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

Initial support for constants with long long types. 

Currently, the actual values they can have are still constrained to the 32-bit range. Also, there are some bits of functionality (e.g. for initializers) that are not implemented yet.
This commit is contained in:
Stephen Heumann 2021-02-03 23:11:23 -06:00
parent 714b417261
commit 793f0a57cc
9 changed files with 157 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CCommon.pas
View File

@ -114,7 +114,7 @@ type
{Misc.}
{-----}
long = record lsw,msw: integer; end; {for extracting words from longints}
longlong = record low32,high32: longint; end; {64-bit integer representation}
longlong = record lo,hi: longint; end; {64-bit integer representation}
cString = packed array [1..256] of char; {null terminated string}
cStringPtr = ^cString;
@ -167,7 +167,8 @@ type
tokenEnum = ( {enumeration of the tokens}
ident, {identifiers}
{constants}
intconst,uintconst,longconst,ulongconst,doubleconst,
intconst,uintconst,longconst,ulongconst,longlongconst,
ulonglongconst,doubleconst,
stringconst,
{reserved words}
_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy,
@ -208,7 +209,7 @@ type
tokenSet = set of tokenEnum;
tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant,
doubleConstant,stringConstant,macroParameter);
longlongConstant,doubleConstant,stringConstant,macroParameter);
identPtr = ^identRecord; {^ to a symbol table entry}
tokenType = record {a token}
kind: tokenEnum; {kind of token}
@ -220,6 +221,7 @@ type
symbolPtr: identPtr);
intConstant : (ival: integer);
longConstant : (lval: longint);
longlongConstant: (qval: longlong);
doubleConstant: (rval: double);
stringConstant: (sval: longstringPtr;
ispstring: boolean);
@ -487,6 +489,7 @@ var
{------------------}
doDispose: boolean; {dispose of the expression tree as we go?}
realExpressionValue: double; {value of the last real constant expression}
longlongExpressionValue: longlong; {value of the last long long constant expression}
expressionValue: longint; {value of the last constant expression}
expressionType: typePtr; {the type of the expression}
initializerTree: tokenPtr; {for non-constant initializers}

29
CGI.pas
View File

@ -575,6 +575,14 @@ procedure GenLdcLong (lval: longint);
{ lval - value to load }
procedure GenLdcQuad (qval: longlong);
{ load a long long constant }
{ }
{ parameters: }
{ qval - value to load }
procedure GenLdcReal (rval: double);
{ load a real constant }
@ -1238,6 +1246,27 @@ if codeGeneration then begin
end; {GenLdcLong}
procedure GenLdcQuad {qval: longlong};
{ load a long long constant }
{ }
{ parameters: }
{ qval - value to load }
var
lcode: icptr; {local copy of code}
begin {GenLdcQuad}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgQuad;
lcode^.qval.lo := qval.lo;
lcode^.qval.hi := qval.hi;
Gen0(pc_ldc);
end; {if}
end; {GenLdcQuad}
procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint};
{ generate a tool call }

4
DAG.pas
View File

@ -167,8 +167,8 @@ else if (op1 <> nil) and (op2 <> nil) then
if op1^.lval = op2^.lval then
CodesMatch := true;
cgQuad, cgUQuad:
if op1^.qval.low32 = op2^.qval.low32 then
if op1^.qval.high32 = op2^.qval.high32 then
if op1^.qval.lo = op2^.qval.lo then
if op1^.qval.hi = op2^.qval.hi then
CodesMatch := true;
cgReal, cgDouble, cgComp, cgExtended:
if op1^.rval = op2^.rval then

36
Expression.pas
View File

