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

Use the right types for constants cast to character types. 

These were previously treated as having type int. This resulted in incorrect results from sizeof, and would also be a problem for _Generic if it was implemented.

Note that this creates a token kind of "charconst", but this is not the kind for character constants in the source code. Those have type int, so their kind is intconst. The new kinds of "tokens" are created only through casts of constant expressions.
This commit is contained in:
Stephen Heumann 2021-03-07 13:38:21 -06:00
parent 8f8e7f12e2
commit 979852be3c
6 changed files with 83 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CCommon.pas
View File

@ -167,9 +167,12 @@ type
tokenEnum = ( {enumeration of the tokens}
ident, {identifiers}
{constants}
{Note: compconst and charconst, etc. }
{ are not found in program code. }
{ They are created only by casts. }
intconst,uintconst,longconst,ulongconst,longlongconst,
ulonglongconst,floatconst,doubleconst,extendedconst,compconst,
stringconst,
charconst,scharconst,ucharconst,stringconst,
{reserved words}
_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy,
_Genericsy,_Imaginarysy,_Noreturnsy,_Static_assertsy,_Thread_localsy,

82
Expression.pas
View File

@ -1026,7 +1026,7 @@ var
{ convert an operand to a real value }
begin {RealVal}
if token.kind = intconst then
if token.kind in [intconst,charconst,scharconst,ucharconst] then
RealVal := token.ival
else if token.kind = uintconst then begin
if token.ival < 0 then
@ -1056,7 +1056,7 @@ var
{ convert an operand to a longint value }
begin {IntVal}
if token.kind = intconst then
if token.kind in [intconst,charconst,scharconst,ucharconst] then
IntVal := token.ival
else if token.kind = uintconst then begin
IntVal := token.ival & $0000FFFF;
@ -1072,7 +1072,7 @@ var
{ convert an operand to a long long value }
begin {LongLongVal}
if token.kind = intconst then begin
if token.kind in [intconst,charconst,scharconst,ucharconst] then begin
result.lo := token.ival;
if result.lo < 0 then
result.hi := -1
@ -1144,11 +1144,14 @@ var
op^.middle := Pop;
op^.left := Pop;
if op^.right^.token.kind in [intconst,uintconst,
longconst,ulongconst,longlongconst,ulonglongconst] then
longconst,ulongconst,longlongconst,ulonglongconst,
charconst,scharconst,ucharconst] then
if op^.left^.token.kind in [intconst,uintconst,
longconst,ulongconst,longlongconst,ulonglongconst] then
longconst,ulongconst,longlongconst,ulonglongconst,
charconst,scharconst,ucharconst] then
if op^.middle^.token.kind in [intconst,uintconst,
longconst,ulongconst,longlongconst,ulonglongconst] then begin
longconst,ulongconst,longlongconst,ulonglongconst,
charconst,scharconst,ucharconst] then begin
GetLongLongVal(llop1, op^.left^.token);
if (llop1.lo <> 0) or (llop1.hi <> 0) then
op^.token := op^.middle^.token
@ -1190,8 +1193,10 @@ var
op^.left := Pop;
kindRight := op^.right^.token.kind;
kindLeft := op^.left^.token.kind;
if kindRight in [intconst,uintconst,longconst,ulongconst] then begin
if kindLeft in [intconst,uintconst,longconst,ulongconst] then begin
if kindRight in [intconst,uintconst,longconst,ulongconst,
charconst,scharconst,ucharconst] then begin
if kindLeft in [intconst,uintconst,longconst,ulongconst,
charconst,scharconst,ucharconst] then begin
if kind = preprocessorExpression then
goto 2;
@ -1328,9 +1333,11 @@ var
end; {if}
2:
if kindRight in [intconst,uintconst,longconst,ulongconst,
longlongconst,ulonglongconst] then begin
longlongconst,ulonglongconst,charconst,scharconst,ucharconst]
then begin
if kindLeft in [intconst,uintconst,longconst,ulongconst,
longlongconst,ulonglongconst] then begin
longlongconst,ulonglongconst,charconst,scharconst,ucharconst]
then begin
if kind = preprocessorExpression then begin
kindLeft := PPKind(op^.left^.token);
@ -1478,10 +1485,10 @@ var
if op^.right^.token.kind in [intconst,uintconst,longconst,ulongconst,
longlongconst,ulonglongconst,floatconst,doubleconst,extendedconst,
compconst] then
compconst,charconst,scharconst,ucharconst] then
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
longlongconst,ulonglongconst,floatconst,doubleconst,extendedconst,
compconst] then
compconst,charconst,scharconst,ucharconst] then
begin
if fenvAccess then
if kind in [normalExpression, autoInitializerExpression] then
@ -1632,7 +1639,10 @@ var
dispose(op^.left);
op^.left := nil;
if baseType in [cgByte,cgWord] then begin
op^.token.kind := intConst;
if baseType = cgByte then
op^.token.kind := scharConst
else
op^.token.kind := intConst;
op^.token.class := intConstant;
if tp^.cType = ctBool then
op^.token.ival := ord(rop1 <> 0.0)
@ -1651,7 +1661,10 @@ var
op^.token.ival := long(llop1.lo).lsw;
end {else if}
else if baseType = cgUByte then begin
op^.token.kind := intConst;
if tp^.cType = ctUChar then
op^.token.kind := ucharConst
else
op^.token.kind := charConst;
op^.token.class := intConstant;
op^.token.ival := long(llop1.lo).lsw;
op^.token.ival := op^.token.ival & $00FF;
@ -1696,10 +1709,13 @@ var
[typedef,plusplusop,minusminusop,opplusplus,opminusminus,uand]) then
begin
if (kind <> preprocessorExpression) and (op^.left^.token.kind
in [intconst,uintconst,longconst,ulongconst]) then begin
in [intconst,uintconst,longconst,ulongconst,charconst,scharconst,
ucharconst]) then begin
{evaluate a constant operation}
ekind := op^.left^.token.kind;
if ekind in [charconst,scharconst,ucharconst] then
ekind := intconst;
op1 := IntVal(op^.left^.token);
dispose(op^.left);
op^.left := nil;
@ -1724,10 +1740,13 @@ var
end; {else}
end {if}
else if op^.left^.token.kind in [longlongconst,ulonglongconst,
intconst,uintconst,longconst,ulongconst] then begin
intconst,uintconst,longconst,ulongconst,charconst,scharconst,
ucharconst] then begin
{evaluate a constant operation with long long operand}
ekind := op^.left^.token.kind;
if ekind in [charconst,scharconst,ucharconst] then
ekind := intconst;
if kind = preprocessorExpression then
ekind := PPKind(op^.left^.token);
GetLongLongVal(llop1, op^.left^.token);
@ -3279,15 +3298,21 @@ case tree^.token.kind of
end; {case}
end;
intConst,uintConst: begin
intConst,uintConst,charConst,scharConst,ucharConst: begin
Gen1t(pc_ldc, tree^.token.ival, cgWord);
lastwasconst := true;
lastconst := tree^.token.ival;
if tree^.token.kind = intConst then
expressionType := intPtr
else
expressionType := uIntPtr;
end; {case intConst}
else if tree^.token.kind = uintConst then
expressionType := uIntPtr
else if tree^.token.kind = charConst then
expressionType := charPtr
else if tree^.token.kind = scharConst then
expressionType := scharPtr
else {if tree^.token.kind = ucharConst then}
expressionType := ucharPtr;
end; {case intConst,uintConst,charConst,scharConst,ucharConst}
longConst,ulongConst: begin
GenLdcLong(tree^.token.lval);
@ -4391,7 +4416,8 @@ else begin {record the expression for an initialize
castValue := tree^.left;
while castValue^.token.kind = castoper do
castValue := castValue^.left;
if castValue^.token.kind in [intconst,uintconst] then begin
if castValue^.token.kind in
[intconst,uintconst,charconst,scharconst,ucharconst] then begin
expressionValue := castValue^.token.ival;
isConstant := true;
expressionType := tree^.castType;
@ -4407,9 +4433,17 @@ else begin {record the expression for an initialize
goto 1;
end; {if}
end; {if}
if tree^.token.kind = intconst then begin
if tree^.token.kind in [intconst,charconst,scharconst,ucharconst] then
begin
expressionValue := tree^.token.ival;
expressionType := intPtr;
if tree^.token.kind = intconst then
expressionType := intPtr
else if tree^.token.kind = charconst then
expressionType := charPtr
else if tree^.token.kind = scharconst then
expressionType := scharPtr
else {if tree^.token.kind = ucharconst then}
expressionType := ucharPtr;
isConstant := true;
end {else if}
else if tree^.token.kind = uintconst then begin
@ -4515,7 +4549,7 @@ procedure InitExpression;
begin {InitExpression}
startTerm := [ident,intconst,uintconst,longconst,ulongconst,longlongconst,
ulonglongconst,floatconst,doubleconst,extendedconst,compconst,
stringconst,_Genericsy];
charconst,scharconst,ucharconst,stringconst,_Genericsy];
startExpression:= startTerm +
[lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy,
plusplusop,minusminusop,typedef,_Alignofsy];

2
Header.pas
View File

@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
{$segment 'SCANNER'}
const
symFileVersion = 13; {version number of .sym file format}
symFileVersion = 14; {version number of .sym file format}
var
inhibitHeader: boolean; {should .sym includes be blocked?}

14
Parser.pas
View File

@ -1891,7 +1891,8 @@ var
tree := tree^.left;
if tree^.token.kind = plusch then begin
rtree := tree^.right;
if rtree^.token.kind in [intconst,uintconst] then
if rtree^.token.kind in
[intconst,uintconst,charconst,scharconst,ucharconst] then
size := rtree^.token.ival
else if rtree^.token.kind in [longconst,ulongconst] then
size := rtree^.token.lval
@ -2134,8 +2135,9 @@ var
while operator in [plusch,minusch] do begin
with tree^.right^.token do
if kind in [intConst,uintconst,longConst,ulongconst,
longlongConst,ulonglongconst] then begin
if kind = intConst then
longlongConst,ulonglongconst,charconst,scharconst,
ucharconst] then begin
if kind in [intConst,charconst,scharconst,ucharconst] then
offSet2 := ival
else if kind = uintConst then
offset2 := ival & $0000ffff
@ -3611,7 +3613,8 @@ if isFunction then begin
with fnType^ do begin
NextToken;
Match(lparench,13);
if token.kind in [intconst,uintconst] then begin
if token.kind in
[intconst,uintconst,charconst,scharconst,ucharconst] then begin
toolNum := token.ival;
NextToken;
end {if}
@ -3622,7 +3625,8 @@ if isFunction then begin
dispatcher := token.lval;
NextToken;
end {if}
else if token.kind in [intconst,uintconst] then begin
else if token.kind in
[intconst,uintconst,charconst,scharconst,ucharconst] then begin
dispatcher := token.ival;
NextToken;
end {if}

