diff --git a/CGI.pas b/CGI.pas index 912d4f7..92b1e7b 100644 --- a/CGI.pas +++ b/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. diff --git a/DAG.pas b/DAG.pas index 4c2be75..9a8444b 100644 --- a/DAG.pas +++ b/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 diff --git a/Expression.pas b/Expression.pas index 8599617..ca40858 100644 --- a/Expression.pas +++ b/Expression.pas @@ -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 diff --git a/Gen.pas b/Gen.pas index 32ac1c7..f8583d8 100644 --- a/Gen.pas +++ b/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} diff --git a/Native.pas b/Native.pas index 627dcf8..57b9a5c 100644 --- a/Native.pas +++ b/Native.pas @@ -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}