@ -2810,6 +2810,8 @@ var
if opType^.baseType in [cgByte,cgWord,cgUByte,cgUWord,cgLong,cgULong] then
if ((divisor.class = intConstant) and (divisor.ival = 0))
or ((divisor.class = longConstant) and (divisor.lval = 0))
or ((divisor.class = longlongConstant)
and (divisor.qval.lo = 0) and (divisor.qval.hi = 0))
or ((divisor.class = doubleConstant) and (divisor.rval = 0.0)) then
Error(129);
end; {CheckDivByZero}
@ -2831,6 +2833,12 @@ var
shiftCount := shiftCountTok.ival
else if shiftCountTok.class = longConstant then
shiftCount := shiftCountTok.lval
else if shiftCountTok.class = longlongConstant then begin
if shiftCountTok.qval.hi = 0 then
shiftCount := shiftCountTok.qval.lo
else
shiftCount := -1;
end {else if}
else
shiftCount := 0;
@ -2911,6 +2919,18 @@ case tree^.token.kind of
lastconst := tree^.token.lval;
end; {case longConst}
longlongConst,ulonglongConst: begin
GenLdcQuad(tree^.token.qval);
if tree^.token.kind = longlongConst then
expressionType := longlongPtr
else
expressionType := ulonglongPtr;
if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then begin
lastwasconst := true;
lastconst := tree^.token.qval.lo;
end; {if}
end; {case longlongConst}
doubleConst: begin
GenLdcReal(tree^.token.rval);
expressionType := doublePtr;
@ -3920,6 +3940,18 @@ else begin {record the expression for an initialize
expressionType := ulongPtr;
isConstant := true;
end {else if}
else if tree^.token.kind = longlongconst then begin
longlongExpressionValue.lo := tree^.token.qval.lo;
longlongExpressionValue.hi := tree^.token.qval.hi;
expressionType := longLongPtr;
isConstant := true;
end {else if}
else if tree^.token.kind = ulonglongconst then begin
longlongExpressionValue.lo := tree^.token.qval.lo;
longlongExpressionValue.hi := tree^.token.qval.hi;
expressionType := ulongLongPtr;
isConstant := true;
end {else if}
else if tree^.token.kind = doubleconst then begin
realExpressionValue := tree^.token.rval;
expressionType := extendedPtr;
@ -3955,8 +3987,8 @@ procedure InitExpression;
{ initialize the expression handler }
begin {InitExpression}
startTerm := [ident,intconst,uintconst,longconst,ulongconst,doubleconst,
stringconst,_Genericsy];
startTerm := [ident,intconst,uintconst,longconst,ulongconst,longlongconst,
ulonglongconst,doubleconst,stringconst,_Genericsy];
startExpression:= startTerm +
[lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy,
plusplusop,minusminusop,typedef,_Alignofsy];

7
Gen.pas
View File

@ -4986,6 +4986,13 @@ procedure GenTree {op: icptr};
GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0);
end;
cgQuad,cgUQuad: begin
GenNative(m_pea, immediate, long(op^.qval.hi).msw, nil, 0);
GenNative(m_pea, immediate, long(op^.qval.hi).lsw, nil, 0);
GenNative(m_pea, immediate, long(op^.qval.lo).msw, nil, 0);
GenNative(m_pea, immediate, long(op^.qval.lo).lsw, nil, 0);
end;
otherwise:
Error(cge1);
end; {case}

10
Header.pas
View File

@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
{$segment 'SCANNER'}
const
symFileVersion = 9; {version number of .sym file format}
symFileVersion = 10; {version number of .sym file format}
var
inhibitHeader: boolean; {should .sym includes be blocked?}
@ -711,6 +711,10 @@ procedure EndInclude {chPtr: ptr};
identifier: WriteString(token.name);
intConstant: WriteWord(token.ival);
longConstant: WriteLong(token.lval);
longlongConstant: begin
WriteLong(token.qval.lo);
WriteLong(token.qval.hi);
end;
doubleConstant: WriteDouble(token.rval);
stringConstant: begin
WriteLongString(token.sval);
@ -1331,6 +1335,10 @@ var
identifier: token.name := ReadString;
intConstant: token.ival := ReadWord;
longConstant: token.lval := ReadLong;
longlongConstant: begin
token.qval.lo := ReadLong;
token.qval.hi := ReadLong;
end;
doubleConstant: token.rval := ReadDouble;
stringConstant: begin
token.sval := ReadLongString;

23
Parser.pas
View File