3
Scanner.pas
View File

@ -747,6 +747,9 @@ case token.kind of
typedef,
ident: write(token.name^);
charconst,
scharconst,
ucharconst,
intconst,
uintconst: write(token.ival:1);

10
Table.asm
View File

@ -286,7 +286,7 @@ charSym start single character symbols
! constants
enum (intconst,uintconst,longconst,ulongconst,longlongconst)
enum (ulonglongconst,floatconst,doubleconst,extendedconst,compconst)
enum stringconst
enum (charconst,scharconst,ucharconst,stringconst)
! reserved words
enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)
enum (_Genericsy,_Imaginarysy,_Noreturnsy,_Static_assertsy,_Thread_localsy)
@ -363,6 +363,9 @@ icp start in-coming priority for expression
dc i1'200' doubleconst
dc i1'200' extendedconst
dc i1'200' compconst
dc i1'200' charconst
dc i1'200' scharconst
dc i1'200' ucharconst
dc i1'200' stringconst
dc i1'200' _Alignassy
dc i1'16' _Alignofsy
@ -533,6 +536,9 @@ isp start in stack priority for expression
dc i1'0' doubleconst
dc i1'0' extendedconst
dc i1'0' compconst
dc i1'0' charconst
dc i1'0' scharconst
dc i1'0' ucharconst
dc i1'0' stringconst
dc i1'0' _Alignassy
dc i1'16' _Alignofsy
@ -906,7 +912,7 @@ wordHash start reserved word hash table
! constants
enum (intconst,uintconst,longconst,ulongconst,longlongconst)
enum (ulonglongconst,floatconst,doubleconst,extendedconst,compconst)
enum stringconst
enum (charconst,scharconst,ucharconst,stringconst)
! reserved words
enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)
enum (_Genericsy,_Imaginarysy,_Noreturnsy,_Static_assertsy,_Thread_localsy)