mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2025-02-06 04:30:13 +00:00
Make floating-point casts reduce the range and precision of numbers.
The C standards generally allow floating-point operations to be done with extra range and precision, but they require that explicit casts convert to the actual type specified. ORCA/C was not previously doing that. This patch relies on some new library routines (currently in ORCALib) to do this precision reduction. This fixes #64.
This commit is contained in:
Stephen Heumann
parent
92048171ef
commit
fc515108f4
46
CGI.pas
46
CGI.pas
@ -648,6 +648,15 @@ function TypeSize (tp: baseTypeEnum): integer;
|
||||
{ Parameters: }
|
||||
{ code - intermediate code instruction to write }
|
||||
|
||||
|
||||
procedure LimitPrecision (var rval: extended; tp: baseTypeEnum);
|
||||
|
||||
{ limit the precision and range of a real value to the type. }
|
||||
{ }
|
||||
{ parameters: }
|
||||
{ rval - real value }
|
||||
{ tp - type to limit precision to }
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
|
||||
implementation
|
||||
@ -884,10 +893,11 @@ if codeGeneration then begin
|
||||
end;
|
||||
|
||||
pc_cnn,pc_cnv:
|
||||
if fp1 = fp2 then
|
||||
if (fp1 = fp2)
|
||||
and not (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp]) then
|
||||
goto 1
|
||||
else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended])
|
||||
and (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp,cgExtended]) then
|
||||
and (baseTypeEnum(fp2) = cgExtended) then
|
||||
goto 1
|
||||
else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord])
|
||||
and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then
|
||||
@ -1377,4 +1387,36 @@ case tp of
|
||||
end; {case}
|
||||
end; {TypeSize}
|
||||
|
||||
|
||||
procedure LimitPrecision {rval: var extended; tp: baseTypeEnum};
|
||||
|
||||
{ limit the precision and range of a real value to the type. }
|
||||
{ }
|
||||
{ parameters: }
|
||||
{ rval - real value }
|
||||
{ tp - type to limit precision to }
|
||||
|
||||
var
|
||||
d: double;
|
||||
s: real;
|
||||
c: comp;
|
||||
|
||||
begin {LimitPrecision}
|
||||
case tp of
|
||||
cgReal: begin
|
||||
s := rval;
|
||||
rval := s;
|
||||
end;
|
||||
cgDouble: begin
|
||||
d := rval;
|
||||
rval := d;
|
||||
end;
|
||||
cgComp: begin
|
||||
c := rval;
|
||||
rval := c;
|
||||
end;
|
||||
cgExtended: ;
|
||||
end; {case}
|
||||
end; {LimitPrecision}
|
||||
|
||||
end.
|
||||
|
||||
13
DAG.pas
13
DAG.pas
@ -1161,6 +1161,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
end;
|
||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||
rval := op^.left^.q;
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.q := 0;
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
@ -1181,6 +1182,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
end;
|
||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||
rval := ord4(op^.left^.q) & $0000FFFF;
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.q := 0;
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
@ -1203,6 +1205,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
end;
|
||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||
rval := op^.left^.lval;
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.lval := 0;
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
@ -1227,6 +1230,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
rval := lval
|
||||
else
|
||||
rval := (lval & $7FFFFFFF) + 2147483648.0;
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
otherwise: ;
|
||||
@ -1246,6 +1250,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
cgQuad,cgUQuad: ;
|
||||
cgDouble,cgExtended: begin
|
||||
rval := CnvLLX(op^.left^.qval);
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.qval := longlong0;
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
@ -1268,6 +1273,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||
cgQuad,cgUQuad: ;
|
||||
cgDouble,cgExtended: begin
|
||||
rval := CnvULLX(op^.left^.qval);
|
||||
LimitPrecision(rval, totype.optype);
|
||||
op^.left^.qval := longlong0;
|
||||
op^.left^.rval := rval;
|
||||
end;
|
||||
@ -1346,7 +1352,8 @@ case op^.opcode of {check for optimizations of this node}
|
||||
CnvXLL(op^.left^.qval, rval);
|
||||
cgUQuad:
|
||||
CnvXULL(op^.left^.qval, rval);
|
||||
cgReal,cgDouble,cgComp,cgExtended: ;
|
||||
cgReal,cgDouble,cgComp,cgExtended:
|
||||
LimitPrecision(rval, totype.optype);
|
||||
otherwise: ;
|
||||
end;
|
||||
end; {case}
|
||||
@ -1374,7 +1381,9 @@ case op^.opcode of {check for optimizations of this node}
|
||||
firsttype.i := (op^.left^.q & $00F0) >> 4;
|
||||
if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
||||
if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then
|
||||
doit := true;
|
||||
if (baseTypeEnum(op^.left^.q & $000F) = toType.optype)
|
||||
or (baseTypeEnum(op^.left^.q & $000F) = cgExtended) then
|
||||
doit := true;
|
||||
end {if}
|
||||
else begin
|
||||
if firstType.optype in [cgByte,cgWord,cgLong] then
|
||||
|
||||
@ -567,6 +567,8 @@ else if kind2 in
|
||||
|
||||
scalarType: begin
|
||||
baseType1 := t1^.baseType;
|
||||
if baseType1 in [cgReal,cgDouble,cgComp] then
|
||||
baseType1 := cgExtended;
|
||||
if baseType1 = cgString then
|
||||
Error(64)
|
||||
else if baseType1 = cgVoid then
|
||||
@ -1643,6 +1645,7 @@ var
|
||||
else begin
|
||||
op^.token.kind := extendedConst;
|
||||
op^.token.class := realConstant;
|
||||
LimitPrecision(rop1, baseType);
|
||||
op^.token.rval := rop1;
|
||||
end; {else if}
|
||||
end; {if}
|
||||
@ -2211,7 +2214,7 @@ if (tp^.kind = scalarType) and (tp^.cType = ctBool) then begin
|
||||
else if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin
|
||||
rt := tp^.baseType;
|
||||
et := expressionType^.baseType;
|
||||
if rt <> et then
|
||||
if (rt <> et) or (rt in [cgReal,cgDouble,cgComp]) then
|
||||
if et <> cgVoid then
|
||||
Gen2(pc_cnv, ord(et), ord(rt))
|
||||
else
|
||||
|
||||
18
Gen.pas
18
Gen.pas
@ -1649,7 +1649,7 @@ const {note: these constants list all legal }
|
||||
uquadToVoid = $DB;
|
||||
|
||||
var
|
||||
fromReal: boolean; {are we converting from a real?}
|
||||
toRealType: baseTypeEnum; {real type converted to}
|
||||
lab1: integer; {used for branches}
|
||||
lLong: longType; {used to reserve gLong}
|
||||
|
||||
@ -1663,12 +1663,13 @@ else
|
||||
gQuad.preference := onStack;
|
||||
if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin
|
||||
op^.q := (op^.q & $000F) | (cReal * 16);
|
||||
fromReal := true;
|
||||
end; {if}
|
||||
if (op^.q & $000F) in [cDouble,cExtended,cComp,cReal] then begin
|
||||
toRealType := baseTypeEnum(op^.q & $000F);
|
||||
op^.q := (op^.q & $00F0) | cReal;
|
||||
end {if}
|
||||
else
|
||||
fromReal := false;
|
||||
if (op^.q & $000F) in [cDouble,cExtended,cComp] then
|
||||
op^.q := (op^.q & $00F0) | cReal;
|
||||
toRealType := cgVoid;
|
||||
GenTree(op^.left);
|
||||
if op^.q in [wordToLong,wordToUlong] then begin
|
||||
lab1 := GenLabel;
|
||||
@ -1994,6 +1995,13 @@ else if (op^.q & $000F) in [cLong,cULong] then
|
||||
end; {else if}
|
||||
gLong.where := onStack;
|
||||
end; {if}
|
||||
if toRealType <> cgVoid then
|
||||
case toRealType of
|
||||
cgReal: GenCall(91);
|
||||
cgDouble: GenCall(92);
|
||||
cgComp: GenCall(93);
|
||||
cgExtended: ;
|
||||
end; {case}
|
||||
end; {GenCnv}
|
||||
|
||||
|
||||
|
||||
@ -2047,6 +2047,9 @@ case callNum of
|
||||
88: sp := @'~SCMP8';
|
||||
89: sp := @'~CNVREALLONGLONG';
|
||||
90: sp := @'~CNVREALULONGLONG';
|
||||
91: sp := @'~SINGLEPRECISION';
|
||||
92: sp := @'~DOUBLEPRECISION';
|
||||
93: sp := @'~COMPPRECISION';
|
||||
otherwise:
|
||||
Error(cge1);
|
||||
end; {case}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user