mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-06-25 16:29:56 +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:
parent
92048171ef
commit
fc515108f4
46
CGI.pas
46
CGI.pas
|
@ -648,6 +648,15 @@ function TypeSize (tp: baseTypeEnum): integer;
|
||||||
{ Parameters: }
|
{ Parameters: }
|
||||||
{ code - intermediate code instruction to write }
|
{ 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
|
implementation
|
||||||
|
@ -884,10 +893,11 @@ if codeGeneration then begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
pc_cnn,pc_cnv:
|
pc_cnn,pc_cnv:
|
||||||
if fp1 = fp2 then
|
if (fp1 = fp2)
|
||||||
|
and not (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp]) then
|
||||||
goto 1
|
goto 1
|
||||||
else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended])
|
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
|
goto 1
|
||||||
else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord])
|
else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord])
|
||||||
and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then
|
and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then
|
||||||
|
@ -1377,4 +1387,36 @@ case tp of
|
||||||
end; {case}
|
end; {case}
|
||||||
end; {TypeSize}
|
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.
|
end.
|
||||||
|
|
13
DAG.pas
13
DAG.pas
|
@ -1161,6 +1161,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
end;
|
end;
|
||||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||||
rval := op^.left^.q;
|
rval := op^.left^.q;
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.q := 0;
|
op^.left^.q := 0;
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
|
@ -1181,6 +1182,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
end;
|
end;
|
||||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||||
rval := ord4(op^.left^.q) & $0000FFFF;
|
rval := ord4(op^.left^.q) & $0000FFFF;
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.q := 0;
|
op^.left^.q := 0;
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
|
@ -1203,6 +1205,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
end;
|
end;
|
||||||
cgReal,cgDouble,cgComp,cgExtended: begin
|
cgReal,cgDouble,cgComp,cgExtended: begin
|
||||||
rval := op^.left^.lval;
|
rval := op^.left^.lval;
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.lval := 0;
|
op^.left^.lval := 0;
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
|
@ -1227,6 +1230,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
rval := lval
|
rval := lval
|
||||||
else
|
else
|
||||||
rval := (lval & $7FFFFFFF) + 2147483648.0;
|
rval := (lval & $7FFFFFFF) + 2147483648.0;
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
otherwise: ;
|
otherwise: ;
|
||||||
|
@ -1246,6 +1250,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
cgQuad,cgUQuad: ;
|
cgQuad,cgUQuad: ;
|
||||||
cgDouble,cgExtended: begin
|
cgDouble,cgExtended: begin
|
||||||
rval := CnvLLX(op^.left^.qval);
|
rval := CnvLLX(op^.left^.qval);
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.qval := longlong0;
|
op^.left^.qval := longlong0;
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
|
@ -1268,6 +1273,7 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
cgQuad,cgUQuad: ;
|
cgQuad,cgUQuad: ;
|
||||||
cgDouble,cgExtended: begin
|
cgDouble,cgExtended: begin
|
||||||
rval := CnvULLX(op^.left^.qval);
|
rval := CnvULLX(op^.left^.qval);
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
op^.left^.qval := longlong0;
|
op^.left^.qval := longlong0;
|
||||||
op^.left^.rval := rval;
|
op^.left^.rval := rval;
|
||||||
end;
|
end;
|
||||||
|
@ -1346,7 +1352,8 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
CnvXLL(op^.left^.qval, rval);
|
CnvXLL(op^.left^.qval, rval);
|
||||||
cgUQuad:
|
cgUQuad:
|
||||||
CnvXULL(op^.left^.qval, rval);
|
CnvXULL(op^.left^.qval, rval);
|
||||||
cgReal,cgDouble,cgComp,cgExtended: ;
|
cgReal,cgDouble,cgComp,cgExtended:
|
||||||
|
LimitPrecision(rval, totype.optype);
|
||||||
otherwise: ;
|
otherwise: ;
|
||||||
end;
|
end;
|
||||||
end; {case}
|
end; {case}
|
||||||
|
@ -1374,7 +1381,9 @@ case op^.opcode of {check for optimizations of this node}
|
||||||
firsttype.i := (op^.left^.q & $00F0) >> 4;
|
firsttype.i := (op^.left^.q & $00F0) >> 4;
|
||||||
if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
if fromType.optype in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
||||||
if toType.optype in [cgReal,cgDouble,cgComp,cgExtended] then
|
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}
|
end {if}
|
||||||
else begin
|
else begin
|
||||||
if firstType.optype in [cgByte,cgWord,cgLong] then
|
if firstType.optype in [cgByte,cgWord,cgLong] then
|
||||||
|
|
|
@ -567,6 +567,8 @@ else if kind2 in
|
||||||
|
|
||||||
scalarType: begin
|
scalarType: begin
|
||||||
baseType1 := t1^.baseType;
|
baseType1 := t1^.baseType;
|
||||||
|
if baseType1 in [cgReal,cgDouble,cgComp] then
|
||||||
|
baseType1 := cgExtended;
|
||||||
if baseType1 = cgString then
|
if baseType1 = cgString then
|
||||||
Error(64)
|
Error(64)
|
||||||
else if baseType1 = cgVoid then
|
else if baseType1 = cgVoid then
|
||||||
|
@ -1643,6 +1645,7 @@ var
|
||||||
else begin
|
else begin
|
||||||
op^.token.kind := extendedConst;
|
op^.token.kind := extendedConst;
|
||||||
op^.token.class := realConstant;
|
op^.token.class := realConstant;
|
||||||
|
LimitPrecision(rop1, baseType);
|
||||||
op^.token.rval := rop1;
|
op^.token.rval := rop1;
|
||||||
end; {else if}
|
end; {else if}
|
||||||
end; {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
|
else if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin
|
||||||
rt := tp^.baseType;
|
rt := tp^.baseType;
|
||||||
et := expressionType^.baseType;
|
et := expressionType^.baseType;
|
||||||
if rt <> et then
|
if (rt <> et) or (rt in [cgReal,cgDouble,cgComp]) then
|
||||||
if et <> cgVoid then
|
if et <> cgVoid then
|
||||||
Gen2(pc_cnv, ord(et), ord(rt))
|
Gen2(pc_cnv, ord(et), ord(rt))
|
||||||
else
|
else
|
||||||
|
|
18
Gen.pas
18
Gen.pas
|
@ -1649,7 +1649,7 @@ const {note: these constants list all legal }
|
||||||
uquadToVoid = $DB;
|
uquadToVoid = $DB;
|
||||||
|
|
||||||
var
|
var
|
||||||
fromReal: boolean; {are we converting from a real?}
|
toRealType: baseTypeEnum; {real type converted to}
|
||||||
lab1: integer; {used for branches}
|
lab1: integer; {used for branches}
|
||||||
lLong: longType; {used to reserve gLong}
|
lLong: longType; {used to reserve gLong}
|
||||||
|
|
||||||
|
@ -1663,12 +1663,13 @@ else
|
||||||
gQuad.preference := onStack;
|
gQuad.preference := onStack;
|
||||||
if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin
|
if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin
|
||||||
op^.q := (op^.q & $000F) | (cReal * 16);
|
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}
|
end {if}
|
||||||
else
|
else
|
||||||
fromReal := false;
|
toRealType := cgVoid;
|
||||||
if (op^.q & $000F) in [cDouble,cExtended,cComp] then
|
|
||||||
op^.q := (op^.q & $00F0) | cReal;
|
|
||||||
GenTree(op^.left);
|
GenTree(op^.left);
|
||||||
if op^.q in [wordToLong,wordToUlong] then begin
|
if op^.q in [wordToLong,wordToUlong] then begin
|
||||||
lab1 := GenLabel;
|
lab1 := GenLabel;
|
||||||
|
@ -1994,6 +1995,13 @@ else if (op^.q & $000F) in [cLong,cULong] then
|
||||||
end; {else if}
|
end; {else if}
|
||||||
gLong.where := onStack;
|
gLong.where := onStack;
|
||||||
end; {if}
|
end; {if}
|
||||||
|
if toRealType <> cgVoid then
|
||||||
|
case toRealType of
|
||||||
|
cgReal: GenCall(91);
|
||||||
|
cgDouble: GenCall(92);
|
||||||
|
cgComp: GenCall(93);
|
||||||
|
cgExtended: ;
|
||||||
|
end; {case}
|
||||||
end; {GenCnv}
|
end; {GenCnv}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -2047,6 +2047,9 @@ case callNum of
|
||||||
88: sp := @'~SCMP8';
|
88: sp := @'~SCMP8';
|
||||||
89: sp := @'~CNVREALLONGLONG';
|
89: sp := @'~CNVREALLONGLONG';
|
||||||
90: sp := @'~CNVREALULONGLONG';
|
90: sp := @'~CNVREALULONGLONG';
|
||||||
|
91: sp := @'~SINGLEPRECISION';
|
||||||
|
92: sp := @'~DOUBLEPRECISION';
|
||||||
|
93: sp := @'~COMPPRECISION';
|
||||||
otherwise:
|
otherwise:
|
||||||
Error(cge1);
|
Error(cge1);
|
||||||
end; {case}
|
end; {case}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user