Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

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 2021-03-06 22:28:39 -06:00
parent 92048171ef
commit fc515108f4
5 changed files with 75 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
CGI.pas
View File

@ -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
View File

@ -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

5
Expression.pas
View File

@ -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
View File

@ -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}

3
Native.pas
View File

@ -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}