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

Add a new representation of C basic types and use it for type checking.

Browse Source 
This allows us to distinguish int from short, etc.
This commit is contained in:
Stephen Heumann 2020-02-29 22:43:29 -06:00
parent 6c0ec564c6
commit c0b2b44cad
5 changed files with 158 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
CCommon.pas
View File

@ -150,6 +150,14 @@ type
cgReal,cgDouble,cgComp,cgExtended,cgString, cgReal,cgDouble,cgComp,cgExtended,cgString,
cgVoid,ccPointer); cgVoid,ccPointer);
{ Basic types (plus the void type) as defined by the C language. }
{ This differs from baseTypeEnum in that different types with the }
{ same representation are distinguished from each other. }
cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt,
ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp,
ctVoid);
{tokens} {tokens}
{------} {------}
{Note: tokenEnum is duplicated in } {Note: tokenEnum is duplicated in }
@ -266,7 +274,8 @@ type
isConstant: boolean; {is the type a constant?} isConstant: boolean; {is the type a constant?}
saveDisp: longint; {disp in symbol file} saveDisp: longint; {disp in symbol file}
case kind: typeKind of {NOTE: aType,pType and fType must overlap} case kind: typeKind of {NOTE: aType,pType and fType must overlap}
scalarType : (baseType: baseTypeEnum;); scalarType : (baseType: baseTypeEnum; {our internal type representation}
cType: cTypeEnum); {type in the C type system}
arrayType : (aType: typePtr; arrayType : (aType: typePtr;
elements: longint; elements: longint;
); );

50
Expression.pas
View File