@ -1846,6 +1846,8 @@ var
size := rtree^.token.ival
else if rtree^.token.kind in [longconst,ulongconst] then
size := rtree^.token.lval
else if rtree^.token.kind in [longlongconst,ulonglongconst] then
size := rtree^.token.qval.lo
else begin
Error(18);
errorFound := true;
@ -2056,11 +2058,13 @@ var
operator := tree^.token.kind;
while operator in [plusch,minusch] do begin
with tree^.right^.token do
if kind in [intConst,longConst] then begin
if kind in [intConst,longConst,longlongConst] then begin
if kind = intConst then
offSet2 := ival
else
offset2 := lval;
else if kind = longConst then
offset2 := lval
else {if kind = longlongConst then}
offset2 := qval.lo;
if operator = plusch then
offset := offset + offset2
else
@ -4179,12 +4183,19 @@ var
{do assignment conversions}
while tree^.token.kind = castoper do
tree := tree^.left;
isConstant := tree^.token.class in [intConstant,longConstant];
isConstant :=
tree^.token.class in [intConstant,longConstant,longlongConstant];
if isConstant then
if tree^.token.class = intConstant then
val := tree^.token.ival
else
val := tree^.token.lval;
else if tree^.token.class = longConstant then
val := tree^.token.lval
else {if tree^.token.class = longlongConstant then} begin
if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then
val := tree^.token.qval.lo
else
isConstant := false;
end; {else}
{ if isConstant then
if tree^.token.class = intConstant then

59
Scanner.pas
View File

@ -272,6 +272,7 @@ var
lintErrors: set of 1..maxLint; {lint error codes}
spaceStr: string[2]; {string ' ' (used in stringization)}
quoteStr: string[2]; {string '"' (used in stringization)}
numericConstants: set of tokenClass; {token classes for numeric constants}
{-- External procedures; see expression evaluator for notes ----}
@ -742,6 +743,9 @@ case token.kind of
longConst,
ulongConst: write(token.lval:1);
longlongConst,
ulonglongConst: write('0x...'); {TODO implement}
doubleConst: write(token.rval:1);
@ -1043,7 +1047,7 @@ if class1 in [identifier,reservedWord] then begin
str2 := tk2.name
else if class2 = reservedWord then
str2 := @reservedWords[kind2]
else if class2 in [intConstant,longConstant,doubleConstant] then
else if class2 in numericConstants then
str2 := tk2.numString
else begin
Error(63);
@ -1067,8 +1071,8 @@ if class1 in [identifier,reservedWord] then begin
goto 1;
end {class1 in [identifier,reservedWord]}
else if class1 in [intConstant,longConstant,doubleConstant] then begin
if class2 in [intConstant,longConstant,doubleConstant] then
else if class1 in numericConstants then begin
if class2 in numericConstants then
str2 := tk2.numString
else if class2 = identifier then
str2 := tk2.name
@ -1086,7 +1090,7 @@ else if class1 in [intConstant,longConstant,doubleConstant] then begin
tk1 := token;
token := lt;
goto 1;
end {else if class1 in [intConstant,longConstant,doubleConstant]}
end {else if class1 in numericConstants}
else if class1 = stringConstant then begin
if class2 = stringConstant then begin
@ -1106,7 +1110,7 @@ else if class1 = stringConstant then begin
end {else if}
else if kind1 = dotch then begin
if class2 in [intConstant,longConstant,doubleConstant] then begin
if class2 in numericConstants then begin
workString := concat(tk1.numString^, tk2.numString^);
lt := token;
DoNumber(true);
@ -1114,7 +1118,7 @@ else if kind1 = dotch then begin
token := lt;
goto 1;
end; {if}
end {else if class1 in [intConstant,longConstant,doubleConstant]}
end {else if class1 in numericConstants}
else if kind1 = poundch then begin
if kind2 = poundch then begin
@ -1846,7 +1850,7 @@ else begin
new(tempString);
tempString^[0] := chr(0);
while
(token.class in [reservedWord,intconstant,longconstant,doubleconstant])
(token.class in ([reservedWord] + numericConstants))
or (token.kind in [dotch,ident]) do begin
if token.kind = ident then
tempString^ := concat(tempString^, token.name^)
@ -1854,7 +1858,7 @@ else begin
tempString^ := concat(tempString^, '.')
else if token.class = reservedWord then
tempString^ := concat(tempString^, reservedWords[token.kind])
else {if token.class in [intconst,longconst,doubleconst] then}
else {if token.class in numericConstants then}
tempString^ := concat(tempString^, token.numstring^);
NextToken;
end; {while}
@ -2317,6 +2321,10 @@ var
longConstant:
if tk1^.token.lval <> tk2^.token.lval then
goto 3;
longlongConstant:
if (tk1^.token.qval.lo <> tk2^.token.qval.lo) or
(tk1^.token.qval.hi <> tk2^.token.qval.hi) then
goto 3;
doubleConstant:
if tk1^.token.rval <> tk2^.token.rval then
goto 3;
@ -3145,12 +3153,14 @@ var
isBin: boolean; {is the value a binary number?}
isHex: boolean; {is the value a hex number?}
isLong: boolean; {is the value a long number?}
isLongLong: boolean; {is the value a long long number?}
isReal: boolean; {is the value a real number?}
numIndex: 0..maxLine; {index into workString}
sp: stringPtr; {for saving identifier names}
stringIndex: 0..maxLine; {length of the number string}
unsigned: boolean; {is the number unsigned?}
val: integer; {value of a digit}
c1: char; {saved copy of last character}
numString: pString; {characters in the number}
@ -3217,6 +3227,7 @@ isBin := false; {assume it's not binary}
isHex := false; {assume it's not hex}
isReal := false; {assume it's an integer}
isLong := false; {assume a short integer}
isLongLong := false;
unsigned := false; {assume signed numbers}
stringIndex := 0; {no digits so far...}
if scanWork then begin {set up the scanner}
@ -3276,11 +3287,17 @@ if c2 in ['e','E'] then begin {handle an exponent}
end; {if}
1:
while c2 in ['l','u','L','U'] do {check for long or unsigned}
if c2 in ['l','L'] then begin
NextChar;
if isLong then
if c2 in ['l','L'] then begin
if isLong or isLongLong then
FlagError(156);
isLong := true;
c1 := c2;
NextChar;
if c2 = c1 then begin
NextChar;
isLongLong := true;
end {if}
else
isLong := true;
end {if}
else {if c2 in ['u','U'] then} begin
NextChar;
@ -3293,6 +3310,8 @@ while c2 in ['l','u','L','U'] do {check for long or unsigned}
if c2 in ['f','F'] then begin {allow F designator on reals}
if unsigned then
FlagError(91);
if isLongLong then
FlagError(156);
if not isReal then begin
FlagError(100);
isReal := true;
@ -3395,7 +3414,17 @@ else begin {hex, octal, & binary}
end; {else}
if long(token.lval).msw <> 0 then
isLong := true;
if isLong then begin
if isLongLong then begin
{TODO support actual long long range}
token.qval.lo := token.lval;
token.qval.hi := 0;
if unsigned then
token.kind := ulonglongConst
else
token.kind := longlongConst;
token.class := longlongConstant;
end {if}
else if isLong then begin
if unsigned or (token.lval & $80000000 <> 0) then
token.kind := ulongConst
else
@ -3718,6 +3747,8 @@ lintErrors := [51,104,105,110,124,125,128,129,130,147,151,152,153,154,155];
spaceStr := ' '; {strings used in stringization}
quoteStr := '"';
{set of classes for numeric constants}
numericConstants := [intConstant,longConstant,longlongConstant,doubleConstant];
new(mp); {__LINE__}
mp^.name := @'__LINE__';
@ -3877,7 +3908,7 @@ repeat
intConstant : token.ival := -token.ival;
longConstant : token.lval := -token.lval;
doubleConstant: token.rval := -token.rval;
otherwise: ;
longlongConstant,otherwise: Error(108);
end; {case}
end {if}
else

10
Table.asm
View File

@ -284,7 +284,8 @@ charKinds start character set
charSym start single character symbols
enum ident,0 identifiers
! constants
enum (intconst,uintconst,longconst,ulongconst,doubleconst)
enum (intconst,uintconst,longconst,ulongconst,longlongconst)
enum (ulonglongconst,doubleconst)
enum stringconst
! reserved words
enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)
@ -356,6 +357,8 @@ icp start in-coming priority for expression
dc i1'200' uintconst
dc i1'200' longconst
dc i1'200' ulongconst
dc i1'200' longlongconst
dc i1'200' ulonglongconst
dc i1'200' doubleconst
dc i1'200' stringconst
dc i1'200' _Alignassy
@ -521,6 +524,8 @@ isp start in stack priority for expression
dc i1'0' uintconst
dc i1'0' longconst
dc i1'0' ulongconst
dc i1'0' longlongconst
dc i1'0' ulonglongconst
dc i1'0' doubleconst
dc i1'0' stringconst
dc i1'0' _Alignassy
@ -893,7 +898,8 @@ wordHash start reserved word hash table
enum ident,0 identifiers
! constants
enum (intconst,uintconst,longconst,ulongconst,doubleconst)
enum (intconst,uintconst,longconst,ulongconst,longlongconst)
enum (ulonglongconst,doubleconst)
enum stringconst
! reserved words
enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)