Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-06-10 22:29:27 +00:00
Code Issues Projects Releases Wiki Activity

Keep track of semantic type of floating-point expressions.

Browse Source 
Previously, the type was forced to extended in many circumstances. This was visible in that the results of sizeof were incorrect. It would also affect _Generic, if and when that is implemented.

Note that this does not affect the actual format used for computations and storage of intermediates. That is still the extended format.
This commit is contained in:
Stephen Heumann 2021-03-06 23:54:55 -06:00
parent cf9add4720
commit 41623529d7
1 changed files with 53 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
Expression.pas
View File

@ -352,11 +352,8 @@ function Unary(tp: baseTypeEnum): baseTypeEnum;
{ Stack type. } { Stack type. }
begin {Unary} begin {Unary}
if tp in [cgByte,cgUByte,cgReal,cgDouble,cgComp] then if tp in [cgByte,cgUByte] then
if tp in [cgByte,cgUByte] then tp := cgWord;
tp := cgWord
else {if tp in [cgReal,cgDouble,cgComp] then}
tp := cgExtended;
Unary := tp; Unary := tp;
end; {Unary} end; {Unary}
@ -381,6 +378,37 @@ var
rType: typePtr; {right type} rType: typePtr; {right type}
lt,rt: baseTypeEnum; {work variables} lt,rt: baseTypeEnum; {work variables}
function CommonRealType (lt, rt: baseTypeEnum): baseTypeEnum;
{ Compute the common real type of two types, where at least }
{ one of the types is a real type. }
{ }
{ inputs: }
{ lt, rt - the two operand types }
{ }
{ outputs: }
{ expressionType - set to result type }
begin {CommonRealType}
if (lt = cgComp) and (rt = cgComp) then
lt := cgComp
else if (lt in [cgExtended,cgComp]) or (rt in [cgExtended,cgComp]) then
lt := cgExtended
else if (lt = cgDouble) or (rt = cgDouble) then
lt := cgDouble
else
lt := cgReal;
CommonRealType := lt;
case lt of
cgReal: expressionType := floatPtr;
cgDouble: expressionType := doublePtr;
cgExtended: expressionType := extendedPtr;
cgComp: expressionType := compPtr;
end; {case}
end; {CommonRealType}
begin {UsualBinaryConversions} begin {UsualBinaryConversions}
UsualBinaryConversions := cgULong; UsualBinaryConversions := cgULong;
if lType^.kind = pointerType then if lType^.kind = pointerType then
@ -402,17 +430,15 @@ if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin
lt := Unary(lType^.baseType); lt := Unary(lType^.baseType);
rt := Unary(rType^.baseType); rt := Unary(rType^.baseType);
if lt <> rt then begin if lt <> rt then begin
if lt = cgExtended then begin if lt in [cgReal,cgDouble,cgExtended,cgComp] then begin
if rt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then if rt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
Gen2(pc_cnv, ord(rt), ord(cgExtended)); Gen2(pc_cnv, ord(rt), ord(cgExtended));
UsualBinaryConversions := cgExtended; UsualBinaryConversions := CommonRealType(lt, rt);
expressionType := extendedPtr;
end {if} end {if}
else if rt = cgExtended then begin else if rt in [cgReal,cgDouble,cgExtended,cgComp] then begin
if lt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then if lt in [cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad] then
Gen2(pc_cnn, ord(lt), ord(cgExtended)); Gen2(pc_cnn, ord(lt), ord(cgExtended));
UsualBinaryConversions := cgExtended; UsualBinaryConversions := CommonRealType(lt, rt);
expressionType := extendedPtr;
end {else if} end {else if}
else if lt = cgUQuad then begin else if lt = cgUQuad then begin
if rt in [cgWord,cgUWord,cgLong,cgULong] then if rt in [cgWord,cgUWord,cgLong,cgULong] then
@ -470,9 +496,7 @@ if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin
else begin {types are the same} else begin {types are the same}
UsualBinaryConversions := lt; UsualBinaryConversions := lt;
if lt = cgWord then {update types that may have changed} if lt = cgWord then {update types that may have changed}
expressionType := intPtr expressionType := intPtr;
else if lt = cgExtended then
expressionType := extendedPtr;
end; {else} end; {else}
end {if} end {if}
else else
@ -503,9 +527,7 @@ if expressionType^.kind = scalarType then begin
et := Unary(expressionType^.baseType); et := Unary(expressionType^.baseType);
UsualUnaryConversions := et; UsualUnaryConversions := et;
if et = cgWord then {update types that may have changed} if et = cgWord then {update types that may have changed}
expressionType := intPtr expressionType := intPtr;
else if et = cgExtended then
expressionType := extendedPtr;
end {if} end {if}
{else if expressionType^.kind in [arrayType,pointerType] then {else if expressionType^.kind in [arrayType,pointerType] then
UsualUnaryConversions := cgULong}; UsualUnaryConversions := cgULong};
@ -3431,7 +3453,7 @@ case tree^.token.kind of
Gen0(pc_adl) Gen0(pc_adl)
else if et in [cgQuad,cgUQuad] then else if et in [cgQuad,cgUQuad] then
Gen0(pc_adq) Gen0(pc_adq)
else if et = cgExtended then else if et in [cgReal,cgDouble,cgComp,cgExtended] then
Gen0(pc_adr) Gen0(pc_adr)
else else
Error(66); Error(66);
@ -3447,7 +3469,7 @@ case tree^.token.kind of
Gen0(pc_sbl) Gen0(pc_sbl)
else if et in [cgQuad,cgUQuad] then else if et in [cgQuad,cgUQuad] then
Gen0(pc_sbq) Gen0(pc_sbq)
else if et = cgExtended then else if et in [cgReal,cgDouble,cgComp,cgExtended] then
Gen0(pc_sbr) Gen0(pc_sbr)
else else
Error(66); Error(66);
@ -3465,7 +3487,7 @@ case tree^.token.kind of
Gen0(pc_mpq) Gen0(pc_mpq)
else if et = cgUQuad then else if et = cgUQuad then
Gen0(pc_umq) Gen0(pc_umq)
else if et = cgExtended then else if et in [cgReal,cgDouble,cgComp,cgExtended] then
Gen0(pc_mpr) Gen0(pc_mpr)
else else
Error(66); Error(66);
@ -3483,7 +3505,7 @@ case tree^.token.kind of
Gen0(pc_dvq) Gen0(pc_dvq)
else if et = cgUQuad then else if et = cgUQuad then
Gen0(pc_udq) Gen0(pc_udq)
else if et = cgExtended then else if et in [cgReal,cgDouble,cgComp,cgExtended] then
Gen0(pc_dvr) Gen0(pc_dvr)
else else
Error(66); Error(66);
@ -3609,7 +3631,7 @@ case tree^.token.kind of
expressionType := uLongPtr expressionType := uLongPtr
else begin else begin
et := UsualUnaryConversions; et := UsualUnaryConversions;
if et = cgExtended then begin if et in [cgReal,cgDouble,cgComp,cgExtended] then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := intPtr; expressionType := intPtr;
@ -3626,7 +3648,7 @@ case tree^.token.kind of
expressionType := uLongPtr expressionType := uLongPtr
else begin else begin
et := UsualUnaryConversions; et := UsualUnaryConversions;
if et = cgExtended then begin if et in [cgReal,cgDouble,cgComp,cgExtended] then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := intPtr; expressionType := intPtr;
@ -3654,7 +3676,7 @@ case tree^.token.kind of
expressionType := uLongPtr expressionType := uLongPtr
else begin else begin
et := UsualUnaryConversions; et := UsualUnaryConversions;
if et = cgExtended then begin if et in [cgReal,cgDouble,cgComp,cgExtended] then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := intPtr; expressionType := intPtr;
@ -3671,7 +3693,7 @@ case tree^.token.kind of
expressionType := uLongPtr expressionType := uLongPtr
else begin else begin
et := UsualUnaryConversions; et := UsualUnaryConversions;
if et = cgExtended then begin if et in [cgReal,cgDouble,cgComp,cgExtended] then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := intPtr; expressionType := intPtr;
@ -3860,7 +3882,7 @@ case tree^.token.kind of
Gen0(pc_adl); Gen0(pc_adl);
cgQuad,cgUQuad: cgQuad,cgUQuad:
Gen0(pc_adq); Gen0(pc_adq);
cgExtended: cgReal,cgDouble,cgComp,cgExtended:
Gen0(pc_adr); Gen0(pc_adr);
otherwise: otherwise:
error(66); error(66);
@ -3918,7 +3940,7 @@ case tree^.token.kind of
Gen0(pc_sbl); Gen0(pc_sbl);
cgQuad,cgUQuad: cgQuad,cgUQuad:
Gen0(pc_sbq); Gen0(pc_sbq);
cgExtended: cgReal,cgDouble,cgComp,cgExtended:
Gen0(pc_sbr); Gen0(pc_sbr);
otherwise: otherwise:
error(66); error(66);
@ -3945,7 +3967,7 @@ case tree^.token.kind of
Gen0(pc_mpq); Gen0(pc_mpq);
cgUQuad: cgUQuad:
Gen0(pc_umq); Gen0(pc_umq);
cgExtended: cgReal,cgDouble,cgComp,cgExtended:
Gen0(pc_mpr); Gen0(pc_mpr);
otherwise: otherwise:
error(66); error(66);
@ -3971,7 +3993,7 @@ case tree^.token.kind of
Gen0(pc_dvq); Gen0(pc_dvq);
cgUQuad: cgUQuad:
Gen0(pc_udq); Gen0(pc_udq);
cgExtended: cgReal,cgDouble,cgComp,cgExtended:
Gen0(pc_dvr); Gen0(pc_dvr);
otherwise: otherwise:
error(66); error(66);
@ -4051,7 +4073,7 @@ case tree^.token.kind of
Gen0(pc_ngl); Gen0(pc_ngl);
cgQuad,cgUQuad: cgQuad,cgUQuad:
Gen0(pc_ngq); Gen0(pc_ngq);
cgExtended: cgReal,cgDouble,cgComp,cgExtended:
Gen0(pc_ngr); Gen0(pc_ngr);
otherwise: otherwise:
error(66); error(66);
@ -4093,7 +4115,7 @@ case tree^.token.kind of
Gen0t(pc_equ, cgQuad); Gen0t(pc_equ, cgQuad);
end; end;
cgExtended: begin cgReal,cgDouble,cgComp,cgExtended: begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_equ, cgExtended); Gen0t(pc_equ, cgExtended);
end; end;