@ -374,13 +374,13 @@ if (lType^.kind = scalarType) and (rType^.kind = scalarType) then begin
end {else if} end {else if}
else {one operand is unsigned in and the other is int} begin else {one operand is unsigned in and the other is int} begin
UsualBinaryConversions := cgUWord; UsualBinaryConversions := cgUWord;
expressionType := uWordPtr; expressionType := uIntPtr;
end; {else} end; {else}
end {if} end {if}
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 := wordPtr expressionType := intPtr
else if lt = cgExtended then else if lt = cgExtended then
expressionType := extendedPtr; expressionType := extendedPtr;
end; {else} end; {else}
@ -413,7 +413,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 := wordPtr expressionType := intPtr
else if et = cgExtended then else if et = cgExtended then
expressionType := extendedPtr; expressionType := extendedPtr;
end {if} end {if}
@ -819,7 +819,7 @@ var
{fnPtr^.saveDisp := 0;} {fnPtr^.saveDisp := 0;}
{fnPtr^.isConstant := false;} {fnPtr^.isConstant := false;}
fnPtr^.kind := functionType; fnPtr^.kind := functionType;
fnPtr^.fType := wordPtr; fnPtr^.fType := intPtr;
{fnPtr^.varargs := false;} {fnPtr^.varargs := false;}
{fnPtr^.prototyped := false;} {fnPtr^.prototyped := false;}
{fnPtr^.overrideKR := false;} {fnPtr^.overrideKR := false;}
@ -1722,7 +1722,7 @@ if expressionType^.kind = scalarType then begin
otherwise: otherwise:
Error(47); Error(47);
end; {case} end; {case}
expressionType := wordPtr; expressionType := intPtr;
Gen0t(op, bt); Gen0t(op, bt);
end {if} end {if}
else else
@ -1947,7 +1947,7 @@ var
ip: identPtr; {for scanning for the field} ip: identPtr; {for scanning for the field}
begin {DoSelection} begin {DoSelection}
expressionType := wordPtr; {set defaults in case there is an error} expressionType := intPtr; {set defaults in case there is an error}
size := 0; size := 0;
if tree^.token.class = identifier then begin if tree^.token.class = identifier then begin
while lType^.kind = definedType do while lType^.kind = definedType do
@ -2260,7 +2260,7 @@ var
else if ExpressionKind(tree) in [arrayType,pointerType] then else if ExpressionKind(tree) in [arrayType,pointerType] then
GenerateCode(tree) GenerateCode(tree)
else begin else begin
expressionType := wordPtr; {set default type in case of error} expressionType := intPtr; {set default type in case of error}
if doDispose then {prevent spurious errors} if doDispose then {prevent spurious errors}
Error(78); Error(78);
end; {else} end; {else}
@ -2805,7 +2805,7 @@ case tree^.token.kind of
enumConst: begin enumConst: begin
Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord); Gen1t(pc_ldc, tree^.id^.itype^.eval, cgWord);
expressionType := wordPtr; expressionType := intPtr;
end; end;
end; {case} end; {case}
@ -2816,9 +2816,9 @@ case tree^.token.kind of
lastwasconst := true; lastwasconst := true;
lastconst := tree^.token.ival; lastconst := tree^.token.ival;
if tree^.token.kind = intConst then if tree^.token.kind = intConst then
expressionType := wordPtr expressionType := intPtr
else else
expressionType := uwordPtr; expressionType := uIntPtr;
end; {case intConst} end; {case intConst}
longConst,ulongConst: begin longConst,ulongConst: begin
@ -3134,7 +3134,7 @@ case tree^.token.kind of
else if UsualUnaryConversions = cgExtended then begin else if UsualUnaryConversions = cgExtended then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := wordPtr; expressionType := intPtr;
end; {if} end; {if}
lType := expressionType; lType := expressionType;
GenerateCode(tree^.right); GenerateCode(tree^.right);
@ -3143,7 +3143,7 @@ case tree^.token.kind of
else if UsualUnaryConversions = cgExtended then begin else if UsualUnaryConversions = cgExtended then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := wordPtr; expressionType := intPtr;
end; {if} end; {if}
case UsualBinaryConversions(lType) of case UsualBinaryConversions(lType) of
cgByte,cgUByte,cgWord,cgUWord: cgByte,cgUByte,cgWord,cgUWord:
@ -3153,7 +3153,7 @@ case tree^.token.kind of
otherwise: otherwise:
error(66); error(66);
end; {case} end; {case}
expressionType := wordPtr; expressionType := intPtr;
end; {case barbarop} end; {case barbarop}
andandop: begin {&&} andandop: begin {&&}
@ -3163,7 +3163,7 @@ case tree^.token.kind of
else if UsualUnaryConversions = cgExtended then begin else if UsualUnaryConversions = cgExtended then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := wordPtr; expressionType := intPtr;
end; {if} end; {if}
lType := expressionType; lType := expressionType;
GenerateCode(tree^.right); GenerateCode(tree^.right);
@ -3172,7 +3172,7 @@ case tree^.token.kind of
else if UsualUnaryConversions = cgExtended then begin else if UsualUnaryConversions = cgExtended then begin
GenLdcReal(0.0); GenLdcReal(0.0);
Gen0t(pc_neq, cgExtended); Gen0t(pc_neq, cgExtended);
expressionType := wordPtr; expressionType := intPtr;
end; {if} end; {if}
case UsualBinaryConversions(lType) of case UsualBinaryConversions(lType) of
cgByte,cgUByte,cgWord,cgUWord: cgByte,cgUByte,cgWord,cgUWord:
@ -3182,7 +3182,7 @@ case tree^.token.kind of
otherwise: otherwise:
error(66); error(66);
end; {case} end; {case}
expressionType := wordPtr; expressionType := intPtr;
end; {case andandop} end; {case andandop}
carotch: begin {^} carotch: begin {^}
@ -3472,7 +3472,7 @@ case tree^.token.kind of
Gen0t(pc_equ, UsualBinaryConversions(lType)) Gen0t(pc_equ, UsualBinaryConversions(lType))
else else
Gen0t(pc_neq, UsualBinaryConversions(lType)); Gen0t(pc_neq, UsualBinaryConversions(lType));
expressionType := wordPtr; expressionType := intPtr;
end; {case exceqop,eqeqop} end; {case exceqop,eqeqop}
lteqop, {<=} lteqop, {<=}
@ -3491,7 +3491,7 @@ case tree^.token.kind of
Gen0t(pc_les, UsualBinaryConversions(lType)) Gen0t(pc_les, UsualBinaryConversions(lType))
else {if tree^.token.kind = gtch then} else {if tree^.token.kind = gtch then}
Gen0t(pc_grt, UsualBinaryConversions(lType)); Gen0t(pc_grt, UsualBinaryConversions(lType));
expressionType := wordPtr; expressionType := intPtr;
end; {case lteqop,gteqop,ltch,gtch} end; {case lteqop,gteqop,ltch,gtch}
uminus: begin {unary -} uminus: begin {unary -}
@ -3546,7 +3546,7 @@ case tree^.token.kind of
otherwise: otherwise:
error(66); error(66);
end; {case} end; {case}
expressionType := wordPtr; expressionType := intPtr;
end; {case excch} end; {case excch}
plusplusop: {prefix ++} plusplusop: {prefix ++}
@ -3754,7 +3754,7 @@ if kind = normalExpression then begin {generate code from the expression tree}
GenerateCode(tree); GenerateCode(tree);
end {if} end {if}
else else
expressionType := wordPtr; {set default type in case of error} expressionType := intPtr; {set default type in case of error}
end {if} end {if}
else begin {record the expression for an initializer} else begin {record the expression for an initializer}
initializerTree := tree; initializerTree := tree;
@ -3762,7 +3762,7 @@ else begin {record the expression for an initialize
if errorFound then begin if errorFound then begin
DisposeTree(initializerTree); DisposeTree(initializerTree);
initializerTree := nil; initializerTree := nil;
expressionType := wordPtr; {set default type in case of error} expressionType := intPtr; {set default type in case of error}
end {if} end {if}
else begin else begin
ldoDispose := doDispose; {find the expression type} ldoDispose := doDispose; {find the expression type}
@ -3795,13 +3795,13 @@ else begin {record the expression for an initialize
end; {if} end; {if}
if tree^.token.kind = intconst then begin if tree^.token.kind = intconst then begin
expressionValue := tree^.token.ival; expressionValue := tree^.token.ival;
expressionType := wordPtr; expressionType := intPtr;
isConstant := true; isConstant := true;
end {else if} end {else if}
else if tree^.token.kind = uintconst then begin else if tree^.token.kind = uintconst then begin
expressionValue := tree^.token.ival; expressionValue := tree^.token.ival;
expressionValue := expressionValue & $0000FFFF; expressionValue := expressionValue & $0000FFFF;
expressionType := uwordPtr; expressionType := uIntPtr;
isConstant := true; isConstant := true;
end {else if} end {else if}
else if tree^.token.kind = longconst then begin else if tree^.token.kind = longconst then begin
@ -3819,7 +3819,7 @@ else begin {record the expression for an initialize
expressionType := extendedPtr; expressionType := extendedPtr;
isConstant := true; isConstant := true;
if kind in [arrayExpression,preprocessorExpression] then begin if kind in [arrayExpression,preprocessorExpression] then begin
expressionType := wordPtr; expressionType := intPtr;
expressionValue := 1; expressionValue := 1;
Error(47); Error(47);
end; {if} end; {if}
@ -3829,7 +3829,7 @@ else begin {record the expression for an initialize
expressionType := stringTypePtr; expressionType := stringTypePtr;
isConstant := true; isConstant := true;
if kind in [arrayExpression,preprocessorExpression] then begin if kind in [arrayExpression,preprocessorExpression] then begin
expressionType := wordPtr; expressionType := intPtr;
expressionValue := 1; expressionValue := 1;
Error(47); Error(47);
end; {if} end; {if}

39
Header.pas
View File

@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
{$segment 'SCANNER'} {$segment 'SCANNER'}
const const
symFileVersion = 7; {version number of .sym file format} symFileVersion = 8; {version number of .sym file format}
var var
inhibitHeader: boolean; {should .sym includes be blocked?} inhibitHeader: boolean; {should .sym includes be blocked?}
@ -969,19 +969,19 @@ procedure EndInclude {chPtr: ptr};
begin {WriteType} begin {WriteType}
if tp = bytePtr then if tp = sCharPtr then
WriteByte(2) WriteByte(2)
else if tp = uBytePtr then else if tp = charPtr then
WriteByte(3) WriteByte(3)
else if tp = wordPtr then else if tp = intPtr then
WriteByte(4) WriteByte(4)
else if tp = uWordPtr then else if tp = uIntPtr then
WriteByte(5) WriteByte(5)
else if tp = longPtr then else if tp = longPtr then
WriteByte(6) WriteByte(6)
else if tp = uLongPtr then else if tp = uLongPtr then
WriteByte(7) WriteByte(7)
else if tp = realPtr then else if tp = floatPtr then
WriteByte(8) WriteByte(8)
else if tp = doublePtr then else if tp = doublePtr then
WriteByte(9) WriteByte(9)
@ -995,6 +995,12 @@ procedure EndInclude {chPtr: ptr};
WriteByte(13) WriteByte(13)
else if tp = defaultStruct then else if tp = defaultStruct then
WriteByte(14) WriteByte(14)
else if tp = uCharPtr then
WriteByte(15)
else if tp = shortPtr then
WriteByte(16)
else if tp = uShortPtr then
WriteByte(17)
else if tp^.saveDisp <> 0 then begin else if tp^.saveDisp <> 0 then begin
WriteByte(1); WriteByte(1);
WriteLong(tp^.saveDisp); WriteLong(tp^.saveDisp);
@ -1006,8 +1012,10 @@ procedure EndInclude {chPtr: ptr};
WriteByte(ord(tp^.isConstant)); WriteByte(ord(tp^.isConstant));
WriteByte(ord(tp^.kind)); WriteByte(ord(tp^.kind));
case tp^.kind of case tp^.kind of
scalarType: scalarType: begin
WriteByte(ord(tp^.baseType)); WriteByte(ord(tp^.baseType));
WriteByte(ord(tp^.cType));
end;
arrayType: begin arrayType: begin
WriteLong(tp^.elements); WriteLong(tp^.elements);
@ -1612,8 +1620,10 @@ var
tp^.isConstant := boolean(ReadByte); tp^.isConstant := boolean(ReadByte);
tp^.kind := typeKind(ReadByte); tp^.kind := typeKind(ReadByte);
case tp^.kind of case tp^.kind of
scalarType: scalarType: begin
tp^.baseType := baseTypeEnum(ReadByte); tp^.baseType := baseTypeEnum(ReadByte);
tp^.cType := cTypeEnum(ReadByte);
end;
arrayType: begin arrayType: begin
tp^.elements := ReadLong; tp^.elements := ReadLong;
@ -1676,19 +1686,22 @@ var
end; {if} end; {if}
end; {case 1} end; {case 1}
2: tp := bytePtr; 2: tp := sCharPtr;
3: tp := uBytePtr; 3: tp := charPtr;
4: tp := wordPtr; 4: tp := intPtr;
5: tp := uWordPtr; 5: tp := uIntPtr;
6: tp := longPtr; 6: tp := longPtr;
7: tp := uLongPtr; 7: tp := uLongPtr;
8: tp := realPtr; 8: tp := floatPtr;
9: tp := doublePtr; 9: tp := doublePtr;
10: tp := extendedPtr; 10: tp := extendedPtr;
11: tp := stringTypePtr; 11: tp := stringTypePtr;
12: tp := voidPtr; 12: tp := voidPtr;
13: tp := voidPtrPtr; 13: tp := voidPtrPtr;
14: tp := defaultStruct; 14: tp := defaultStruct;
15: tp := uCharPtr;
16: tp := shortPtr;
17: tp := uShortPtr;
end; {case} end; {case}
end; {ReadType} end; {ReadType}

45
Parser.pas
View File

@ -1862,7 +1862,7 @@ var
else begin else begin
Error(47); Error(47);
errorFound := true; errorFound := true;
Subscript := wordPtr; Subscript := intPtr;
end; {else} end; {else}
end {if} end {if}
else if tree^.token.kind = dotch then begin else if tree^.token.kind = dotch then begin
@ -1879,7 +1879,7 @@ var
else begin else begin
Error(47); Error(47);
errorFound := true; errorFound := true;
Subscript := wordPtr; Subscript := intPtr;
end; {else} end; {else}
end {else if} end {else if}
else if tree^.token.kind = ident then begin else if tree^.token.kind = ident then begin
@ -1887,7 +1887,7 @@ var
if ip = nil then begin if ip = nil then begin
Error(31); Error(31);
errorFound := true; errorFound := true;
Subscript := wordPtr; Subscript := intPtr;
iPtr^.pName := @'?'; iPtr^.pName := @'?';
end {if} end {if}
else begin else begin
@ -1898,7 +1898,7 @@ var
else begin else begin
Error(47); Error(47);
errorFound := true; errorFound := true;
Subscript := wordPtr; Subscript := intPtr;
end; {else} end; {else}
end; {Subscript} end; {Subscript}
@ -2239,7 +2239,7 @@ var
{fill a structure} {fill a structure}
if variable^.storage in [external,global,private] then if variable^.storage in [external,global,private] then
Fill(count * tp^.size, bytePtr) Fill(count * tp^.size, sCharPtr)
else begin else begin
i := count; i := count;
while i <> 0 do begin while i <> 0 do begin
@ -2256,7 +2256,7 @@ var
{fill a union} {fill a union}
if variable^.storage in [external,global,private] then if variable^.storage in [external,global,private] then
Fill(count * tp^.size, bytePtr) Fill(count * tp^.size, sCharPtr)
else else
Fill(count, tp^.fieldList^.iType); Fill(count, tp^.fieldList^.iType);
end {else if} end {else if}
@ -2364,7 +2364,7 @@ var
iPtr^.sval := token.sval; iPtr^.sval := token.sval;
count := tp^.elements - token.sval^.length; count := tp^.elements - token.sval^.length;
if count <> 0 then if count <> 0 then
Fill(count, bytePtr); Fill(count, sCharPtr);
end {if} end {if}
else begin else begin
iPtr^.isConstant := false; iPtr^.isConstant := false;
@ -2477,7 +2477,7 @@ var
end; {if} end; {if}
if count > 0 then if count > 0 then
if variable^.storage in [external,global,private] then if variable^.storage in [external,global,private] then
Fill(count, bytePtr); Fill(count, sCharPtr);
printMacroExpansions := lPrintMacroExpansions; printMacroExpansions := lPrintMacroExpansions;
end {if} end {if}
else {struct/union assignment initializer} else {struct/union assignment initializer}
@ -2767,33 +2767,33 @@ var
if typeSpecifiers = [voidsy] then if typeSpecifiers = [voidsy] then
myTypeSpec := voidPtr myTypeSpec := voidPtr
else if typeSpecifiers = [charsy] then else if typeSpecifiers = [charsy] then
myTypeSpec := uBytePtr myTypeSpec := charPtr
else if typeSpecifiers = [signedsy,charsy] then else if typeSpecifiers = [signedsy,charsy] then
myTypeSpec := bytePtr myTypeSpec := sCharPtr
else if typeSpecifiers = [unsignedsy,charsy] then else if typeSpecifiers = [unsignedsy,charsy] then
myTypeSpec := uBytePtr myTypeSpec := uCharPtr
else if (typeSpecifiers = [shortsy]) else if (typeSpecifiers = [shortsy])
or (typeSpecifiers = [signedsy,shortsy]) or (typeSpecifiers = [signedsy,shortsy])
or (typeSpecifiers = [shortsy,intsy]) or (typeSpecifiers = [shortsy,intsy])
or (typeSpecifiers = [signedsy,shortsy,intsy]) then or (typeSpecifiers = [signedsy,shortsy,intsy]) then
myTypeSpec := wordPtr myTypeSpec := shortPtr
else if (typeSpecifiers = [unsignedsy,shortsy]) else if (typeSpecifiers = [unsignedsy,shortsy])
or (typeSpecifiers = [unsignedsy,shortsy,intsy]) then or (typeSpecifiers = [unsignedsy,shortsy,intsy]) then
myTypeSpec := uWordPtr myTypeSpec := uShortPtr
else if (typeSpecifiers = [intsy]) else if (typeSpecifiers = [intsy])
or (typeSpecifiers = [signedsy]) or (typeSpecifiers = [signedsy])
or (typeSpecifiers = [signedsy,intsy]) then begin or (typeSpecifiers = [signedsy,intsy]) then begin
if unix_1 then if unix_1 then
myTypeSpec := longPtr myTypeSpec := longPtr
else else
myTypeSpec := wordPtr; myTypeSpec := intPtr;
end {else if} end {else if}
else if (typeSpecifiers = [unsignedsy]) else if (typeSpecifiers = [unsignedsy])
or (typeSpecifiers = [unsignedsy,intsy]) then begin or (typeSpecifiers = [unsignedsy,intsy]) then begin
if unix_1 then if unix_1 then
myTypeSpec := uLongPtr myTypeSpec := uLongPtr
else else
myTypeSpec := uWordPtr; myTypeSpec := uIntPtr;
end {else if} end {else if}
else if (typeSpecifiers = [longsy]) else if (typeSpecifiers = [longsy])
or (typeSpecifiers = [signedsy,longsy]) or (typeSpecifiers = [signedsy,longsy])
@ -2804,18 +2804,17 @@ var
or (typeSpecifiers = [unsignedsy,longsy,intsy]) then or (typeSpecifiers = [unsignedsy,longsy,intsy]) then
myTypeSpec := uLongPtr myTypeSpec := uLongPtr
else if typeSpecifiers = [floatsy] then else if typeSpecifiers = [floatsy] then
myTypeSpec := realPtr myTypeSpec := floatPtr
else if typeSpecifiers = [doublesy] then else if typeSpecifiers = [doublesy] then
myTypeSpec := doublePtr myTypeSpec := doublePtr
else if typeSpecifiers = [longsy,doublesy] then else if (typeSpecifiers = [longsy,doublesy])
or (typeSpecifiers = [extendedsy]) then
myTypeSpec := extendedPtr myTypeSpec := extendedPtr
else if typeSpecifiers = [compsy] then else if typeSpecifiers = [compsy] then
myTypeSpec := compPtr myTypeSpec := compPtr
else if typeSpecifiers = [extendedsy] then
myTypeSpec := extendedPtr
else if typeSpecifiers = [_Boolsy] then begin else if typeSpecifiers = [_Boolsy] then begin
Error(135); Error(135);
myTypeSpec := wordPtr; myTypeSpec := intPtr;
end {else if} end {else if}
else else
UnexpectedTokenError(expectedNext); UnexpectedTokenError(expectedNext);
@ -3009,7 +3008,7 @@ while token.kind in allowedTokens do begin
end; {else} end; {else}
end; {if} end; {if}
1: mySkipDeclarator := token.kind = semicolonch; 1: mySkipDeclarator := token.kind = semicolonch;
myTypeSpec := wordPtr; myTypeSpec := intPtr;
typeDone := true; typeDone := true;
end; end;
@ -3147,7 +3146,7 @@ skipDeclarator := mySkipDeclarator;
typeSpec := myTypeSpec; typeSpec := myTypeSpec;
declarationModifiers := myDeclarationModifiers; declarationModifiers := myDeclarationModifiers;
if typeSpec = nil then begin if typeSpec = nil then begin
typeSpec := wordPtr; {under C89, default type is int} typeSpec := intPtr; {under C89, default type is int}
if (lint & lintC99Syntax) <> 0 then if (lint & lintC99Syntax) <> 0 then
Error(151); Error(151);
end; {if} end; {if}
@ -3592,7 +3591,7 @@ if isFunction then begin
tlp := lp; tlp := lp;
while tlp <> nil do begin while tlp <> nil do begin
if tlp^.itype = nil then begin if tlp^.itype = nil then begin
tlp^.itype := wordPtr; tlp^.itype := intPtr;
if (lint & lintC99Syntax) <> 0 then if (lint & lintC99Syntax) <> 0 then
if (lint & lintNotPrototyped) = 0 then if (lint & lintNotPrototyped) = 0 then
Error(147); {C99+ require K&R params to be declared} Error(147); {C99+ require K&R params to be declared}

108
Symbol.pas
View File

@ -25,17 +25,19 @@
{ noDeclarations - have we declared anything at this level? } { noDeclarations - have we declared anything at this level? }
{ table - current symbol table } { table - current symbol table }
{ } { }
{ bytePtr - pointer to the base type for bytes } { charPtr - pointer to the base type for char }
{ uBytePtr - pointer to the base type for unsigned bytes } { sCharPtr - pointer to the base type for signed char }
{ wordPtr - pointer to the base type for words } { uCharPtr - pointer to the base type for unsigned char }
{ uWordPtr - pointer to the base type for unsigned words } { shortPtr - pointer to the base type for short }
{ longPtr - pointer to the base type for long words } { uShortPtr - pointer to the base type for unsigned short }
{ uLongPtr - pointer to the base type for unsigned long words } { intPtr - pointer to the base type for int }
{ realPtr - pointer to the base type for reals } { uIntPtr - pointer to the base type for unsigned int }
{ doublePtr - pointer to the base type for double precision } { longPtr - pointer to the base type for long }
{ reals } { uLongPtr - pointer to the base type for unsigned long }
{ compPtr - pointer to the base type for comp reals } { floatPtr - pointer to the base type for float }
{ extendedPtr - pointer to the base type for extended reals } { doublePtr - pointer to the base type for double }
{ compPtr - pointer to the base type for comp }
{ extendedPtr - pointer to the base type for extended }
{ voidPtr - pointer to the base type for void } { voidPtr - pointer to the base type for void }
{ voidPtrPtr - typeless pointer, for some type casting } { voidPtrPtr - typeless pointer, for some type casting }
{ stringTypePtr - pointer to the base type for string } { stringTypePtr - pointer to the base type for string }
@ -69,9 +71,10 @@ var
noDeclarations: boolean; {have we declared anything at this level?} noDeclarations: boolean; {have we declared anything at this level?}
table: symbolTablePtr; {current symbol table} table: symbolTablePtr; {current symbol table}
globalTable: symbolTablePtr; {global symbol table} globalTable: symbolTablePtr; {global symbol table}
bytePtr,uBytePtr,wordPtr,uWordPtr, {base types} {base types}
longPtr,uLongPtr,realPtr,doublePtr,compPtr,extendedPtr, charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr,
longPtr,uLongPtr,floatPtr,doublePtr,compPtr,extendedPtr,
stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr; stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr;
{---------------------------------------------------------------} {---------------------------------------------------------------}
@ -381,9 +384,10 @@ else
scalarType: scalarType:
if kind2 = scalarType then if kind2 = scalarType then
CompTypes := t1^.baseType = t2^.baseType CompTypes :=
(t1^.baseType = t2^.baseType) and (t1^.cType = t2^.cType)
else if kind2 = enumType then else if kind2 = enumType then
CompTypes := t1^.baseType = cgWord; CompTypes := (t1^.baseType = cgWord) and (t1^.cType = ctInt);
arrayType: arrayType:
if kind2 = arrayType then begin if kind2 = arrayType then begin
@ -417,7 +421,7 @@ else
enumType: enumType:
if kind2 = scalarType then if kind2 = scalarType then
CompTypes := t2^.baseType = cgWord CompTypes := (t2^.baseType = cgWord) and (t2^.cType = ctInt)
else if kind2 = enumType then else if kind2 = enumType then
CompTypes := true; CompTypes := true;
@ -986,7 +990,7 @@ var
case tp^.kind of case tp^.kind of
scalarType: WriteScalarType(tp, $80, subscripts); scalarType: WriteScalarType(tp, $80, subscripts);
enumType, enumType,
functionType: WriteScalarType(wordPtr, $80, subscripts); functionType: WriteScalarType(intPtr, $80, subscripts);
otherwise: begin otherwise: begin
CnOut(11); CnOut(11);
CnOut2(subscripts); CnOut2(subscripts);
@ -1050,7 +1054,7 @@ var
else else
WriteScalarType(tp2, 0, count) WriteScalarType(tp2, 0, count)
else if tp2^.kind = enumType then else if tp2^.kind = enumType then
WriteScalarType(wordPtr, 0, count) WriteScalarType(intPtr, 0, count)
else if tp2^.kind = pointerType then else if tp2^.kind = pointerType then
WritePointerType(tp2, count) WritePointerType(tp2, count)
else begin else begin
@ -1133,7 +1137,7 @@ var
WriteAddress(ip); {write the address field} WriteAddress(ip); {write the address field}
case tPtr^.kind of case tPtr^.kind of
scalarType: WriteScalarType(tPtr, 0, 0); scalarType: WriteScalarType(tPtr, 0, 0);
enumType: WriteScalarType(wordPtr, 0, 0); enumType: WriteScalarType(intPtr, 0, 0);
pointerType: begin pointerType: begin
WritePointerType(tPtr, 0); WritePointerType(tPtr, 0);
ExpandPointerType(tPtr); ExpandPointerType(tPtr);
@ -1192,37 +1196,68 @@ PushTable;
globalTable := table; globalTable := table;
noDeclarations := false; noDeclarations := false;
{declare base types} {declare base types}
new(bytePtr); {byte} new(sCharPtr); {signed char}
with bytePtr^ do begin with sCharPtr^ do begin
size := cgByteSize; size := cgByteSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgByte; baseType := cgByte;
cType := ctSChar;
end; {with} end; {with}
new(uBytePtr); {unsigned byte} new(charPtr); {char}
with uBytePtr^ do begin with charPtr^ do begin
size := cgByteSize; size := cgByteSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgUByte; baseType := cgUByte;
cType := ctChar;
end; {with} end; {with}
new(wordPtr); {word} new(uCharPtr); {unsigned char}
with wordPtr^ do begin with uCharPtr^ do begin
size := cgByteSize;
saveDisp := 0;
isConstant := false;
kind := scalarType;
baseType := cgUByte;
cType := ctUChar;
end; {with}
new(shortPtr); {short}
with shortPtr^ do begin
size := cgWordSize; size := cgWordSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgWord; baseType := cgWord;
cType := ctShort;
end; {with} end; {with}
new(uWordPtr); {unsigned word} new(uShortPtr); {unsigned short}
with uWordPtr^ do begin with uShortPtr^ do begin
size := cgWordSize; size := cgWordSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgUWord; baseType := cgUWord;
cType := ctUShort;
end; {with}
new(intPtr); {int}
with intPtr^ do begin
size := cgWordSize;
saveDisp := 0;
isConstant := false;
kind := scalarType;
baseType := cgWord;
cType := ctInt;
end; {with}
new(uIntPtr); {unsigned int}
with uIntPtr^ do begin
size := cgWordSize;
saveDisp := 0;
isConstant := false;
kind := scalarType;
baseType := cgUWord;
cType := ctUInt;
end; {with} end; {with}
new(longPtr); {long} new(longPtr); {long}
with longPtr^ do begin with longPtr^ do begin
@ -1231,6 +1266,7 @@ with longPtr^ do begin
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgLong; baseType := cgLong;
cType := ctLong;
end; {with} end; {with}
new(uLongPtr); {unsigned long} new(uLongPtr); {unsigned long}
with uLongPtr^ do begin with uLongPtr^ do begin
@ -1239,14 +1275,16 @@ with uLongPtr^ do begin
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgULong; baseType := cgULong;
cType := ctULong;
end; {with} end; {with}
new(realPtr); {real} new(floatPtr); {real}
with realPtr^ do begin with floatPtr^ do begin
size := cgRealSize; size := cgRealSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgReal; baseType := cgReal;
cType := ctFloat;
end; {with} end; {with}
new(doublePtr); {double} new(doublePtr); {double}
with doublePtr^ do begin with doublePtr^ do begin
@ -1255,6 +1293,7 @@ with doublePtr^ do begin
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgDouble; baseType := cgDouble;
cType := ctDouble;
end; {with} end; {with}
new(compPtr); {comp} new(compPtr); {comp}
with compPtr^ do begin with compPtr^ do begin
@ -1263,14 +1302,16 @@ with compPtr^ do begin
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgComp; baseType := cgComp;
cType := ctComp;
end; {with} end; {with}
new(extendedPtr); {extended} new(extendedPtr); {extended, aka long double}
with extendedPtr^ do begin with extendedPtr^ do begin
size := cgExtendedSize; size := cgExtendedSize;
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgExtended; baseType := cgExtended;
cType := ctLongDouble;
end; {with} end; {with}
new(stringTypePtr); {string constant type} new(stringTypePtr); {string constant type}
with stringTypePtr^ do begin with stringTypePtr^ do begin
@ -1278,7 +1319,7 @@ with stringTypePtr^ do begin
saveDisp := 0; saveDisp := 0;
isConstant := false; isConstant := false;
kind := arrayType; kind := arrayType;
aType := uBytePtr; aType := charPtr;
elements := 1; elements := 1;
end; {with} end; {with}
new(voidPtr); {void} new(voidPtr); {void}
@ -1288,6 +1329,7 @@ with voidPtr^ do begin
isConstant := false; isConstant := false;
kind := scalarType; kind := scalarType;
baseType := cgVoid; baseType := cgVoid;
cType := ctVoid;
end; {with} end; {with}
new(voidPtrPtr); {typeless pointer} new(voidPtrPtr); {typeless pointer}
with voidPtrPtr^ do begin with voidPtrPtr^ do begin
@ -1308,7 +1350,7 @@ with defaultStruct^ do begin {(for structures with errors)}
with fieldlist^ do begin with fieldlist^ do begin
next := nil; next := nil;
name := @'field'; name := @'field';
itype := wordPtr; itype := intPtr;
class := ident; class := ident;
state := declared; state := declared;
disp := 0; disp := 0;