mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-05-28 12:41:35 +00:00
979852be3c
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.
4592 lines
167 KiB
ObjectPascal
4592 lines
167 KiB
ObjectPascal
{$optimize 1}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ Parser }
|
|
{ }
|
|
{ External Subroutines: }
|
|
{ }
|
|
{ DoDeclaration - process a variable or function declaration }
|
|
{ DoStatement - process a statement from a function }
|
|
{ AutoInit - generate code to initialize an auto variable }
|
|
{ InitParser - initialize the parser }
|
|
{ Match - insure that the next token is of the specified type }
|
|
{ TermParser - shut down the parser }
|
|
{ DeclarationSpecifiers - handle a type specifier }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit Parser;
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
interface
|
|
|
|
uses CCommon, Table, MM, CGI, Scanner, Header, Symbol, Expression, Asm;
|
|
|
|
{$segment 'parser'}
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure DoDeclaration (doingPrototypes: boolean);
|
|
|
|
{ process a variable or function declaration }
|
|
{ }
|
|
{ parameters: }
|
|
{ doingPrototypes - are we processing a parameter list? }
|
|
|
|
|
|
procedure DoStatement;
|
|
|
|
{ process a statement from a function }
|
|
|
|
|
|
procedure TypeName;
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ outputs: }
|
|
{ typeSpec - pointer to the type }
|
|
|
|
|
|
procedure AutoInit (variable: identPtr; line: integer);
|
|
|
|
{ generate code to initialize an auto variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - the variable to initialize }
|
|
{ line - line number (used for debugging) }
|
|
|
|
|
|
function MakeFuncIdentifier: identPtr;
|
|
|
|
{ Make the predefined identifier __func__. }
|
|
{ }
|
|
{ It is inserted in the symbol table as if the following }
|
|
{ declaration appeared at the beginning of the function body: }
|
|
{ }
|
|
{ static const char __func__[] = "function-name"; }
|
|
{ }
|
|
{ This must only be called within a function body. }
|
|
|
|
|
|
procedure InitParser;
|
|
|
|
{ Initialize the parser }
|
|
|
|
|
|
procedure Match (kind: tokenEnum; err: integer);
|
|
|
|
{ insure that the next token is of the specified type }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - expected token kind }
|
|
{ err - error number if the expected token is not found }
|
|
|
|
|
|
procedure TermParser;
|
|
|
|
{ shut down the parser }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
const
|
|
maxBitField = 32; {max # of bits in a bit field}
|
|
|
|
type
|
|
|
|
identList = ^identNode; {list of ids; used for initializers}
|
|
identNode = record
|
|
next: identList;
|
|
id: identPtr;
|
|
end;
|
|
|
|
{ The switch record is used to record the values for the }
|
|
{ switch jump table. The linked list of entries is in order }
|
|
{ of increasing switch value (val). }
|
|
|
|
switchPtr = ^switchRecord; {switch label table entry}
|
|
switchRecord = record
|
|
next,last: switchPtr; {doubly linked list (for inserts)}
|
|
lab: integer; {label to branch to}
|
|
val: longlong; {switch value}
|
|
end;
|
|
|
|
{token stack}
|
|
{-----------}
|
|
tokenStackPtr = ^tokenStackRecord;
|
|
tokenStackRecord = record
|
|
next: tokenStackPtr;
|
|
token: tokenType;
|
|
end;
|
|
{statement stack}
|
|
{---------------}
|
|
statementPtr = ^statementRecord;
|
|
{kinds of nestable statements}
|
|
statementKind = (compoundSt,ifSt,elseSt,doSt,whileSt,forSt,switchSt);
|
|
statementRecord = record {element of the statement stack}
|
|
next: statementPtr; {next element on the stack}
|
|
breakLab, continueLab: integer; {branch points for break, continue}
|
|
case kind: statementKind of
|
|
compoundSt: (
|
|
doingDeclaration: boolean; {doing declarations? (or statements)}
|
|
lFenvAccess: boolean; {previous value of fenvAccess just}
|
|
);
|
|
ifSt: (
|
|
ifLab: integer; {branch point}
|
|
);
|
|
elseSt: (
|
|
elseLab: integer; {branch point}
|
|
);
|
|
doSt: (
|
|
doLab: integer; {branch point}
|
|
);
|
|
whileSt: (
|
|
whileTop: integer; {label at top of while loop}
|
|
whileEnd: integer; {label at bottom of while loop}
|
|
);
|
|
forSt: (
|
|
forLoop: integer; {branch here to loop}
|
|
e3List: tokenStackPtr; {tokens for last expression}
|
|
);
|
|
switchSt: (
|
|
maxVal: longint; {max switch value}
|
|
ln: integer; {temp var number}
|
|
size: integer; {temp var size}
|
|
labelCount: integer; {# of switch labels}
|
|
switchExit: integer; {branch point}
|
|
switchLab: integer; {branch point}
|
|
switchList: switchPtr; {list of labels and values}
|
|
switchDefault: integer; {default branch point}
|
|
);
|
|
end;
|
|
|
|
var
|
|
firstCompoundStatement: boolean; {are we doing a function level compound statement?}
|
|
fType: typePtr; {return type of the current function}
|
|
functionName: stringPtr; {name of the current function}
|
|
isForwardDeclared: boolean; {is the field list component }
|
|
{ referencing a forward struct/union? }
|
|
isFunction: boolean; {is the declaration a function?}
|
|
isPascal: boolean; {has the pascal modifier been used?}
|
|
{ (set by DoDeclaration)}
|
|
returnLabel: integer; {label for exit point}
|
|
skipDeclarator: boolean; {for enum,struct,union with no declarator}
|
|
statementList: statementPtr; {list of open statements}
|
|
savedVolatile: boolean; {saved copy of volatile}
|
|
doingForLoopClause1: boolean; {doing the first clause of a for loop?}
|
|
|
|
{parameter processing variables}
|
|
{------------------------------}
|
|
lastParameter: identPtr; {next parameter to process}
|
|
numberOfParameters: integer; {number of indeclared parameters}
|
|
pfunc: identPtr; {func. for which parms are being defined}
|
|
protoType: typePtr; {type from a parameter list}
|
|
protoVariable: identPtr; {variable from a parameter list}
|
|
|
|
{type info for the current declaration}
|
|
{-------------------------------------}
|
|
storageClass: tokenEnum; {storage class of the declaration}
|
|
{ typeSpec: typePtr; (in CCommon) {type specifier}
|
|
declarationModifiers: tokenSet; {all storage class specifiers, type }
|
|
{qualifiers, function specifiers, & }
|
|
{alignment specifiers in declaration}
|
|
|
|
{syntactic classes of tokens}
|
|
{---------------------------}
|
|
{ specifierQualifierListElement: tokenSet; (in CCommon)}
|
|
{ topLevelDeclarationStart: tokenSet; (in CCommon)}
|
|
localDeclarationStart: tokenSet;
|
|
declarationSpecifiersElement: tokenSet;
|
|
structDeclarationStart: tokenSet;
|
|
|
|
{-- External procedures ----------------------------------------}
|
|
|
|
function slt64(a,b: longlong): boolean; extern;
|
|
|
|
function sgt64(a,b: longlong): boolean; extern;
|
|
|
|
{-- Parser Utility Procedures ----------------------------------}
|
|
|
|
procedure Match {kind: tokenEnum; err: integer};
|
|
|
|
{ insure that the next token is of the specified type }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - expected token kind }
|
|
{ err - error number if the expected token is not found }
|
|
|
|
begin {Match}
|
|
if token.kind = kind then
|
|
NextToken
|
|
else
|
|
Error(err);
|
|
end; {Match}
|
|
|
|
|
|
procedure SkipStatement;
|
|
|
|
{ Skip the remainder of the current statement }
|
|
|
|
var
|
|
bracketCount: integer; {for error skip}
|
|
|
|
begin {SkipStatement}
|
|
bracketCount := 0;
|
|
while (token.kind <> eofsy) and
|
|
((token.kind <> semicolonch) or (bracketCount <> 0)) do begin
|
|
if token.kind = lbrackch then
|
|
bracketCount := bracketCount+1;
|
|
if token.kind = rbrackch then
|
|
if bracketCount <> 0 then
|
|
bracketCount := bracketCount-1;
|
|
NextToken;
|
|
end; {while}
|
|
if token.kind = semicolonch then
|
|
NextToken;
|
|
end; {SkipStatement}
|
|
|
|
|
|
procedure GotoLabel (op: pcodes);
|
|
|
|
{ Find a label in the goto label list, creating one if one }
|
|
{ does not already exist. Generate the label or a jump to it }
|
|
{ based on op. }
|
|
{ }
|
|
{ parameters: }
|
|
{ op - operation code to create }
|
|
|
|
label 1;
|
|
|
|
var
|
|
gt: gotoPtr; {work pointer}
|
|
|
|
begin {GotoLabel}
|
|
gt := gotoList; {try to find an existing label}
|
|
while gt <> nil do begin
|
|
if gt^.name^ = token.name^ then
|
|
goto 1;
|
|
gt := gt^.next;
|
|
end; {while}
|
|
gt := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one}
|
|
gt^.next := gotoList;
|
|
gotoList := gt;
|
|
gt^.name := token.name;
|
|
gt^.lab := GenLabel;
|
|
gt^.defined := false;
|
|
1:
|
|
if op = dc_lab then begin
|
|
if gt^.defined then
|
|
Error(77)
|
|
else begin
|
|
gt^.defined := true;
|
|
Gen1(dc_lab, gt^.lab);
|
|
end; {else}
|
|
end {if}
|
|
else
|
|
Gen1(pc_ujp, gt^.lab);
|
|
end; {GotoLabel}
|
|
|
|
|
|
{-- Statements -------------------------------------------------}
|
|
|
|
procedure CompoundStatement (makeSymbols: boolean);
|
|
|
|
{ handle a compound statement }
|
|
{ }
|
|
{ Parameters: }
|
|
{ makeSymbols - create a symbol table? (False for a }
|
|
{ function's outer wrapper, true for imbedded statements) }
|
|
|
|
var
|
|
stPtr: statementPtr; {for creating a compound statement record}
|
|
|
|
begin {CompoundStatement}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.lFenvAccess := fenvAccess; {save existing value of fenvAccess}
|
|
Match(lbracech,27); {make sure there is an opening '{'}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := compoundSt;
|
|
if makeSymbols then {create a symbol table}
|
|
PushTable;
|
|
stPtr^.doingDeclaration := true; {allow declarations}
|
|
end; {CompoundStatement}
|
|
|
|
|
|
procedure EndCompoundStatement;
|
|
|
|
{ finish off a compound statement }
|
|
|
|
var
|
|
dumpLocal: boolean; {dump the local memory pool?}
|
|
tl: tempPtr; {work pointer}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndCompoundStatement}
|
|
dumpLocal := false;
|
|
stPtr := statementList; {pop the statement record}
|
|
statementList := stPtr^.next;
|
|
doingFunction := statementList <> nil; {see if we're done with the function}
|
|
if not doingFunction then begin {if so, finish it off}
|
|
if doingMain then begin {executing to the end of main returns 0}
|
|
if fType^.kind = scalarType then begin
|
|
if fType^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
Gen1t(pc_ldc, 0, fType^.baseType);
|
|
Gen2t(pc_str, 0, 0, fType^.baseType);
|
|
end {if}
|
|
else if fType^.baseType in [cgLong,cgULong] then begin
|
|
GenLdcLong(0);
|
|
Gen2t(pc_str, 0, 0, fType^.baseType);
|
|
end; {else if}
|
|
end {if}
|
|
else if fType^.kind = enumType then begin
|
|
Gen1t(pc_ldc, 0, cgWord);
|
|
Gen2t(pc_str, 0, 0, cgWord);
|
|
end; {else if}
|
|
end; {if}
|
|
Gen1(dc_lab, returnLabel);
|
|
with fType^ do {generate the pc_ret instruction}
|
|
case kind of
|
|
scalarType : Gen0t(pc_ret, baseType);
|
|
arrayType : ;
|
|
structType ,
|
|
unionType ,
|
|
pointerType : Gen0t(pc_ret, cgULong);
|
|
functionType: ;
|
|
enumConst : ;
|
|
enumType : Gen0t(pc_ret, cgWord);
|
|
definedType : ;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
Gen0 (dc_enp); {finish the segment}
|
|
CheckGotoList; {make sure all labels are declared}
|
|
while tempList <> nil do begin {dump the local labels}
|
|
tl := tempList;
|
|
tempList := tl^.next;
|
|
dispose(tl);
|
|
end; {while}
|
|
dumpLocal := true; {dump the local pool}
|
|
nameFound := false; {no pc_nam for the next function (yet)}
|
|
volatile := savedVolatile; {local volatile vars are out of scope}
|
|
fIsNoreturn := false; {not doing a noreturn function}
|
|
functionTable := nil;
|
|
functionName := nil;
|
|
end; {if}
|
|
PopTable; {remove this symbol table}
|
|
fenvAccess := stPtr^.lFenvAccess; {restore old value of fenvAccess}
|
|
dispose(stPtr); {dump the record}
|
|
if dumpLocal then begin
|
|
useGlobalPool := true; {start using the global memory pool}
|
|
LInit; {dispose of the local memory pool}
|
|
end; {if}
|
|
NextToken; {remove the rbracech token}
|
|
end; {EndCompoundStatement}
|
|
|
|
|
|
procedure Statement;
|
|
|
|
{ handle a statement }
|
|
|
|
label 1;
|
|
|
|
var
|
|
lToken,tToken: tokenType; {for look-ahead}
|
|
lPrintMacroExpansions: boolean; {local copy of printMacroExpansions}
|
|
|
|
|
|
function GetSwitchRecord: statementPtr;
|
|
|
|
{ Find the enclosing switch statement }
|
|
{ }
|
|
{ Returns a pointer to the closest switch statement record, }
|
|
{ or nil if there are none. }
|
|
|
|
label 1;
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {GetSwitchRecord}
|
|
stPtr := statementList;
|
|
while stPtr <> nil do begin
|
|
if stPtr^.kind = switchSt then
|
|
goto 1;
|
|
stPtr := stPtr^.next;
|
|
end; {while}
|
|
1: GetSwitchRecord := stPtr;
|
|
end; {GetSwitchRecord}
|
|
|
|
|
|
procedure AssignmentStatement;
|
|
|
|
{ handle an assignment statement }
|
|
|
|
begin {AssignmentStatement}
|
|
if token.kind in startExpression then begin
|
|
Expression(normalExpression, [semicolonch]);
|
|
if expressionType^.baseType <> cgVoid then
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
if token.kind = semicolonch then
|
|
NextToken
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
NextToken;
|
|
Error(92);
|
|
end; {else}
|
|
end; {AssignmentStatement}
|
|
|
|
|
|
procedure BreakStatement;
|
|
|
|
{ handle a break statement }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {BreakStatement}
|
|
stPtr := statementList; {find the proper statement}
|
|
while stPtr <> nil do begin
|
|
if stPtr^.kind in [whileSt,doSt,forSt,switchSt] then
|
|
goto 1;
|
|
stPtr := stPtr^.next;
|
|
end; {while}
|
|
Error(76);
|
|
goto 2;
|
|
|
|
1: if stPtr^.breakLab = 0 then {if there is no break label, create one}
|
|
stPtr^.breakLab := GenLabel;
|
|
Gen1(pc_ujp, stPtr^.breakLab); {branch to the break label}
|
|
2:
|
|
NextToken; {skip the 'break' token}
|
|
Match(semicolonch,22); {insist on a closing ';'}
|
|
end; {BreakStatement}
|
|
|
|
|
|
procedure CaseStatement;
|
|
|
|
{ handle a case statement }
|
|
|
|
var
|
|
stPtr: statementPtr; {switch record for this case label}
|
|
swPtr,swPtr2: switchPtr; {work pointers for inserting new entry}
|
|
val: longlong; {case label value}
|
|
|
|
begin {CaseStatement}
|
|
while token.kind = casesy do begin
|
|
NextToken; {skip the 'case' token}
|
|
stPtr := GetSwitchRecord; {get the proper switch record}
|
|
Expression(arrayExpression, [colonch]); {evaluate the branch condition}
|
|
GetLLExpressionValue(val);
|
|
if stPtr^.size = cgLongSize then begin {convert out-of-range values}
|
|
if val.lo < 0 then
|
|
val.hi := -1
|
|
else
|
|
val.hi := 0;
|
|
end {if}
|
|
else if stPtr^.size = cgWordSize then begin
|
|
if long(val.lo).lsw < 0 then begin
|
|
val.hi := -1;
|
|
val.lo := val.lo | $FFFF0000;
|
|
end {if}
|
|
else begin
|
|
val.hi := 0;
|
|
val.lo := val.lo & $0000FFFF;
|
|
end; {else}
|
|
end; {else if}
|
|
if stPtr = nil then
|
|
Error(72)
|
|
else begin
|
|
new(swPtr2); {create the new label table entry}
|
|
swPtr2^.lab := GenLabel;
|
|
Gen1(dc_lab, swPtr2^.lab);
|
|
swPtr2^.val := val;
|
|
swPtr := stPtr^.switchList;
|
|
if val.lo > stPtr^.maxVal then
|
|
stPtr^.maxVal := val.lo;
|
|
if swPtr = nil then begin {enter it in the table}
|
|
swPtr2^.last := nil;
|
|
swPtr2^.next := nil;
|
|
stPtr^.switchList := swPtr2;
|
|
stPtr^.labelCount := 1;
|
|
end {if}
|
|
else begin
|
|
while (swPtr^.next <> nil) and slt64(swPtr^.val, val) do
|
|
swPtr := swPtr^.next;
|
|
if (swPtr^.val.lo = val.lo) and (swPtr^.val.hi = val.hi) then
|
|
Error(73)
|
|
else if sgt64(swPtr^.val, val) then begin
|
|
swPtr2^.next := swPtr;
|
|
if swPtr^.last = nil then
|
|
stPtr^.switchList := swPtr2
|
|
else
|
|
swPtr^.last^.next := swPtr2;
|
|
swPtr2^.last := swPtr^.last;
|
|
swPtr^.last := swPtr2;
|
|
end {else if}
|
|
else begin {at end of list}
|
|
swPtr2^.next := nil;
|
|
swPtr2^.last := swPtr;
|
|
swPtr^.next := swPtr2;
|
|
end; {else}
|
|
stPtr^.labelCount := stPtr^.labelCount + 1;
|
|
end; {else}
|
|
end; {else}
|
|
|
|
Match(colonch,29); {get the colon}
|
|
end; {while}
|
|
Statement; {process the labeled statement}
|
|
end; {CaseStatement}
|
|
|
|
|
|
procedure ContinueStatement;
|
|
|
|
{ handle a continue statement }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {ContinueStatement}
|
|
stPtr := statementList; {find the proper statement}
|
|
while stPtr <> nil do begin
|
|
if stPtr^.kind in [whileSt,doSt,forSt] then
|
|
goto 1;
|
|
stPtr := stPtr^.next;
|
|
end; {while}
|
|
Error(75);
|
|
goto 2;
|
|
|
|
1: if stPtr^.continueLab = 0 then {if there is no continue label, create one}
|
|
stPtr^.continueLab := GenLabel;
|
|
Gen1(pc_ujp, stPtr^.continueLab); {branch to the continue label}
|
|
2:
|
|
NextToken; {skip the 'continue' token}
|
|
Match(semicolonch,22); {insist on a closing ';'}
|
|
end; {ContinueStatement}
|
|
|
|
|
|
procedure DefaultStatement;
|
|
|
|
{ handle a default statement }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {DefaultStatement}
|
|
NextToken; {skip the 'default' token}
|
|
Match(colonch,29); {get the colon}
|
|
stPtr := GetSwitchRecord; {record the presense of a default label}
|
|
if stPtr = nil then
|
|
Error(72)
|
|
else if stPtr^.switchDefault <> 0 then
|
|
Error(74)
|
|
else begin
|
|
stPtr^.switchDefault := GenLabel;
|
|
Gen1(dc_lab, stPtr^.switchDefault);
|
|
end; {else}
|
|
Statement; {process the labeled statement}
|
|
end; {DefaultStatement}
|
|
|
|
|
|
procedure DoStatement;
|
|
|
|
{ handle a do statement }
|
|
|
|
var
|
|
lab: integer; {branch label}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {DoStatement}
|
|
NextToken; {skip the 'do' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := doSt;
|
|
lab := GenLabel; {create the branch label}
|
|
Gen1(dc_lab, lab);
|
|
stPtr^.doLab := lab;
|
|
stPtr^.breakLab := 0;
|
|
stPtr^.continueLab := 0;
|
|
if c99Scope then PushTable;
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {DoStatement}
|
|
|
|
|
|
procedure ForStatement;
|
|
|
|
{ handle a for statement }
|
|
|
|
var
|
|
errorFound: boolean; {did we find an error?}
|
|
forLoop, continueLab, breakLab: integer; {branch points}
|
|
lType: typePtr; {type of "left" expression}
|
|
parencount: integer; {number of unmatched '(' chars}
|
|
stPtr: statementPtr; {work pointer}
|
|
tl,tk: tokenStackPtr; {for forming expression list}
|
|
|
|
begin {ForStatement}
|
|
NextToken; {skip the 'for' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := forSt;
|
|
forLoop := GenLabel; {create the branch labels}
|
|
continueLab := GenLabel;
|
|
breakLab := GenLabel;
|
|
stPtr^.forLoop := forLoop;
|
|
stPtr^.continueLab := continueLab;
|
|
stPtr^.breakLab := breakLab;
|
|
|
|
if c99Scope then PushTable;
|
|
Match(lparench,13); {evaluate the start condition}
|
|
if allowMixedDeclarations and (token.kind in localDeclarationStart) then begin
|
|
doingForLoopClause1 := true;
|
|
DoDeclaration(false);
|
|
doingForLoopClause1 := false;
|
|
end {if}
|
|
else if token.kind <> semicolonch then begin
|
|
Expression(normalExpression, [semicolonch]);
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
Match(semicolonch,22);
|
|
end {else if}
|
|
else
|
|
NextToken;
|
|
|
|
Gen1(dc_lab, forLoop); {this label points to the condition}
|
|
if token.kind <> semicolonch then {handle the loop test}
|
|
begin {evaluate the expression}
|
|
Expression(normalExpression, [semicolonch]);
|
|
CompareToZero(pc_neq); {Evaluate the condition}
|
|
Gen1(pc_fjp, breakLab);
|
|
end; {if}
|
|
Match(semicolonch,22);
|
|
|
|
tl := nil; {collect the tokens for the last expression}
|
|
parencount := 0;
|
|
errorFound := false;
|
|
while (token.kind <> eofsy)
|
|
and ((token.kind <> rparench) or (parencount <> 0))
|
|
and (token.kind <> semicolonch) do begin
|
|
new(tk); {place the token in the list}
|
|
tk^.next := tl;
|
|
tl := tk;
|
|
tk^.token := token;
|
|
if token.kind = lparench then {allow parens in the expression}
|
|
parencount := parencount+1
|
|
else if token.kind = rparench then
|
|
parencount := parencount-1;
|
|
NextToken; {next token}
|
|
end; {while}
|
|
if errorFound then {if an error was found, dump the list}
|
|
while tl <> nil do begin
|
|
tk := tl;
|
|
tl := tl^.next;
|
|
dispose(tk);
|
|
end; {while}
|
|
stPtr^.e3List := tl; {save the list}
|
|
Match(rparench,12); {get the closing for loop paren}
|
|
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {ForStatement}
|
|
|
|
|
|
procedure IfStatement;
|
|
|
|
{ handle an if statement }
|
|
|
|
var
|
|
lab: integer; {branch label}
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {IfStatement}
|
|
NextToken; {skip the 'if' token}
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
|
|
lab := GenLabel; {create the branch label}
|
|
CompareToZero(pc_neq); {evaluate the condition}
|
|
Gen1(pc_fjp, lab);
|
|
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := ifSt;
|
|
stPtr^.ifLab := lab;
|
|
if c99Scope then PushTable;
|
|
Statement; {process the 'true' statement}
|
|
end; {IfStatement}
|
|
|
|
|
|
procedure GotoStatement;
|
|
|
|
{ handle a goto statement }
|
|
|
|
begin {GotoStatement}
|
|
NextToken; {skip the 'goto' token}
|
|
if token.kind in [ident,typedef] then begin
|
|
GotoLabel(pc_ujp); {jump to the label}
|
|
NextToken; {skip the token}
|
|
end {if}
|
|
else
|
|
Error(9); {flag the error}
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
end; {GotoStatement}
|
|
|
|
|
|
procedure LabelStatement;
|
|
|
|
{ handle a labeled statement }
|
|
|
|
begin {LabelStatement}
|
|
GotoLabel(dc_lab); {define the label}
|
|
NextToken; {skip the label}
|
|
if token.kind = colonch then {if present, skip the colon}
|
|
NextToken
|
|
else begin {bad statement - flag error and skip it}
|
|
Error(31);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {LabelStatement}
|
|
|
|
|
|
procedure ReturnStatement;
|
|
|
|
{ handle a return statement }
|
|
|
|
var
|
|
id: identPtr; {structure id}
|
|
size: longint; {size of the struct/union}
|
|
tk: tokenType; {structure name token}
|
|
|
|
begin {ReturnStatement}
|
|
if fIsNoreturn then
|
|
if (lint & lintReturn) <> 0 then
|
|
Error(153);
|
|
NextToken; {skip the 'return' token}
|
|
if token.kind <> semicolonch then {if present, evaluate the return value}
|
|
begin
|
|
if fType^.kind in [structType,unionType] then begin
|
|
tk.kind := ident;
|
|
tk.class := identifier;
|
|
tk.name := @'@struct';
|
|
tk.symbolPtr := nil;
|
|
id := FindSymbol(tk, variableSpace, false, true);
|
|
Gen1Name(pc_lao, 0, id^.name);
|
|
size := fType^.size;
|
|
end {if}
|
|
else if fType^.kind = scalarType then
|
|
if fType^.baseType in [cgQuad,cgUQuad] then
|
|
Gen2t(pc_lod, 0, 0, cgULong);
|
|
Expression(normalExpression, [semicolonch]);
|
|
AssignmentConversion(fType, expressionType, lastWasConst, lastConst,
|
|
true, false);
|
|
case fType^.kind of
|
|
scalarType: if fType^.baseType in [cgQuad,cgUQuad] then
|
|
Gen0t(pc_sto, fType^.baseType)
|
|
else
|
|
Gen2t(pc_str, 0, 0, fType^.baseType);
|
|
enumType: Gen2t(pc_str, 0, 0, cgWord);
|
|
pointerType: Gen2t(pc_str, 0, 0, cgULong);
|
|
structType,
|
|
unionType: begin
|
|
Gen2(pc_mov, long(size).msw, long(size).lsw);
|
|
Gen0t(pc_pop, cgULong);
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
end {if}
|
|
else begin
|
|
if (fType^.kind <> scalarType) or (fType^.baseType <> cgVoid) then
|
|
if ((lint & lintC99Syntax) <> 0) or ((lint & lintReturn) <> 0) then
|
|
Error(152);
|
|
end; {else}
|
|
Gen1(pc_ujp, returnLabel); {branch to the exit point}
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
end; {ReturnStatement}
|
|
|
|
|
|
procedure SwitchStatement;
|
|
|
|
{ handle a switch statement }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
tp: typePtr; {for checking type}
|
|
|
|
begin {SwitchStatement}
|
|
NextToken; {skip the 'switch' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := switchSt;
|
|
stPtr^.maxVal := -maxint4;
|
|
stPtr^.labelCount := 0;
|
|
stPtr^.switchLab := GenLabel;
|
|
stPtr^.switchExit := GenLabel;
|
|
stPtr^.breakLab := stPtr^.switchExit;
|
|
stPtr^.switchList := nil;
|
|
stPtr^.switchDefault := 0;
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression,[rparench]);
|
|
Match(rparench, 12);
|
|
tp := expressionType; {make sure the expression is integral}
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
case tp^.kind of
|
|
|
|
scalarType:
|
|
if tp^.baseType in [cgQuad,cgUQuad] then begin
|
|
stPtr^.size := cgQuadSize;
|
|
stPtr^.ln := GetTemp(cgQuadSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgQuad);
|
|
end {if}
|
|
else if tp^.baseType in [cgLong,cgULong] then begin
|
|
stPtr^.size := cgLongSize;
|
|
stPtr^.ln := GetTemp(cgLongSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgLong);
|
|
end {if}
|
|
else if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
stPtr^.size := cgWordSize;
|
|
stPtr^.ln := GetTemp(cgWordSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgWord);
|
|
end {else if}
|
|
else
|
|
Error(71);
|
|
|
|
enumType: begin
|
|
stPtr^.size := cgWordSize;
|
|
stPtr^.ln := GetTemp(cgWordSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgWord);
|
|
end;
|
|
|
|
otherwise:
|
|
Error(71);
|
|
end; {case}
|
|
Gen1(pc_ujp, stPtr^.switchLab); {branch to the xjp instruction}
|
|
if c99Scope then PushTable;
|
|
Statement; {process the loop body statement}
|
|
end; {SwitchStatement}
|
|
|
|
|
|
procedure WhileStatement;
|
|
|
|
{ handle a while statement }
|
|
|
|
var
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
top, endl: integer; {branch points}
|
|
|
|
begin {WhileStatement}
|
|
NextToken; {skip the 'while' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := whileSt;
|
|
top := GenLabel; {create the branch labels}
|
|
endl := GenLabel;
|
|
stPtr^.whileTop := top;
|
|
stPtr^.whileEnd := endl;
|
|
stPtr^.breakLab := endl;
|
|
stPtr^.continueLab := top;
|
|
Gen1(dc_lab, top); {define the top label}
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
CompareToZero(pc_neq); {evaluate the condition}
|
|
Gen1(pc_fjp, endl);
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {WhileStatement}
|
|
|
|
begin {Statement}
|
|
1:
|
|
{if trace names are enabled and a line # is due, generate it}
|
|
if traceBack or debugFlag then
|
|
if nameFound or debugFlag then
|
|
if lastLine <> lineNumber then begin
|
|
lastLine := lineNumber;
|
|
Gen2(pc_lnm, lineNumber, ord(debugType));
|
|
end; {if}
|
|
|
|
{handle the statement}
|
|
case token.kind of
|
|
asmsy: begin
|
|
NextToken;
|
|
AsmStatement;
|
|
end;
|
|
breaksy: BreakStatement;
|
|
casesy: CaseStatement;
|
|
continuesy: ContinueStatement;
|
|
defaultsy: DefaultStatement;
|
|
dosy: DoStatement;
|
|
elsesy: begin Error(25); SkipStatement; end;
|
|
forsy: ForStatement;
|
|
gotosy: GotoStatement;
|
|
typedef,
|
|
ident: begin
|
|
lPrintMacroExpansions := printMacroExpansions;
|
|
printMacroExpansions := false;
|
|
lToken := token;
|
|
NextToken;
|
|
tToken := token;
|
|
PutBackToken(token, true);
|
|
token := lToken;
|
|
printMacroExpansions := lPrintMacroExpansions;
|
|
if tToken.kind = colonch then begin
|
|
LabelStatement;
|
|
goto 1;
|
|
end {if}
|
|
else
|
|
AssignmentStatement;
|
|
end;
|
|
ifsy: IfStatement;
|
|
lbracech: CompoundStatement(true);
|
|
returnsy: ReturnStatement;
|
|
semicolonch: NextToken;
|
|
switchsy: SwitchStatement;
|
|
whilesy: WhileStatement;
|
|
otherwise: AssignmentStatement;
|
|
end; {case}
|
|
end; {Statement}
|
|
|
|
|
|
procedure EndDoStatement;
|
|
|
|
{ finish off a do statement }
|
|
|
|
var
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndDoStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {get the statement record}
|
|
if token.kind = whilesy then begin {if a while clause exists, process it}
|
|
NextToken; {skip the 'while' token}
|
|
if stPtr^.continueLab <> 0 then {create the continue label}
|
|
Gen1(dc_lab, stPtr^.continueLab);
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
CompareToZero(pc_equ); {evaluate the condition}
|
|
Gen1(pc_fjp, stPtr^.doLab);
|
|
Match(semicolonch, 22); {process the closing ';'}
|
|
end {if}
|
|
else
|
|
Error(30); {'while' expected}
|
|
if stPtr^.breakLab <> 0 then {create the break label}
|
|
Gen1(dc_lab, stPtr^.breakLab);
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndDoStatement}
|
|
|
|
|
|
procedure EndIfStatement;
|
|
|
|
{ finish off an if statement }
|
|
|
|
var
|
|
lab1,lab2: integer; {branch labels}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndIfStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {get the label to branch to}
|
|
lab1 := stPtr^.ifLab;
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
|
|
if token.kind = elsesy then begin {if an else clause exists, process it}
|
|
NextToken; {skip 'else'}
|
|
lab2 := GenLabel; {create the branch label}
|
|
Gen1(pc_ujp, lab2); {branch past the else clause}
|
|
Gen1(dc_lab, lab1); {create label for if to branch to}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := elseSt;
|
|
stPtr^.elseLab := lab2;
|
|
if c99Scope then PushTable;
|
|
Statement; {evaluate the else clause}
|
|
end {if}
|
|
else begin
|
|
Gen1(dc_lab, lab1); {create label for if to branch to}
|
|
if c99Scope then PopTable;
|
|
end; {else}
|
|
end; {EndIfStatement}
|
|
|
|
|
|
procedure EndElseStatement;
|
|
|
|
{ finish off an else clause }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndElseStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {create the label to branch to}
|
|
Gen1(dc_lab, stPtr^.elseLab);
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndElseStatement}
|
|
|
|
|
|
procedure EndForStatement;
|
|
|
|
{ finish off a for statement }
|
|
|
|
var
|
|
ltoken: tokenType; {for putting ; on stack}
|
|
stPtr: statementPtr; {work pointer}
|
|
tl,tk: tokenStackPtr; {for forming expression list}
|
|
lPrintMacroExpansions: boolean; {local copy of printMacroExpansions}
|
|
|
|
begin {EndForStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList;
|
|
Gen1(dc_lab, stPtr^.continueLab); {define the continue label}
|
|
|
|
tl := stPtr^.e3List; {place the expression back in the list}
|
|
if tl <> nil then begin
|
|
PutBackToken(token, false);
|
|
ltoken.kind := semicolonch;
|
|
ltoken.class := reservedSymbol;
|
|
PutBackToken(ltoken, false);
|
|
while tl <> nil do begin
|
|
PutBackToken(tl^.token, false);
|
|
tk := tl;
|
|
tl := tl^.next;
|
|
dispose(tk);
|
|
end; {while}
|
|
lPrintMacroExpansions := printMacroExpansions; {inhibit token echo}
|
|
printMacroExpansions := false;
|
|
NextToken; {evaluate the expression}
|
|
Expression(normalExpression, [semicolonch]);
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
NextToken; {skip the semicolon}
|
|
printMacroExpansions := lPrintMacroExpansions;
|
|
end; {if}
|
|
|
|
Gen1(pc_ujp, stPtr^.forLoop); {loop to the test}
|
|
Gen1(dc_lab, stPtr^.breakLab); {create the exit label}
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndForStatement}
|
|
|
|
|
|
procedure EndSwitchStatement;
|
|
|
|
{ finish off a switch statement }
|
|
|
|
const
|
|
sparse = 5; {label to tableSize ratio for sparse table}
|
|
|
|
var
|
|
default: integer; {default label}
|
|
ltp: baseTypeEnum; {base type}
|
|
minVal: integer; {min switch value}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
{copies of vars (for efficiency)}
|
|
{-------------------------------}
|
|
exitLab: integer; {label at the end of the jump table}
|
|
isLong: boolean; {is the case expression long?}
|
|
isLongLong: boolean; {is the case expression long long?}
|
|
swPtr,swPtr2: switchPtr; {switch label table list}
|
|
|
|
begin {EndSwitchStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {get the statement record}
|
|
exitLab := stPtr^.switchExit; {get the exit label}
|
|
isLong := stPtr^.size = cgLongSize; {get the long flag}
|
|
isLongLong := stPtr^.size = cgQuadSize; {get the long long flag}
|
|
swPtr := stPtr^.switchList; {Skip further generation if there were}
|
|
if swPtr <> nil then begin { no labels. }
|
|
default := stPtr^.switchDefault; {get a default label}
|
|
if default = 0 then
|
|
default := exitLab;
|
|
Gen1(pc_ujp, exitLab); {branch past the indexed jump}
|
|
Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table}
|
|
if isLongLong then {decide on a base type}
|
|
ltp := cgQuad
|
|
else if isLong then
|
|
ltp := cgLong
|
|
else
|
|
ltp := cgWord;
|
|
if isLong or isLongLong
|
|
or (((stPtr^.maxVal-swPtr^.val.lo) div stPtr^.labelCount) > sparse) then
|
|
begin
|
|
|
|
{Long expressions and sparse switch statements are handled as a }
|
|
{series of if-goto tests. }
|
|
while swPtr <> nil do begin {generate the compares}
|
|
if isLongLong then
|
|
GenLdcQuad(swPtr^.val)
|
|
else if isLong then
|
|
GenLdcLong(swPtr^.val.lo)
|
|
else
|
|
Gen1t(pc_ldc, long(swPtr^.val.lo).lsw, cgWord);
|
|
Gen2t(pc_lod, stPtr^.ln, 0, ltp);
|
|
Gen0t(pc_equ, ltp);
|
|
Gen1(pc_tjp, swPtr^.lab);
|
|
swPtr2 := swPtr;
|
|
swPtr := swPtr^.next;
|
|
dispose(swPtr2);
|
|
end; {while}
|
|
Gen1(pc_ujp, default); {anything else goes to default}
|
|
end {if}
|
|
else begin
|
|
|
|
{compact word switch statements are handled with xjp}
|
|
minVal := long(swPtr^.val.lo).lsw; {record the min label value}
|
|
Gen2t(pc_lod, stPtr^.ln, 0, ltp); {get the value}
|
|
Gen1t(pc_dec, minVal, cgWord); {adjust the range}
|
|
Gen1(pc_xjp, ord(stPtr^.maxVal-minVal+1)); {do the indexed jump}
|
|
while swPtr <> nil do begin {generate the jump table}
|
|
while minVal < swPtr^.val.lo do begin
|
|
Gen1(pc_add, default);
|
|
minVal := minVal+1;
|
|
end; {while}
|
|
minVal := minVal+1;
|
|
Gen1(pc_add, swPtr^.lab);
|
|
swPtr2 := swPtr;
|
|
swPtr := swPtr^.next;
|
|
dispose(swPtr2);
|
|
end; {while}
|
|
Gen1(pc_add, default);
|
|
end; {if}
|
|
Gen1(dc_lab, exitLab); {generate the default label}
|
|
end {if}
|
|
else begin
|
|
Gen1(pc_ujp, exitLab); {branch past the indexed jump}
|
|
Gen1(dc_lab, stPtr^.switchLab); {create the label for the xjp table}
|
|
|
|
default := stPtr^.switchDefault; {if there is one, jump to the default label}
|
|
if default <> 0 then
|
|
Gen1(pc_ujp, default);
|
|
|
|
Gen1(dc_lab, exitLab); {generate the default label}
|
|
end; {else}
|
|
FreeTemp(stPtr^.ln, stPtr^.size); {release temp variable}
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndSwitchStatement}
|
|
|
|
|
|
procedure EndWhileStatement;
|
|
|
|
{ finish off a while statement }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndWhileStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {loop to the test}
|
|
Gen1(pc_ujp, stPtr^.whileTop);
|
|
Gen1(dc_lab, stPtr^.whileEnd); {create the exit label}
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndWhileStatement}
|
|
|
|
{-- Type declarations ------------------------------------------}
|
|
|
|
procedure Declarator(tPtr: typePtr; var variable: identPtr; space: spaceType;
|
|
doingPrototypes: boolean);
|
|
|
|
{ handle a declarator }
|
|
{ }
|
|
{ parameters: }
|
|
{ tPtr - pointer to the type to use }
|
|
{ variable - pointer to variable being defined }
|
|
{ space - variable space to use }
|
|
{ doingPrototypes - are we compiling prototype parameter }
|
|
{ declarations? }
|
|
|
|
label 1;
|
|
|
|
type
|
|
typeDefPtr = ^typeDefRecord; {for stacking type records}
|
|
typeDefRecord = record
|
|
next: typeDefPtr;
|
|
typeDef: typePtr;
|
|
end;
|
|
pointerListPtr = ^pointerList; {for stacking pointer types}
|
|
pointerList = record
|
|
next: pointerListPtr;
|
|
isConstant: boolean;
|
|
end;
|
|
|
|
var
|
|
i: integer; {loop variable}
|
|
lastWasIdentifier: boolean; {for deciding if the declarator is a function}
|
|
lastWasPointer: boolean; {was the last type a pointer?}
|
|
newName: stringPtr; {new symbol name}
|
|
parameterStorage: boolean; {is the new symbol in a parm list?}
|
|
state: stateKind; {declaration state of the variable}
|
|
tPtr2: typePtr; {work pointer}
|
|
tsPtr: typeDefPtr; {work pointer}
|
|
typeStack: typeDefPtr; {stack of type definitions}
|
|
varParmList: boolean; {did we prototype a variable?}
|
|
firstIteration: boolean; {first iteration of type-unstacking loop?}
|
|
|
|
{for checking function compatibility}
|
|
{-----------------------------------}
|
|
checkParms: boolean; {do we need to do type checking on the parm?}
|
|
compatible: boolean; {are the parameters compatible?}
|
|
ftoken: tokenType; {for checking extern functions}
|
|
p1,p2,p3: parameterPtr; {used to trace parameter lists}
|
|
pt1,pt2: typePtr; {parameter types}
|
|
t1: typePtr; {function type}
|
|
tk1,tk2: typeKind; {parameter type kinds}
|
|
unnamedParm: boolean; {is this an unnamed prototype?}
|
|
|
|
|
|
procedure StackDeclarations (var varParmList: boolean);
|
|
|
|
{ stack the declaration operators }
|
|
{ }
|
|
{ Parameters: }
|
|
{ varParmList - did we create one? }
|
|
|
|
var
|
|
cp,cpList: pointerListPtr; {pointer list}
|
|
done,done2: boolean; {for loop termination}
|
|
isPtr: boolean; {is the parenthesized expr a ptr?}
|
|
isVoid: boolean; {is the type specifier void?}
|
|
wp: parameterPtr; {used to build prototype var list}
|
|
pvar: identPtr; {work pointer}
|
|
tPtr2: typePtr; {work pointer}
|
|
ttPtr: typeDefPtr; {work pointer}
|
|
parencount: integer; {for skipping in parm list}
|
|
lvarParmList: boolean; {did we prototype a variable?}
|
|
|
|
{variables used to preserve states}
|
|
{ across recursive calls }
|
|
{---------------------------------}
|
|
lisFunction: boolean; {local copy of isFunction}
|
|
lisPascal: boolean; {local copy of isPascal}
|
|
lLastParameter: identPtr; {next parameter to process}
|
|
lstorageClass: tokenEnum; {storage class of the declaration}
|
|
ltypeSpec: typePtr; {type specifier}
|
|
luseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
lPrintMacroExpansions: boolean; {local copy of printMacroExpansions}
|
|
|
|
begin {StackDeclarations}
|
|
varParmList := false; {no var parm list, yet}
|
|
lastWasIdentifier := false; {used to see if the declaration is a fn}
|
|
cpList := nil;
|
|
if token.kind = typedef then
|
|
token.kind := ident;
|
|
case token.kind of
|
|
|
|
ident: begin {handle 'ident'}
|
|
if space = fieldListSpace then
|
|
variable := nil
|
|
else
|
|
variable := FindSymbol(token, space, true, true);
|
|
newName := token.name;
|
|
if variable = nil then begin
|
|
if storageClass = typedefsy then begin
|
|
tPtr2 := pointer(Calloc(sizeof(typeRecord)));
|
|
{tPtr2^.size := 0;}
|
|
{tPtr2^.saveDisp := 0;}
|
|
tPtr2^.kind := definedType;
|
|
{tPtr^.isConstant := false;}
|
|
tPtr2^.dType := tPtr;
|
|
end {if}
|
|
else
|
|
tPtr2 := tPtr;
|
|
if doingParameters then begin
|
|
if not doingPrototypes then
|
|
if not (tPtr2^.kind in
|
|
[enumConst,structType,unionType,definedType,pointerType])
|
|
then Error(50);
|
|
parameterStorage := true;
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
checkParms := true;
|
|
NextToken;
|
|
if token.kind = eqch then
|
|
state := initialized;
|
|
lastWasIdentifier := true;
|
|
end;
|
|
|
|
asteriskch: begin {handle '*' 'declarator'}
|
|
while token.kind = asteriskch do begin
|
|
NextToken;
|
|
new(cp);
|
|
cp^.next := cpList;
|
|
cpList := cp;
|
|
cp^.isConstant := false;
|
|
while token.kind in [_Alignassy..whilesy] do begin
|
|
if token.kind = constsy then
|
|
cpList^.isConstant := true
|
|
else if token.kind = volatilesy then
|
|
volatile := true
|
|
else if token.kind = restrictsy then
|
|
{always allowed for now (not recorded as part of the type)}
|
|
else
|
|
Error(9);
|
|
NextToken;
|
|
end; {while}
|
|
end; {while}
|
|
StackDeclarations(lvarParmList);
|
|
end;
|
|
|
|
lparench: begin {handle '(' 'declarator' ')'}
|
|
NextToken;
|
|
isPtr := token.kind = asteriskch;
|
|
StackDeclarations(lvarParmList);
|
|
Match(rparench,12);
|
|
if isPtr then
|
|
lastWasIdentifier := false;
|
|
end;
|
|
|
|
otherwise:
|
|
if doingPrototypes then begin {allow for unnamed parameters}
|
|
pvar := pointer(Calloc(sizeof(identRecord)));
|
|
{pvar^.next := nil;}
|
|
{pvar^.saved := 0;}
|
|
pvar^.name := @'?';
|
|
pvar^.itype := tPtr;
|
|
{pvar^.disp := 0;}
|
|
{pvar^.bitDisp := 0;}
|
|
{pvar^.bitsize := 0;}
|
|
{pvar^.initialized := false;}
|
|
{pvar^.iPtr := nil;}
|
|
{pvar^.isForwardDeclared := false;}
|
|
pvar^.class := autosy;
|
|
pvar^.storage := parameter;
|
|
variable := pvar;
|
|
lastWasIdentifier := true;
|
|
newName := nil;
|
|
unnamedParm := true;
|
|
end; {if}
|
|
|
|
end; {case}
|
|
|
|
while token.kind in [lparench,lbrackch] do begin
|
|
|
|
{handle function declarations}
|
|
if token.kind = lparench then begin
|
|
lisPascal := isPascal; {preserve this flag}
|
|
PushTable; {create a symbol table}
|
|
{determine if it's a function}
|
|
isFunction := lastWasIdentifier or isFunction;
|
|
varParmList := not isFunction;
|
|
tPtr2 := pointer(GCalloc(sizeof(typeRecord))); {create the function type}
|
|
{tPtr2^.size := 0;}
|
|
{tPtr2^.saveDisp := 0;}
|
|
tPtr2^.kind := functionType;
|
|
{tPtr2^.isConstant := false;}
|
|
{tPtr2^.varargs := false;}
|
|
{tPtr2^.prototyped := false;}
|
|
{tPtr2^.overrideKR := false;}
|
|
{tPtr2^.parameterList := nil;}
|
|
{tPtr2^.isPascal := false;}
|
|
{tPtr2^.toolNum := 0;}
|
|
{tPtr2^.dispatcher := 0;}
|
|
new(ttPtr);
|
|
ttPtr^.next := typeStack;
|
|
typeStack := ttPtr;
|
|
ttPtr^.typeDef := tPtr2;
|
|
NextToken; {skip the '(' token}
|
|
isVoid := token.kind = voidsy;
|
|
if token.kind = typedef then
|
|
if token.symbolPtr^.itype^.kind = scalarType then
|
|
if token.symbolPtr^.itype^.baseType = cgVoid then
|
|
isVoid := true;
|
|
if isVoid then begin {check for a void prototype}
|
|
lPrintMacroExpansions := printMacroExpansions;
|
|
printMacroExpansions := false;
|
|
NextToken;
|
|
printMacroExpansions := lPrintMacroExpansions;
|
|
if token.kind = rparench then begin
|
|
PutBackToken(token, false);
|
|
NextToken;
|
|
tPtr2^.prototyped := true;
|
|
end
|
|
else begin
|
|
PutBackToken(token, false);
|
|
token.kind := voidsy;
|
|
token.class := reservedSymbol;
|
|
end; {else}
|
|
end; {if}
|
|
{see if we are doing a prototyped list}
|
|
if token.kind in declarationSpecifiersElement then begin
|
|
{handle a prototype variable list}
|
|
numberOfParameters := 0; {don't allow K&R parm declarations}
|
|
luseGlobalPool := useGlobalPool; {use global memory}
|
|
useGlobalPool := true;
|
|
done2 := false;
|
|
lisFunction := isFunction; {preserve global variables}
|
|
ltypeSpec := typeSpec;
|
|
lstorageClass := storageClass;
|
|
with tPtr2^ do begin
|
|
prototyped := true; {it is prototyped}
|
|
repeat {collect the declarations}
|
|
if token.kind in declarationSpecifiersElement then begin
|
|
lLastParameter := lastParameter;
|
|
DoDeclaration(true);
|
|
lastParameter := lLastParameter;
|
|
if protoType <> nil then begin
|
|
wp := pointer(Malloc(sizeof(parameterRecord)));
|
|
wp^.next := parameterList;
|
|
parameterList := wp;
|
|
wp^.parameter := protoVariable;
|
|
wp^.parameterType := protoType;
|
|
if protoVariable <> nil then begin
|
|
protoVariable^.pnext := lastParameter;
|
|
lastParameter := protoVariable;
|
|
end; {if}
|
|
end; {if}
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = dotch then begin
|
|
NextToken;
|
|
Match(dotch,89);
|
|
Match(dotch,89);
|
|
varargs := true;
|
|
done2 := true;
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
done2 := true;
|
|
end {if}
|
|
else begin
|
|
Error(26);
|
|
parencount := 0;
|
|
while (token.kind <> eofsy)
|
|
and ((parencount > 0) or (token.kind <> rparench)) do
|
|
begin
|
|
if token.kind = rparench then
|
|
parencount := parencount-1
|
|
else if token.kind = lparench then
|
|
parencount := parencount+1;
|
|
NextToken;
|
|
end; {while}
|
|
done2 := true;
|
|
end; {else}
|
|
until done2;
|
|
end; {with}
|
|
isFunction := lisFunction; {restore global variables}
|
|
storageClass := lstorageClass;
|
|
typeSpec := ltypeSpec;
|
|
useGlobalPool := luseGlobalPool;
|
|
end {if prototype}
|
|
else if token.kind = ident then begin
|
|
|
|
{handle a K&R variable list}
|
|
if (lint & lintNotPrototyped) <> 0 then
|
|
Error(105);
|
|
if doingFunction or doingPrototypes then
|
|
Error(12)
|
|
else begin
|
|
numberOfParameters := 0; {no function parms yet}
|
|
end; {else}
|
|
repeat {make a list of parameters}
|
|
if not doingFunction then begin
|
|
if token.kind <> ident then begin
|
|
Error(9);
|
|
while not (token.kind in [rparench,commach,ident]) do
|
|
NextToken;
|
|
end; {if}
|
|
if token.kind = ident then begin
|
|
pvar := NewSymbol(token.name, nil, ident, variableSpace,
|
|
declared);
|
|
pvar^.storage := parameter;
|
|
pvar^.pnext := lastParameter;
|
|
lastParameter := pvar;
|
|
numberOfParameters := numberOfParameters+1;
|
|
pvar^.bitdisp := numberOfParameters;
|
|
NextToken;
|
|
end; {if}
|
|
end; {if}
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
done := false;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
end {else if}
|
|
else if (lint & lintNotPrototyped) <> 0 then
|
|
if not tPtr2^.prototyped then
|
|
Error(105);
|
|
Match(rparench,12); {insist on a closing ')' token}
|
|
isPascal := lisPascal; {restore this flag}
|
|
end {if}
|
|
|
|
{handle array declarations}
|
|
else {if token.kind = lbrackch then} begin
|
|
lastWasIdentifier := false;
|
|
tPtr2 := pointer(Calloc(sizeof(typeRecord)));
|
|
{tPtr2^.size := 0;}
|
|
{tPtr2^.saveDisp := 0;}
|
|
{tPtr2^.isConstant := false;}
|
|
tPtr2^.kind := arrayType;
|
|
{tPtr2^.elements := 0;}
|
|
new(ttPtr);
|
|
ttPtr^.next := typeStack;
|
|
typeStack := ttPtr;
|
|
ttPtr^.typeDef := tPtr2;
|
|
NextToken;
|
|
if token.kind <> rbrackch then begin
|
|
Expression(arrayExpression, [rbrackch,semicolonch]);
|
|
if expressionValue <= 0 then begin
|
|
Error(45);
|
|
expressionValue := 1;
|
|
end; {if}
|
|
tPtr2^.elements := expressionValue;
|
|
end; {if}
|
|
Match(rbrackch,24);
|
|
end; {else if}
|
|
end; {while}
|
|
|
|
{stack pointer type records}
|
|
while cpList <> nil do begin
|
|
tPtr2 := pointer(Malloc(sizeof(typeRecord)));
|
|
tPtr2^.size := cgPointerSize;
|
|
tPtr2^.saveDisp := 0;
|
|
tPtr2^.isConstant := cpList^.isConstant;
|
|
tPtr2^.kind := pointerType;
|
|
new(ttPtr);
|
|
ttPtr^.next := typeStack;
|
|
typeStack := ttPtr;
|
|
ttPtr^.typeDef := tPtr2;
|
|
cp := cpList;
|
|
cpList := cp^.next;
|
|
dispose(cp);
|
|
end; {for}
|
|
end; {StackDeclarations}
|
|
|
|
begin {Declarator}
|
|
newName := nil; {no identifier, yet}
|
|
unnamedParm := false; {not an unnamed parameter}
|
|
if storageClass = externsy then {decide on a storage state}
|
|
state := declared
|
|
else
|
|
state := defined;
|
|
typeStack := nil; {no types so far}
|
|
parameterStorage := false; {symbol is not in a parameter list}
|
|
checkParms := false; {assume we won't need to check for parameter type errors}
|
|
StackDeclarations(varParmList); {stack the type records}
|
|
firstIteration := true;
|
|
while typeStack <> nil do begin {reverse the type stack}
|
|
tsPtr := typeStack;
|
|
typeStack := tsPtr^.next;
|
|
if isFunction and (not useGlobalPool) then begin
|
|
tPtr2 := pointer(GMalloc(sizeof(typeRecord)));
|
|
tPtr2^ := tsPtr^.typeDef^;
|
|
tPtr2^.saveDisp := 0;
|
|
end {if}
|
|
else
|
|
tPtr2 := tsPtr^.typeDef;
|
|
dispose(tsPtr);
|
|
if tPtr^.kind = functionType then
|
|
if not firstIteration then
|
|
PopTable; {balance push in StackDeclarations}
|
|
case tPtr2^.kind of
|
|
pointerType: begin
|
|
tPtr2^.pType := tPtr;
|
|
end;
|
|
functionType: begin
|
|
while tPtr^.kind = definedType do
|
|
tPtr := tPtr^.dType;
|
|
tPtr2^.fType := tPtr;
|
|
if tPtr^.kind in [functionType,arrayType] then
|
|
Error(103);
|
|
end;
|
|
arrayType: begin
|
|
tPtr2^.size := tPtr^.size * tPtr2^.elements;
|
|
tPtr2^.aType := tPtr;
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
tPtr := tPtr2;
|
|
firstIteration := false;
|
|
end; {while}
|
|
|
|
if checkParms then begin {check for parameter type conflicts}
|
|
with variable^ do begin
|
|
if doingParameters then begin
|
|
if itype = nil then begin
|
|
itype := tPtr;
|
|
numberOfParameters := numberOfParameters-1;
|
|
if pfunc^.itype^.prototyped then begin
|
|
pfunc^.itype^.overrideKR := true;
|
|
p1 := nil;
|
|
for i := 1 to bitdisp do begin
|
|
p2 := pfunc^.itype^.parameterList;
|
|
while (p2^.next <> p1) and (p2 <> nil) do
|
|
p2 := p2^.next;
|
|
p1 := p2;
|
|
end; {for}
|
|
compatible := false;
|
|
if CompTypes(p1^.parameterType, tPtr) then
|
|
compatible := true
|
|
else begin
|
|
tk1 := p1^.parameterType^.kind;
|
|
tk2 := tPtr^.kind;
|
|
if (tk1 = arrayType) and (tk2 = pointerType) then
|
|
compatible :=
|
|
CompTypes(p1^.parameterType^.aType, tPtr^.pType)
|
|
else if (tk1 = pointerType) and (tk2 = arrayType) then
|
|
compatible :=
|
|
CompTypes(p1^.parameterType^.pType, tPtr^.aType);
|
|
end; {else}
|
|
if not compatible then
|
|
Error(47);
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
Error(42);
|
|
storage := parameter;
|
|
parameterStorage := true;
|
|
end; {if}
|
|
end; {with}
|
|
end {if}
|
|
else if doingParameters then
|
|
if not doingPrototypes then
|
|
if pfunc^.itype^.prototyped then
|
|
if tPtr^.kind in
|
|
[enumConst,structType,unionType,definedType,pointerType]
|
|
then Error(50);
|
|
|
|
if tPtr^.kind = functionType then begin {declare the identifier}
|
|
if variable <> nil then begin
|
|
t1 := variable^.itype;
|
|
if CompTypes(t1, tPtr) then begin
|
|
if t1^.prototyped and tPtr^.prototyped then begin
|
|
p2 := tptr^.parameterList;
|
|
if isPascal then begin
|
|
{reverse the parameter list}
|
|
p1 := nil;
|
|
while p2 <> nil do begin
|
|
p3 := p2;
|
|
p2 := p2^.next;
|
|
p3^.next := p1;
|
|
p1 := p3;
|
|
end; {while}
|
|
tPtr^.parameterList := p1;
|
|
end; {if}
|
|
p2 := tPtr^.parameterList;
|
|
p1 := t1^.parameterList;
|
|
while (p1 <> nil) and (p2 <> nil) do begin
|
|
if p1^.parameter = nil then
|
|
pt1 := p1^.parameterType
|
|
else
|
|
pt1 := p1^.parameter^.itype;
|
|
if p2^.parameter = nil then
|
|
pt2 := p2^.parameterType
|
|
else
|
|
pt2 := p2^.parameter^.itype;
|
|
compatible := false;
|
|
if CompTypes(pt1, pt2) then
|
|
compatible := true
|
|
else begin
|
|
tk1 := pt1^.kind;
|
|
tk2 := pt2^.kind;
|
|
if (tk1 = arrayType) and (tk2 = pointerType) then
|
|
compatible := CompTypes(pt1^.aType, pt2^.pType)
|
|
else if (tk1 = pointerType) and (tk2 = arrayType) then
|
|
compatible := CompTypes(pt1^.pType, pt2^.aType)
|
|
end; {else}
|
|
if not compatible then begin
|
|
Error(47);
|
|
goto 1;
|
|
end; {if}
|
|
p1 := p1^.next;
|
|
p2 := p2^.next;
|
|
end; {while}
|
|
if p1 <> p2 then
|
|
Error(47);
|
|
p2 := tptr^.parameterList;
|
|
if isPascal then begin
|
|
{reverse the parameter list}
|
|
p1 := nil;
|
|
while p2 <> nil do begin
|
|
p3 := p2;
|
|
p2 := p2^.next;
|
|
p3^.next := p1;
|
|
p1 := p3;
|
|
end; {while}
|
|
tPtr^.parameterList := p1;
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
Error(42);
|
|
1:
|
|
end; {if}
|
|
end; {if}
|
|
if tPtr^.kind = functionType then
|
|
state := declared;
|
|
if newName <> nil then {declare the variable}
|
|
variable := NewSymbol(newName, tPtr, storageClass, space, state)
|
|
else if unnamedParm then
|
|
variable^.itype := tPtr
|
|
else begin
|
|
if token.kind <> semicolonch then
|
|
Error(9);
|
|
variable := nil;
|
|
end; {else}
|
|
if variable <> nil then begin
|
|
if parameterStorage then
|
|
variable^.storage := parameter;
|
|
if isForwardDeclared then begin {handle forward declarations}
|
|
tPtr := variable^.itype;
|
|
lastWasPointer := false;
|
|
while tPtr^.kind in
|
|
[pointerType,arrayType,functionType,definedType] do begin
|
|
if tPtr^.kind = pointerType then
|
|
lastWasPointer := true
|
|
else if tPtr^.kind <> definedType then
|
|
lastWasPointer := false;
|
|
tPtr := tPtr^.pType;
|
|
end; {while}
|
|
if ((tPtr <> typeSpec) and (not (tPtr^.kind in [structType,unionType])))
|
|
then begin
|
|
Error(107);
|
|
SkipStatement;
|
|
end; {if}
|
|
variable^.isForwardDeclared := true;
|
|
end; {if}
|
|
end; {if}
|
|
end; {Declarator}
|
|
|
|
|
|
procedure Initializer (var variable: identPtr);
|
|
|
|
{ handle a variable initializer }
|
|
{ }
|
|
{ paramaters: }
|
|
{ variable - ptr to the identifier begin initialized }
|
|
|
|
var
|
|
bitcount: integer; {# if bits initialized}
|
|
bitvalue: longint; {bit field initializer value}
|
|
done: boolean; {for loop termination}
|
|
errorFound: boolean; {used to remove bad initializations}
|
|
iPtr,jPtr,kPtr: initializerPtr; {for reversing the list}
|
|
ip: identList; {used to place an id in the list}
|
|
luseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
|
|
|
|
procedure InitializeBitField;
|
|
|
|
{ If bit fields have been initialized, fill them in }
|
|
{ }
|
|
{ Inputs: }
|
|
{ bitcount - # of bits initialized }
|
|
{ bitvalue - value of initializer }
|
|
|
|
var
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
|
|
begin {InitializeBitField}
|
|
if bitcount <> 0 then begin {skip if there has been no initializer}
|
|
{ writeln('InitializeBitField; bitcount = ', bitcount:1); {debug}
|
|
{create the initializer entry}
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
iPtr^.iVal := bitvalue;
|
|
if bitcount <= 8 then
|
|
iPtr^.itype := cgUByte
|
|
else if bitcount <= 16 then
|
|
iPtr^.itype := cgUWord
|
|
else if bitcount > 24 then
|
|
iPtr^.itype := cgULong
|
|
else begin {3-byte bitfield: split into two parts}
|
|
iPtr^.itype := cgUWord;
|
|
iPtr^.iVal := bitvalue & $0000FFFF;
|
|
bitcount := bitcount - 16;
|
|
bitvalue := bitvalue >> 16;
|
|
InitializeBitField;
|
|
end;
|
|
bitcount := 0; {reset the bit field values}
|
|
bitvalue := 0;
|
|
end; {if}
|
|
end; {InitializeBitField}
|
|
|
|
|
|
procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer);
|
|
|
|
{ get the value of an initializer from a single expression }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type of the variable being initialized }
|
|
{ bitsize - size of bit field (0 for non-bit fields) }
|
|
{ bitdisp - disp of bit field; unused if bitsize = 0 }
|
|
|
|
label 1,2,3;
|
|
|
|
var
|
|
bitmask: longint; {used to add a value to a bit field}
|
|
bKind: baseTypeEnum; {type of constant}
|
|
etype: typePtr; {expression type}
|
|
i: integer; {loop variable}
|
|
ip: identPtr; {ident in pointer constant}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
kind: tokenEnum; {kind of constant}
|
|
offset, offset2: longint; {integer offset from a pointer}
|
|
operator: tokenEnum; {operator for constant pointers}
|
|
tKind: typeKind; {type of constant}
|
|
tree: tokenPtr; {for evaluating pointer constants}
|
|
|
|
|
|
function Subscript (tree: tokenPtr): typePtr;
|
|
|
|
{ handle subscripts in a pointer constant }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - subscript operators }
|
|
{ }
|
|
{ returns: type of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ iPtr - initializer location to store the array name }
|
|
{ offset - bytes past the start of the array }
|
|
|
|
var
|
|
ip: identPtr; {ident pointer}
|
|
rtree: tokenPtr; {work pointer}
|
|
tp: typePtr; {for tracking types}
|
|
select: longint; {selector size}
|
|
size: longint; {subscript value}
|
|
|
|
begin {Subscript}
|
|
if tree^.token.kind = uasterisk then begin
|
|
tree := tree^.left;
|
|
if tree^.token.kind = plusch then begin
|
|
rtree := tree^.right;
|
|
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
|
|
else if rtree^.token.kind in [longlongconst,ulonglongconst] then begin
|
|
size := rtree^.token.qval.lo;
|
|
with rtree^.token.qval do
|
|
if not (((hi = 0) and (lo & $ff000000 = 0)) or
|
|
((hi = -1) and (lo & $ff000000 = $ff000000))) then
|
|
Error(6);
|
|
end {else if}
|
|
else begin
|
|
Error(18);
|
|
errorFound := true;
|
|
end; {else}
|
|
tp := Subscript(tree^.left);
|
|
if tp^.kind <> arrayType then
|
|
Error(47)
|
|
else begin
|
|
tp := tp^.atype;
|
|
offset := offset + size*tp^.size;
|
|
Subscript := tp;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
end; {else}
|
|
end {if}
|
|
else if tree^.token.kind = dotch then begin
|
|
tp := Subscript(tree^.left);
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
if tp^.kind in [structType,unionType] then begin
|
|
DoSelection(tp, tree^.right, select);
|
|
Subscript := expressionType;
|
|
offset := offset+select;
|
|
if isBitField then
|
|
Error(106);
|
|
end {if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
end; {else}
|
|
end {else if}
|
|
else if tree^.token.kind = ident then begin
|
|
ip := FindSymbol(tree^.token, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
iPtr^.pName := @'?';
|
|
end {if}
|
|
else begin
|
|
Subscript := ip^.itype;
|
|
iPtr^.pName := ip^.name;
|
|
end; {else}
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
end; {else}
|
|
end; {Subscript}
|
|
|
|
|
|
begin {GetInitializerValue}
|
|
if token.kind in [dotch,lbrackch] then begin
|
|
{designated initializer: give error and skip over it}
|
|
Error(150);
|
|
while token.kind in [dotch,lbrackch] do begin
|
|
if token.kind = lbrackch then begin
|
|
NextToken;
|
|
Expression(arrayExpression, [rbrackch]);
|
|
if token.kind = rbrackch then
|
|
NextToken;
|
|
end {if}
|
|
else {if token.kind = dotch then} begin
|
|
NextToken;
|
|
if token.kind in [ident,typedef] then
|
|
NextToken;
|
|
end {if}
|
|
end; {while}
|
|
if token.kind = eqch then
|
|
NextToken;
|
|
end; {if}
|
|
if variable^.storage = stackFrame then
|
|
Expression(autoInitializerExpression, [commach,rparench,rbracech])
|
|
else
|
|
Expression(initializerExpression, [commach,rparench,rbracech]);
|
|
if bitsize = 0 then begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
end; {if}
|
|
etype := expressionType;
|
|
AssignmentConversion(tp, expressionType, isConstant, expressionValue,
|
|
false, false);
|
|
if variable^.storage = external then
|
|
variable^.storage := global;
|
|
if isConstant and (variable^.storage in [external,global,private]) then begin
|
|
if bitsize = 0 then begin
|
|
if etype^.baseType in [cgQuad,cgUQuad] then begin
|
|
iPtr^.qVal := llExpressionValue;
|
|
end {if}
|
|
else begin
|
|
iPtr^.qval.hi := 0;
|
|
iPtr^.iVal := expressionValue;
|
|
end; {else}
|
|
iPtr^.itype := tp^.baseType;
|
|
InitializeBitField;
|
|
end; {if}
|
|
case tp^.kind of
|
|
|
|
scalarType: begin
|
|
bKind := tp^.baseType;
|
|
if (etype^.baseType in [cgByte..cgULong,cgQuad,cgUQuad])
|
|
and (bKind in [cgByte..cgULong,cgQuad,cgUQuad]) then begin
|
|
if bKind in [cgLong,cgULong,cgQuad,cgUQuad] then
|
|
if eType^.baseType = cgUByte then
|
|
iPtr^.iVal := iPtr^.iVal & $000000FF
|
|
else if eType^.baseType = cgUWord then
|
|
iPtr^.iVal := iPtr^.iVal & $0000FFFF;
|
|
if bKind in [cgQuad,cgUQuad] then
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
if (etype^.baseType in [cgByte,cgWord,cgLong])
|
|
and (iPtr^.iVal < 0) then
|
|
iPtr^.qVal.hi := -1
|
|
else
|
|
iPtr^.qVal.hi := 0;
|
|
goto 3;
|
|
end; {if}
|
|
if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
iPtr^.rVal := expressionValue
|
|
else if etype^.baseType in
|
|
[cgReal,cgDouble,cgComp,cgExtended] then
|
|
iPtr^.rval := realExpressionValue;
|
|
goto 3;
|
|
end; {if}
|
|
Error(47);
|
|
errorFound := true;
|
|
goto 2;
|
|
|
|
3: if bitsize <> 0 then begin
|
|
|
|
{set up a bit field value}
|
|
if bitdisp < bitcount then
|
|
InitializeBitField;
|
|
bitmask := 0;
|
|
for i := 1 to bitsize do
|
|
bitmask := (bitmask << 1) | 1;
|
|
bitmask := bitmask & expressionValue;
|
|
for i := 1 to bitdisp do
|
|
bitmask := bitmask << 1;
|
|
bitvalue := bitvalue | bitmask;
|
|
bitcount := bitcount + bitsize;
|
|
end; {if}
|
|
end;
|
|
|
|
arrayType: begin
|
|
if tp^.aType^.kind = scalarType then
|
|
if tp^.aType^.baseType in [cgByte,cgUByte] then
|
|
if eType^.baseType = cgString then
|
|
goto 2;
|
|
Error(46);
|
|
errorFound := true;
|
|
end;
|
|
|
|
pointerType:
|
|
if etype = stringTypePtr then begin
|
|
iPtr^.isConstant := true;
|
|
iPtr^.iType := ccPointer;
|
|
iPtr^.pval := 0;
|
|
iPtr^.pPlus := false;
|
|
iPtr^.isName := false;
|
|
iPtr^.pStr := longstringPtr(expressionValue);
|
|
end {if}
|
|
else if etype^.kind = scalarType then
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
if expressionValue = 0 then
|
|
iPtr^.iType := cgULong
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end {else}
|
|
else if etype^.baseType in [cgQuad,cgUQuad] then
|
|
if (llExpressionValue.hi = 0) and
|
|
(llExpressionValue.lo = 0) then
|
|
iPtr^.iType := cgULong
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end {else}
|
|
else begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end {else}
|
|
else if etype^.kind = pointerType then begin
|
|
iPtr^.iType := cgULong;
|
|
iPtr^.pval := expressionValue;
|
|
end {else if}
|
|
else begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end; {else}
|
|
|
|
structType,unionType,enumType: begin
|
|
Error(46);
|
|
errorFound := true;
|
|
end;
|
|
|
|
otherwise:
|
|
Error(57);
|
|
|
|
end; {case}
|
|
2: DisposeTree(initializerTree);
|
|
end {if}
|
|
else begin
|
|
if ((tp^.kind = pointerType)
|
|
or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong])))
|
|
and (bitsize = 0)
|
|
then begin
|
|
iPtr^.iType := ccPointer;
|
|
if variable^.storage in [external,global,private] then begin
|
|
|
|
{do pointer constants with + or -}
|
|
iPtr^.isConstant := true;
|
|
tree := initializerTree;
|
|
while tree^.token.kind = castoper do
|
|
tree := tree^.left;
|
|
offset := 0;
|
|
operator := tree^.token.kind;
|
|
while operator in [plusch,minusch] do begin
|
|
with tree^.right^.token do
|
|
if kind in [intConst,uintconst,longConst,ulongconst,
|
|
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
|
|
else if kind in [longConst,ulongconst] then begin
|
|
offset2 := lval;
|
|
if (lval & $ff000000 <> 0)
|
|
and (lval & $ff000000 <> $ff000000) then
|
|
Error(6);
|
|
end {else if}
|
|
else {if kind = longlongConst then} begin
|
|
offset2 := qval.lo;
|
|
with qval do
|
|
if not (((hi = 0) and (lo & $ff000000 = 0)) or
|
|
((hi = -1) and (lo & $ff000000 = $ff000000))) then
|
|
Error(6);
|
|
end; {else}
|
|
if operator = plusch then
|
|
offset := offset + offset2
|
|
else
|
|
offset := offset - offset2;
|
|
end {if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
tree := tree^.left;
|
|
operator := tree^.token.kind;
|
|
end; {if}
|
|
kind := tree^.token.kind;
|
|
if kind = ident then begin
|
|
|
|
{handle names of functions or static arrays}
|
|
ip := FindSymbol(tree^.token, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
end {if}
|
|
else begin
|
|
tKind := ip^.itype^.kind;
|
|
if tKind = functionType then begin
|
|
if operator in [plusch,minusch] then begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {if}
|
|
end {if}
|
|
else if (tKind = arrayType)
|
|
and (ip^.storage in [external,global,private]) then begin
|
|
offset := offset*ip^.itype^.atype^.size;
|
|
end {else if}
|
|
else if tKind = pointerType then begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := true;
|
|
iPtr^.pName := ip^.name;
|
|
end; {if}
|
|
end {if}
|
|
else if kind = uand then begin
|
|
tree := tree^.left;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := true;
|
|
if tree^.token.kind = ident then begin
|
|
ip := FindSymbol(tree^.token, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
end {if}
|
|
else
|
|
if ip^.storage in [external,global,private] then begin
|
|
offset := offset*ip^.itype^.size;
|
|
iPtr^.pName := ip^.name;
|
|
end {if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
tp := Subscript(tree);
|
|
if offset > 0 then
|
|
iPtr^.pPlus := true
|
|
else begin
|
|
iPtr^.pPlus := false;
|
|
offset := -offset;
|
|
end; {else}
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
end {else if}
|
|
else if kind in [dotch,uasterisk] then begin
|
|
iPtr^.isName := true;
|
|
tp := Subscript(tree);
|
|
if offset > 0 then
|
|
iPtr^.pPlus := true
|
|
else begin
|
|
iPtr^.pPlus := false;
|
|
offset := -offset;
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
end {else if}
|
|
else if kind = stringConst then begin
|
|
iPtr^.pval := offset;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := false;
|
|
iPtr^.pStr := tree^.token.sval;
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
DisposeTree(initializerTree);
|
|
goto 1;
|
|
end; {if}
|
|
end {if}
|
|
else if tp^.kind in [structType,unionType] then
|
|
iPtr^.isStructOrUnion := true;
|
|
|
|
{handle auto variables}
|
|
if bitsize <> 0 then begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := bitdisp;
|
|
iPtr^.bitsize := bitsize;
|
|
iPtr^.isStructOrUnion := false;
|
|
end; {if}
|
|
if variable^.storage in [external,global,private] then begin
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {else}
|
|
iPtr^.isConstant := false;
|
|
iPtr^.iTree := initializerTree;
|
|
iPtr^.bitdisp := bitdisp;
|
|
iPtr^.bitsize := bitsize;
|
|
end; {else}
|
|
1:
|
|
end; {GetInitializerValue}
|
|
|
|
|
|
procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer;
|
|
main: boolean);
|
|
|
|
{ initialize one level of the type }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - pointer to the type being initialized }
|
|
{ bitsize - size of bit field (0 for non-bit fields) }
|
|
{ bitdisp - disp of bit field; unused if bitsize = 0 }
|
|
{ main - is this a call from the main level? }
|
|
|
|
var
|
|
bitCount: integer; {# of bits in a union}
|
|
braces: boolean; {is the initializer inclosed in braces?}
|
|
count,maxCount: longint; {for tracking the size of an initializer}
|
|
ep: tokenPtr; {for forming string expression}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
ip: identPtr; {for tracing field lists}
|
|
kind: typeKind; {base type of an initializer}
|
|
ktp: typePtr; {array type with definedTypes removed}
|
|
lPrintMacroExpansions: boolean; {local copy of printMacroExpansions}
|
|
|
|
|
|
procedure Fill (count: longint; tp: typePtr);
|
|
|
|
{ fill in unspecified space in an initialized array with 0 }
|
|
{ }
|
|
{ parameters: }
|
|
{ count - ^ elements of this type to create }
|
|
{ tp - ptr to type of elements to create }
|
|
|
|
var
|
|
i: longint; {loop variable}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
tk: tokenPtr; {expression record}
|
|
ip: identPtr; {pointer to next field in a structure}
|
|
|
|
begin {Fill}
|
|
{ writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug}
|
|
InitializeBitField; {if needed, do the bit field}
|
|
if tp^.kind = arrayType then
|
|
|
|
{fill an array}
|
|
Fill(count*tp^.elements ,tp^.aType)
|
|
else if tp^.kind = structType then begin
|
|
|
|
{fill a structure}
|
|
if variable^.storage in [external,global,private] then
|
|
Fill(count * tp^.size, sCharPtr)
|
|
else begin
|
|
i := count;
|
|
while i <> 0 do begin
|
|
ip := tp^.fieldList;
|
|
while ip <> nil do begin
|
|
Fill(1, ip^.iType);
|
|
ip := ip^.next;
|
|
end; {while}
|
|
i := i-1;
|
|
end; {while}
|
|
end; {else}
|
|
end {else if}
|
|
else if tp^.kind = unionType then begin
|
|
|
|
{fill a union}
|
|
if variable^.storage in [external,global,private] then
|
|
Fill(count * tp^.size, sCharPtr)
|
|
else
|
|
Fill(count, tp^.fieldList^.iType);
|
|
end {else if}
|
|
else
|
|
|
|
{fill a single value}
|
|
while count <> 0 do begin
|
|
iPtr := pointer(Calloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := variable^.storage in [external,global,private];
|
|
{iPtr^.bitdisp := 0;}
|
|
{iPtr^.bitsize := 0;}
|
|
{iPtr^.isStructOrUnion := false;}
|
|
if iPtr^.isConstant then begin
|
|
if tp^.kind = scalarType then
|
|
iPtr^.itype := tp^.baseType
|
|
else if tp^.kind = pointertype then begin
|
|
iPtr^.itype := cgULong;
|
|
{iPtr^.iVal := 0;}
|
|
end {else if}
|
|
else begin
|
|
iPtr^.itype := cgWord;
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
new(tk);
|
|
tk^.next := nil;
|
|
tk^.left := nil;
|
|
tk^.middle := nil;
|
|
tk^.right := nil;
|
|
tk^.token.kind := intconst;
|
|
tk^.token.class := intConstant;
|
|
tk^.token.ival := 0;
|
|
iPtr^.iTree := tk;
|
|
end; {else}
|
|
if count < 16384 then begin
|
|
iPtr^.count := long(count).lsw;
|
|
count := 0;
|
|
end {if}
|
|
else begin
|
|
iPtr^.count := 16384;
|
|
count := count-16384;
|
|
end; {else}
|
|
end; {while}
|
|
end; {Fill}
|
|
|
|
|
|
procedure RecomputeSizes (tp: typePtr);
|
|
|
|
{ a size has been inferred from an initializer - set the }
|
|
{ appropriate type size values }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type to check }
|
|
|
|
begin {RecomputeSizes}
|
|
if tp^.aType^.kind = arrayType then
|
|
RecomputeSizes(tp^.aType);
|
|
with tp^ do
|
|
size := aType^.size*elements;
|
|
end; {RecomputeSizes}
|
|
|
|
begin {InitializeTerm}
|
|
braces := false; {allow for an opening brace}
|
|
if token.kind = lbracech then begin
|
|
NextToken;
|
|
braces := true;
|
|
end; {if}
|
|
|
|
{handle arrays}
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
kind := tp^.kind;
|
|
if kind = arrayType then begin
|
|
ktp := tp^.atype;
|
|
while ktp^.kind = definedType do
|
|
ktp := ktp^.dType;
|
|
kind := ktp^.kind;
|
|
|
|
{handle string constants}
|
|
if (token.kind = stringConst) and (kind = scalarType)
|
|
and (ktp^.baseType in [cgByte,cgUByte]) then begin
|
|
if tp^.elements = 0 then begin
|
|
tp^.elements := token.sval^.length + 1;
|
|
RecomputeSizes(variable^.itype);
|
|
end {if}
|
|
else if tp^.elements < token.sval^.length then begin
|
|
Error(44);
|
|
errorFound := true;
|
|
end; {else if}
|
|
with ktp^ do begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
if (variable^.storage in [external,global,private]) then begin
|
|
iPtr^.isConstant := true;
|
|
iPtr^.itype := cgString;
|
|
iPtr^.sval := token.sval;
|
|
count := tp^.elements - token.sval^.length;
|
|
if count <> 0 then
|
|
Fill(count, sCharPtr);
|
|
end {if}
|
|
else begin
|
|
iPtr^.isConstant := false;
|
|
new(ep);
|
|
iPtr^.iTree := ep;
|
|
ep^.next := nil;
|
|
ep^.left := nil;
|
|
ep^.middle := nil;
|
|
ep^.right := nil;
|
|
ep^.token := token;
|
|
end; {else}
|
|
end; {with}
|
|
NextToken;
|
|
end {if}
|
|
|
|
{handle arrays of non-strings}
|
|
else if kind in
|
|
[scalarType,pointerType,enumType,arrayType,structType,unionType] then
|
|
begin
|
|
count := 0; {get the expressions|initializers}
|
|
maxCount := tp^.elements;
|
|
if token.kind <> rbracech then
|
|
repeat
|
|
InitializeTerm(ktp, 0, 0, false);
|
|
count := count+1;
|
|
if count <> maxCount then begin
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
done := token.kind = rbracech;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy) or (count = maxCount);
|
|
if maxCount <> 0 then begin
|
|
count := maxCount-count;
|
|
if count <> 0 then {if there weren't enough initializers...}
|
|
Fill(count,ktp); { fill in the blank spots}
|
|
end {if}
|
|
else begin
|
|
tp^.elements := count; {set the array size}
|
|
RecomputeSizes(variable^.itype);
|
|
end; {else}
|
|
end {else if}
|
|
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if}
|
|
|
|
{handle structures and unions}
|
|
else if kind in [structType, unionType] then begin
|
|
if braces or (not main) then begin
|
|
count := tp^.size;
|
|
ip := tp^.fieldList;
|
|
bitCount := 0;
|
|
lPrintMacroExpansions := printMacroExpansions;
|
|
while (ip <> nil) and (ip^.itype^.size > 0) do begin
|
|
if ip^.isForwardDeclared then
|
|
ResolveForwardReference(ip);
|
|
if token.kind = rbracech then begin {initialize this field to 0}
|
|
printMacroExpansions := false; {inhibit token echo}
|
|
PutBackToken(token, false);
|
|
PutBackToken(token, false);
|
|
token.kind := intconst;
|
|
token.class := intConstant;
|
|
token.ival := 0;
|
|
PutBackToken(token, false);
|
|
token.kind := lbracech;
|
|
token.class := reservedSymbol;
|
|
end; {if}
|
|
if ip^.bitSize = 0 then
|
|
if bitCount > 0 then begin
|
|
InitializeBitField;
|
|
bitCount := (bitCount+7) div 8;
|
|
count := count-bitCount;
|
|
bitCount := 0;
|
|
end; {if}
|
|
InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false);
|
|
if ip^.bitSize <> 0 then begin
|
|
bitCount := bitCount + ip^.bitSize;
|
|
if bitCount > maxBitField then begin
|
|
count := count - (maxBitField div 8);
|
|
bitCount := ip^.bitSize;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
count := count-ip^.itype^.size;
|
|
end; {else}
|
|
{ writeln('Initializer: ', ip^.bitsize:10, ip^.bitdisp:10, bitCount:10); {debug}
|
|
if kind = unionType then
|
|
ip := nil
|
|
else
|
|
ip := ip^.next;
|
|
if token.kind = commach then begin
|
|
if ip <> nil then
|
|
NextToken;
|
|
end {if}
|
|
else if token.kind <> rbracech then
|
|
ip := nil;
|
|
end; {while}
|
|
if bitCount > 0 then begin
|
|
InitializeBitField;
|
|
bitCount := (bitCount+7) div 8;
|
|
count := count-bitCount;
|
|
bitCount := 0;
|
|
end; {if}
|
|
if count > 0 then
|
|
if variable^.storage in [external,global,private] then
|
|
Fill(count, sCharPtr);
|
|
printMacroExpansions := lPrintMacroExpansions;
|
|
end {if}
|
|
else {struct/union assignment initializer}
|
|
GetInitializerValue(tp, bitsize, bitdisp);
|
|
end {else if}
|
|
|
|
{handle single-valued types}
|
|
else if kind in [scalarType,pointerType,enumType] then
|
|
GetInitializerValue(tp, bitsize, bitdisp)
|
|
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
|
|
if braces then begin {if there was an opening brace then }
|
|
if token.kind = commach then { insist on a closing brace }
|
|
NextToken;
|
|
if token.kind = rbracech then
|
|
NextToken
|
|
else begin
|
|
Error(23);
|
|
while not (token.kind in [rbracech,eofsy]) do
|
|
NextToken;
|
|
NextToken;
|
|
errorFound := true;
|
|
end; {else}
|
|
end; {if}
|
|
end; {InitializeTerm}
|
|
|
|
begin {Initializer}
|
|
bitcount := 0; {set up for bit fields}
|
|
bitvalue := 0;
|
|
errorFound := false; {no errors found so far}
|
|
luseGlobalPool := useGlobalPool; {use global memory for global vars}
|
|
useGlobalPool := (variable^.storage in [external,global,private])
|
|
or useGlobalPool;
|
|
{make sure a required '{' is there}
|
|
if not (token.kind in [lbracech,stringConst]) then
|
|
if variable^.itype^.kind = arrayType then begin
|
|
Error(27);
|
|
errorFound := true;
|
|
end; {if}
|
|
InitializeTerm(variable^.itype, 0, 0, true); {do the initialization}
|
|
variable^.state := initialized; {mark the variable as initialized}
|
|
iPtr := variable^.iPtr; {reverse the initializer list}
|
|
jPtr := nil;
|
|
while iPtr <> nil do begin
|
|
kPtr := iPtr;
|
|
iPtr := iPtr^.next;
|
|
kPtr^.next := jPtr;
|
|
jPtr := kPtr;
|
|
end; {while}
|
|
variable^.iPtr := jPtr;
|
|
if errorFound then {eliminate bad initializers}
|
|
variable^.state := defined;
|
|
useGlobalPool := luseGlobalPool; {restore useGlobalPool}
|
|
end; {Initializer}
|
|
|
|
|
|
procedure DoStaticAssert;
|
|
|
|
{ process a static assertion }
|
|
|
|
begin {DoStaticAssert}
|
|
NextToken;
|
|
Match(lparench, 13);
|
|
Expression(arrayExpression, [commach]);
|
|
if (expressionType = nil) or (expressionType^.kind <> scalarType) then
|
|
Error(18)
|
|
else if expressionValue = 0 then
|
|
Error(132);
|
|
Match(commach, 86);
|
|
Match(stringconst, 83);
|
|
Match(rparench, 12);
|
|
Match(semicolonch, 22);
|
|
end; {DoStaticAssert}
|
|
|
|
|
|
procedure DeclarationSpecifiers (allowedTokens: tokenSet;
|
|
expectedNext: tokenEnum);
|
|
|
|
{ handle declaration specifiers or a specifier-qualifier list }
|
|
{ }
|
|
{ parameters: }
|
|
{ allowedTokens - specifiers/qualifiers that can be used }
|
|
{ expectedNext - token usually expected after declaration }
|
|
{ specifiers (used for error messages only) }
|
|
{ }
|
|
{ outputs: }
|
|
{ isForwardDeclared - is the field list component }
|
|
{ referencing a forward struct/union? }
|
|
{ skipDeclarator - for enum,struct,union with no }
|
|
{ declarator }
|
|
{ typespec - type specifier }
|
|
{ declarationModifiers - all storage class specifiers, }
|
|
{ type qualifiers, function specifiers, and }
|
|
{ alignment specifiers in this declaration }
|
|
|
|
label 1,2,3;
|
|
|
|
var
|
|
done: boolean; {for loop termination}
|
|
enumVal: integer; {default value for the next enum constant}
|
|
tPtr: typePtr; {for building types}
|
|
variable: identPtr; {enumeration variable}
|
|
|
|
structPtr: identPtr; {structure identifier}
|
|
structTypePtr: typePtr; {structure type}
|
|
tKind: typeKind; {defining structure or union?}
|
|
|
|
ttoken: tokenType; {temp variable for struct name}
|
|
lUseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
globalStruct: boolean; {did we force global pool use?}
|
|
|
|
typeSpecifiers: tokenSet; {set of tokens specifying the type}
|
|
typeDone: boolean; {no more type specifiers can be accepted}
|
|
|
|
isConstant: boolean; {did we find a constsy?}
|
|
|
|
myIsForwardDeclared: boolean; {value of isForwardDeclared to generate}
|
|
mySkipDeclarator: boolean; {value of skipDeclarator to generate}
|
|
myTypeSpec: typePtr; {value of typeSpec to generate}
|
|
myDeclarationModifiers: tokenSet; {all modifiers in this declaration}
|
|
|
|
isLongLong: boolean; {is this a "long long" type?}
|
|
|
|
procedure FieldList (tp: typePtr; kind: typeKind);
|
|
|
|
{ handle a field list }
|
|
{ }
|
|
{ parameters }
|
|
{ tp - place to store the type pointer }
|
|
|
|
label 1;
|
|
|
|
var
|
|
bitDisp: integer; {current bit disp}
|
|
disp: longint; {current byte disp}
|
|
done: boolean; {for loop termination}
|
|
fl,tfl,ufl: identPtr; {field list}
|
|
ldoingParameters: boolean; {local copy of doingParameters}
|
|
lisForwardDeclared: boolean; {local copy of isForwardDeclared}
|
|
lstorageClass: tokenEnum; {storage class of the declaration}
|
|
maxDisp: longint; {for determining union sizes}
|
|
variable: identPtr; {variable being defined}
|
|
didFlexibleArray: boolean; {have we seen a flexible array member?}
|
|
alignmentSpecified: boolean; {was alignment explicitly specified?}
|
|
|
|
begin {FieldList}
|
|
ldoingParameters := doingParameters; {allow fields in K&R dec. area}
|
|
doingParameters := false;
|
|
lisForwardDeclared := isForwardDeclared; {stack this value}
|
|
lStorageClass := storageClass; {don't allow auto in a struct}
|
|
storageClass := ident;
|
|
bitDisp := 0; {start allocation from byte 0}
|
|
disp := 0;
|
|
maxDisp := 0;
|
|
didFlexibleArray := false;
|
|
fl := nil; {nothing in the field list, yet}
|
|
{while there are entries in the field list...}
|
|
1: while token.kind in structDeclarationStart do begin
|
|
if token.kind = _Static_assertsy then begin
|
|
DoStaticAssert;
|
|
goto 1;
|
|
end; {if}
|
|
DeclarationSpecifiers(specifierQualifierListElement, ident);
|
|
alignmentSpecified := _Alignassy in declarationModifiers;
|
|
if not skipDeclarator then
|
|
repeat {declare the variables...}
|
|
if didFlexibleArray then
|
|
Error(118);
|
|
variable := nil;
|
|
if token.kind <> colonch then begin
|
|
Declarator(typeSpec, variable, fieldListSpace, false);
|
|
if variable <> nil then {enter the var in the field list}
|
|
begin
|
|
tfl := fl; {(check for dups)}
|
|
while tfl <> nil do begin
|
|
if tfl^.name^ = variable^.name^ then
|
|
Error(42);
|
|
tfl := tfl^.next;
|
|
end; {while}
|
|
variable^.next := fl;
|
|
fl := variable;
|
|
end; {if}
|
|
end; {if}
|
|
if token.kind = colonch then {handle a bit field}
|
|
begin
|
|
if kind = unionType then
|
|
Error(56);
|
|
NextToken;
|
|
Expression(arrayExpression,[commach,semicolonch]);
|
|
if (expressionValue >= maxBitField) or (expressionValue < 0) then
|
|
begin
|
|
Error(54);
|
|
expressionValue := maxBitField-1;
|
|
end; {if}
|
|
if (bitdisp+long(expressionValue).lsw > maxBitField)
|
|
or (long(expressionValue).lsw = 0) then begin
|
|
disp := disp+((bitDisp+7) div 8);
|
|
bitdisp := 0;
|
|
if long(expressionValue).lsw = 0 then
|
|
if variable <> nil then
|
|
Error(55);
|
|
end; {if}
|
|
if variable <> nil then begin
|
|
variable^.disp := disp;
|
|
variable^.bitdisp := bitdisp;
|
|
variable^.bitsize := long(expressionValue).lsw;
|
|
tPtr := variable^.itype;
|
|
end {if}
|
|
else
|
|
tPtr := typeSpec;
|
|
bitdisp := bitdisp+long(expressionValue).lsw;
|
|
if (tPtr^.kind <> scalarType)
|
|
or not (tPtr^.baseType in
|
|
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])
|
|
or (expressionValue > tPtr^.size*8)
|
|
or ((expressionValue > 1) and (tPtr^.cType = ctBool)) then
|
|
Error(115);
|
|
if alignmentSpecified then
|
|
Error(142);
|
|
end {if}
|
|
else if variable <> nil then begin
|
|
if bitdisp <> 0 then begin
|
|
disp := disp+((bitDisp+7) div 8);
|
|
bitdisp := 0;
|
|
end {if}
|
|
else if kind = unionType then
|
|
disp := 0;
|
|
variable^.disp := disp;
|
|
variable^.bitdisp := bitdisp;
|
|
variable^.bitsize := 0;
|
|
disp := disp + variable^.itype^.size;
|
|
if disp > maxDisp then
|
|
maxDisp := disp;
|
|
if variable^.itype^.size = 0 then
|
|
if (variable^.itype^.kind = arrayType)
|
|
and (disp > 0) then {handle flexible array member}
|
|
didFlexibleArray := true
|
|
else
|
|
Error(117);
|
|
end {if}
|
|
else
|
|
Error(116);
|
|
if token.kind = commach then {allow repeated declarations}
|
|
begin
|
|
NextToken;
|
|
done := false;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy)
|
|
else
|
|
Error(116);
|
|
Match(semicolonch,22); {insist on a closing ';'}
|
|
end; {while}
|
|
if fl <> nil then begin
|
|
ufl := nil; {reverse the field list}
|
|
while fl <> nil do begin
|
|
tfl := fl;
|
|
fl := fl^.next;
|
|
tfl^.next := ufl;
|
|
ufl := tfl;
|
|
end; {while}
|
|
if kind = structType then begin {return the field list}
|
|
if bitdisp <> 0 then
|
|
disp := disp+((bitDisp+7) div 8);
|
|
tp^.size := disp;
|
|
end {if}
|
|
else
|
|
tp^.size := maxDisp;
|
|
tp^.fieldList := ufl;
|
|
end {if}
|
|
else
|
|
Error(26); {error if no named declarations}
|
|
storageClass := lStorageClass; {restore default storage class}
|
|
isForwardDeclared := lisForwardDeclared; {restore the forward flag}
|
|
doingParameters := ldoingParameters; {restore the parameters flag}
|
|
end; {FieldList}
|
|
|
|
|
|
procedure ResolveType;
|
|
|
|
{ Resolve a set of type specifier keywords to a type }
|
|
|
|
begin {ResolveType}
|
|
{See C17 6.7.2}
|
|
if typeSpecifiers = [voidsy] then
|
|
myTypeSpec := voidPtr
|
|
else if typeSpecifiers = [charsy] then
|
|
myTypeSpec := charPtr
|
|
else if typeSpecifiers = [signedsy,charsy] then
|
|
myTypeSpec := sCharPtr
|
|
else if typeSpecifiers = [unsignedsy,charsy] then
|
|
myTypeSpec := uCharPtr
|
|
else if (typeSpecifiers = [shortsy])
|
|
or (typeSpecifiers = [signedsy,shortsy])
|
|
or (typeSpecifiers = [shortsy,intsy])
|
|
or (typeSpecifiers = [signedsy,shortsy,intsy]) then
|
|
myTypeSpec := shortPtr
|
|
else if (typeSpecifiers = [unsignedsy,shortsy])
|
|
or (typeSpecifiers = [unsignedsy,shortsy,intsy]) then
|
|
myTypeSpec := uShortPtr
|
|
else if (typeSpecifiers = [intsy])
|
|
or (typeSpecifiers = [signedsy])
|
|
or (typeSpecifiers = [signedsy,intsy]) then begin
|
|
if unix_1 then
|
|
myTypeSpec := int32Ptr
|
|
else
|
|
myTypeSpec := intPtr;
|
|
end {else if}
|
|
else if (typeSpecifiers = [unsignedsy])
|
|
or (typeSpecifiers = [unsignedsy,intsy]) then begin
|
|
if unix_1 then
|
|
myTypeSpec := uInt32Ptr
|
|
else
|
|
myTypeSpec := uIntPtr;
|
|
end {else if}
|
|
else if (typeSpecifiers = [longsy])
|
|
or (typeSpecifiers = [signedsy,longsy])
|
|
or (typeSpecifiers = [longsy,intsy])
|
|
or (typeSpecifiers = [signedsy,longsy,intsy]) then begin
|
|
if isLongLong then
|
|
myTypeSpec := longLongPtr
|
|
else
|
|
myTypeSpec := longPtr;
|
|
end {else if}
|
|
else if (typeSpecifiers = [unsignedsy,longsy])
|
|
or (typeSpecifiers = [unsignedsy,longsy,intsy]) then begin
|
|
if isLongLong then
|
|
myTypeSpec := uLongLongPtr
|
|
else
|
|
myTypeSpec := uLongPtr;
|
|
end {else if}
|
|
else if typeSpecifiers = [floatsy] then
|
|
myTypeSpec := floatPtr
|
|
else if typeSpecifiers = [doublesy] then
|
|
myTypeSpec := doublePtr
|
|
else if (typeSpecifiers = [longsy,doublesy])
|
|
or (typeSpecifiers = [extendedsy]) then
|
|
myTypeSpec := extendedPtr
|
|
else if typeSpecifiers = [compsy] then
|
|
myTypeSpec := compPtr
|
|
else if typeSpecifiers = [_Boolsy] then begin
|
|
myTypeSpec := boolPtr;
|
|
end {else if}
|
|
else
|
|
UnexpectedTokenError(expectedNext);
|
|
end; {ResolveType}
|
|
|
|
|
|
begin {DeclarationSpecifiers}
|
|
myTypeSpec := nil;
|
|
myIsForwardDeclared := false; {not doing a forward reference (yet)}
|
|
mySkipDeclarator := false; {declarations are required (so far)}
|
|
myDeclarationModifiers := [];
|
|
typeSpecifiers := [];
|
|
typeDone := false;
|
|
isConstant := false;
|
|
isLongLong := false;
|
|
while token.kind in allowedTokens do begin
|
|
case token.kind of
|
|
{storage class specifiers}
|
|
autosy,externsy,registersy,staticsy,typedefsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
if storageClass <> ident then begin
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
UnexpectedTokenError(expectedNext)
|
|
else
|
|
Error(26);
|
|
end; {if}
|
|
storageClass := token.kind;
|
|
if not doingFunction then
|
|
if token.kind = autosy then
|
|
Error(62);
|
|
if doingParameters then begin
|
|
if token.kind <> registersy then
|
|
Error(87);
|
|
end {if}
|
|
else if storageClass in [staticsy,typedefsy] then begin
|
|
{Error if we may have allocated type info in local pool.}
|
|
{This should not come up with current use of MM pools. }
|
|
if not useGlobalPool then
|
|
if typeDone then
|
|
Error(57);
|
|
useGlobalPool := true;
|
|
end; {else if}
|
|
if doingForLoopClause1 then
|
|
if not (storageClass in [autosy,registersy]) then
|
|
Error(127);
|
|
NextToken;
|
|
end;
|
|
|
|
_Thread_localsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
Error(139);
|
|
NextToken;
|
|
end;
|
|
|
|
{function specifiers}
|
|
inlinesy,_Noreturnsy,asmsy,pascalsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
NextToken;
|
|
end;
|
|
|
|
{type qualifiers}
|
|
constsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
isConstant := true;
|
|
NextToken;
|
|
end;
|
|
|
|
volatilesy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
volatile := true;
|
|
NextToken;
|
|
end;
|
|
|
|
restrictsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
if (myTypeSpec^.kind <> pointerType)
|
|
or (myTypeSpec^.pType^.kind = functionType) then
|
|
Error(143);
|
|
NextToken;
|
|
end;
|
|
|
|
_Atomicsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
Error(137);
|
|
NextToken;
|
|
if token.kind = lparench then begin
|
|
{_Atomic(typename) as type specifier}
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
UnexpectedTokenError(expectedNext);
|
|
NextToken;
|
|
TypeName;
|
|
myTypeSpec := typeSpec;
|
|
Match(rparench, 12);
|
|
end; {if}
|
|
typeDone := true;
|
|
end;
|
|
|
|
{type specifiers}
|
|
unsignedsy,signedsy,intsy,longsy,charsy,shortsy,floatsy,doublesy,voidsy,
|
|
compsy,extendedsy,_Boolsy: begin
|
|
if typeDone then
|
|
UnexpectedTokenError(expectedNext)
|
|
else if token.kind in typeSpecifiers then begin
|
|
if (token.kind = longsy) and
|
|
((myTypeSpec = longPtr) or (myTypeSpec = uLongPtr)) then begin
|
|
isLongLong := true;
|
|
ResolveType;
|
|
end
|
|
else
|
|
UnexpectedTokenError(expectedNext);
|
|
end {if}
|
|
else begin
|
|
if restrictsy in myDeclarationModifiers then begin
|
|
myDeclarationModifiers := myDeclarationModifiers - [restrictsy];
|
|
Error(143);
|
|
end; {if}
|
|
typeSpecifiers := typeSpecifiers + [token.kind];
|
|
ResolveType;
|
|
end; {else}
|
|
NextToken;
|
|
end;
|
|
|
|
_Complexsy,_Imaginarysy: begin
|
|
Error(136);
|
|
NextToken;
|
|
end;
|
|
|
|
enumsy: begin {enum}
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
UnexpectedTokenError(expectedNext)
|
|
else if restrictsy in myDeclarationModifiers then
|
|
Error(143);
|
|
NextToken; {skip the 'enum' token}
|
|
if token.kind = ident then begin {handle a type definition}
|
|
variable := FindSymbol(token, tagSpace, true, true);
|
|
ttoken := token;
|
|
NextToken;
|
|
if variable <> nil then
|
|
if variable^.itype^.kind = enumType then
|
|
if token.kind <> lbracech then
|
|
goto 1;
|
|
tPtr := pointer(Malloc(sizeof(typeRecord)));
|
|
tPtr^.size := cgWordSize;
|
|
tPtr^.saveDisp := 0;
|
|
tPtr^.isConstant := false;
|
|
tPtr^.kind := enumType;
|
|
variable :=
|
|
NewSymbol(ttoken.name, tPtr, storageClass, tagSpace, defined);
|
|
end {if}
|
|
else if token.kind <> lbracech then
|
|
Error(9);
|
|
enumVal := 0; {set the default value}
|
|
if token.kind = lbracech then begin
|
|
NextToken; {skip the '{'}
|
|
repeat {declare the enum constants}
|
|
tPtr := pointer(Malloc(sizeof(typeRecord)));
|
|
tPtr^.size := cgWordSize;
|
|
tPtr^.saveDisp := 0;
|
|
tPtr^.isConstant := false;
|
|
tPtr^.kind := enumConst;
|
|
if token.kind = ident then begin
|
|
variable :=
|
|
NewSymbol(token.name, tPtr, ident, variableSpace, defined);
|
|
NextToken;
|
|
end {if}
|
|
else
|
|
Error(9);
|
|
if token.kind = eqch then begin {handle explicit enumeration values}
|
|
NextToken;
|
|
Expression(arrayExpression,[commach,rbracech]);
|
|
enumVal := long(expressionValue).lsw;
|
|
if enumVal <> expressionValue then
|
|
Error(6);
|
|
end; {if}
|
|
tPtr^.eval := enumVal; {set the enumeration constant value}
|
|
enumVal := enumVal+1; {inc the default enumeration value}
|
|
if token.kind = commach then {next enumeration...}
|
|
begin
|
|
done := false;
|
|
NextToken;
|
|
{kws -- allow trailing , in enum }
|
|
{ C99 6.7.2.2 Enumeration specifiers }
|
|
if token.kind = rbracech then done := true;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
if token.kind = rbracech then
|
|
NextToken
|
|
else begin
|
|
Error(23);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {if}
|
|
1: mySkipDeclarator := token.kind = semicolonch;
|
|
myTypeSpec := intPtr;
|
|
typeDone := true;
|
|
end;
|
|
|
|
structsy, {struct}
|
|
unionsy: begin {union}
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
UnexpectedTokenError(expectedNext)
|
|
else if restrictsy in myDeclarationModifiers then
|
|
Error(143);
|
|
globalStruct := false; {we didn't make it global}
|
|
if token.kind = structsy then {set the type kind to use}
|
|
tKind := structType
|
|
else
|
|
tKind := unionType;
|
|
structPtr := nil; {no record, yet}
|
|
structTypePtr := defaultStruct; {use int as a default type}
|
|
NextToken; {skip 'struct' or 'union'}
|
|
if token.kind in [ident,typedef] {if there is a struct name then...}
|
|
then begin
|
|
{look up the name}
|
|
structPtr := FindSymbol(token, tagSpace, true, true);
|
|
ttoken := token; {record the structure name}
|
|
NextToken; {skip the structure name}
|
|
if structPtr = nil then begin {if the name hasn't been defined then...}
|
|
if token.kind <> lbracech then
|
|
structPtr := FindSymbol(ttoken, tagSpace, false, true);
|
|
if structPtr <> nil then
|
|
structTypePtr := structPtr^.itype
|
|
else begin
|
|
myIsForwardDeclared := true;
|
|
globalStruct := doingParameters and (token.kind <> lbracech);
|
|
if globalStruct then begin
|
|
lUseGlobalPool := useGlobalPool;
|
|
useGlobalPool := true;
|
|
end; {if}
|
|
structTypePtr := pointer(Calloc(sizeof(typeRecord)));
|
|
{structTypePtr^.size := 0;}
|
|
{structTypePtr^.saveDisp := 0;}
|
|
{structTypePtr^.isConstant := false;}
|
|
structTypePtr^.kind := tkind;
|
|
{structTypePtr^.fieldList := nil;}
|
|
{structTypePtr^.sName := nil;}
|
|
structPtr := NewSymbol(ttoken.name, structTypePtr, ident,
|
|
tagSpace, defined);
|
|
structTypePtr^.sName := structPtr^.name;
|
|
end;
|
|
end {if}
|
|
{the name has been defined, so...}
|
|
else if structPtr^.itype^.kind <> tKind then begin
|
|
Error(42); {it's an error if it's not a struct}
|
|
structPtr := nil;
|
|
end {else}
|
|
else begin {record the existing structure type}
|
|
structTypePtr := structPtr^.itype;
|
|
end; {else}
|
|
end {if}
|
|
else if token.kind <> lbracech then
|
|
Error(9); {its an error if there's no name or struct}
|
|
2: if token.kind = lbracech then {handle a structure definition...}
|
|
begin {error if we already have one!}
|
|
if (structTypePtr <> defaultStruct)
|
|
and (structTypePtr^.fieldList <> nil) then begin
|
|
Error(53);
|
|
structPtr := nil;
|
|
end; {if}
|
|
NextToken; {skip the '{'}
|
|
if structTypePtr = defaultStruct then begin
|
|
structTypePtr := pointer(Calloc(sizeof(typeRecord)));
|
|
{structTypePtr^.size := 0;}
|
|
{structTypePtr^.saveDisp := 0;}
|
|
{structTypePtr^.isConstant := false;}
|
|
structTypePtr^.kind := tkind;
|
|
{structTypePtr^.fieldList := nil;}
|
|
{structTypePtr^.sName := nil;}
|
|
end; {if}
|
|
if structPtr <> nil then
|
|
structPtr^.itype := structTypePtr;
|
|
FieldList(structTypePtr,tKind); {define the fields}
|
|
if token.kind = rbracech then {insist on a closing rbrace}
|
|
NextToken
|
|
else begin
|
|
Error(23);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {if}
|
|
if globalStruct then
|
|
useGlobalPool := lUseGlobalPool;
|
|
myTypeSpec := structTypePtr;
|
|
mySkipDeclarator := token.kind = semicolonch;
|
|
typeDone := true;
|
|
end;
|
|
|
|
typedef: begin {named type definition}
|
|
if (typeSpecifiers = []) and not typeDone then begin
|
|
myTypeSpec := token.symbolPtr^.itype;
|
|
if restrictsy in myDeclarationModifiers then
|
|
if (myTypeSpec^.kind <> pointerType)
|
|
or (myTypeSpec^.pType^.kind = functionType) then
|
|
Error(143);
|
|
NextToken;
|
|
typeDone := true;
|
|
end {if}
|
|
else {interpret as declarator, not type specifier}
|
|
goto 3;
|
|
end;
|
|
|
|
{alignment specifier}
|
|
_Alignassy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
NextToken;
|
|
Match(lparench, 13);
|
|
if token.kind in specifierQualifierListElement then begin
|
|
TypeName;
|
|
with typeSpec^ do
|
|
if (size = 0) or ((kind = arrayType) and (elements = 0)) then
|
|
Error(133);
|
|
end {if}
|
|
else begin
|
|
Expression(arrayExpression, [rparench]);
|
|
if (expressionValue <> 0) and (expressionValue <> 1) then
|
|
Error(138);
|
|
end;
|
|
Match(rparench, 12);
|
|
end;
|
|
|
|
otherwise: begin
|
|
Error(57);
|
|
NextToken;
|
|
end;
|
|
end; {case}
|
|
end; {while}
|
|
3:
|
|
isForwardDeclared := myIsForwardDeclared;
|
|
skipDeclarator := mySkipDeclarator;
|
|
typeSpec := myTypeSpec;
|
|
declarationModifiers := myDeclarationModifiers;
|
|
if typeSpec = nil then begin
|
|
typeSpec := intPtr; {under C89, default type is int}
|
|
if (lint & lintC99Syntax) <> 0 then
|
|
Error(151);
|
|
end; {if}
|
|
if isconstant then begin {handle a constant type}
|
|
new(tPtr);
|
|
if typeSpec^.kind in [structType,unionType] then begin
|
|
with tPtr^ do begin
|
|
size := typeSpec^.size;
|
|
kind := definedType;
|
|
dType := typeSpec;
|
|
saveDisp := 0;
|
|
end; {with}
|
|
end {if}
|
|
else
|
|
tPtr^ := typeSpec^;
|
|
tPtr^.isConstant := true;
|
|
typeSpec := tPtr;
|
|
end; {if}
|
|
end; {DeclarationSpecifiers}
|
|
|
|
|
|
{-- Externally available subroutines ---------------------------}
|
|
|
|
procedure DoDeclaration {doingPrototypes: boolean};
|
|
|
|
{ process a variable or function declaration }
|
|
{ }
|
|
{ parameters: }
|
|
{ doingPrototypes - are we processing a parameter list? }
|
|
|
|
label 1,2,3,4;
|
|
|
|
var
|
|
done: boolean; {for loop termination}
|
|
fName: stringPtr; {for forming uppercase names}
|
|
i: integer; {loop variable}
|
|
isAsm: boolean; {has the asm modifier been used?}
|
|
isInline: boolean; {has the inline specifier been used?}
|
|
isNoreturn: boolean; {has the _Noreturn specifier been used?}
|
|
alignmentSpecified: boolean; {was an alignment explicitly specified?}
|
|
lDoingParameters: boolean; {local copy of doingParameters}
|
|
lisPascal: boolean; {local copy of isPascal}
|
|
lp,tlp,tlp2: identPtr; {for tracing parameter list}
|
|
ltypeSpec: typePtr; {copy of type specifier}
|
|
lUseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
nextPdisp: integer; {for calculating parameter disps}
|
|
noFDefinitions: boolean; {are function definitions inhibited?}
|
|
p1,p2,p3: parameterPtr; {for reversing prototyped parameters}
|
|
variable: identPtr; {pointer to the variable being declared}
|
|
fnType: typePtr; {function type}
|
|
segType: integer; {segment type}
|
|
tp: typePtr; {for tracing type lists}
|
|
tk: tokenType; {work token}
|
|
typeFound: boolean; {has some type specifier been found?}
|
|
startLine: integer; {line where this declaration starts}
|
|
|
|
|
|
procedure CheckArray (v: identPtr; firstVariable: boolean);
|
|
|
|
{ make sure all required array sizes are specified }
|
|
{ }
|
|
{ parameters: }
|
|
{ v - pointer to the identifier to check }
|
|
{ firstVariable - can the first array subscript be of a }
|
|
{ non-fixed size? }
|
|
|
|
label 1;
|
|
|
|
var
|
|
tp: typePtr; {work pointer}
|
|
|
|
begin {CheckArray}
|
|
if v <> nil then begin {skip check if there's no variable}
|
|
tp := v^.itype; {initialize the type pointer}
|
|
while tp <> nil do begin {check all types}
|
|
if tp^.kind = arrayType then {if it's an array with an unspecified }
|
|
begin
|
|
if tp^.elements = 0 then { size and an unspecified size is not }
|
|
if not firstVariable then { allowed here, flag an error. }
|
|
begin
|
|
Error(49);
|
|
goto 1;
|
|
end; {if}
|
|
if tp^.aType^.size = 0 then begin
|
|
Error(123);
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
firstVariable := false; {unspecified sizes are only allowed in }
|
|
{ the first subscript }
|
|
case tp^.kind of {next type...}
|
|
arrayType:
|
|
tp := tp^.aType;
|
|
pointerType: begin
|
|
tp := tp^.pType;
|
|
firstVariable := true; {(also allowed for pointers to arrays)}
|
|
end;
|
|
functionType:
|
|
tp := tp^.fType;
|
|
otherwise:
|
|
tp := nil;
|
|
end; {case}
|
|
end; {while}
|
|
end; {if}
|
|
1:
|
|
end; {CheckArray}
|
|
|
|
|
|
procedure SegmentStatement;
|
|
|
|
{ compile a segment statement }
|
|
{ }
|
|
{ statement syntax: }
|
|
{ }
|
|
{ 'segment' string-constant [',' 'dynamic'] }
|
|
|
|
var
|
|
i: integer; {loop variable}
|
|
len: integer; {segment name length}
|
|
|
|
begin {SegmentStatement}
|
|
NextToken;
|
|
if token.kind = stringConst then begin
|
|
for i := 1 to 10 do begin
|
|
defaultSegment[i] := chr(0);
|
|
currentSegment[i] := chr(0);
|
|
end; {for}
|
|
len := token.sval^.length;
|
|
if len > 10 then
|
|
len := 10;
|
|
for i := 1 to len do
|
|
defaultSegment[i] := token.sval^.str[i];
|
|
for i := 1 to len do
|
|
currentSegment[i] := token.sval^.str[i];
|
|
FlagPragmas(p_segment);
|
|
NextToken;
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = ident then begin
|
|
if token.name^ = 'dynamic' then
|
|
segmentKind := $8000
|
|
else Error(84);
|
|
NextToken;
|
|
end {if}
|
|
else Error(84);
|
|
end {if}
|
|
else
|
|
segmentKind := 0;
|
|
Match(semicolonch,22);
|
|
end {if}
|
|
else begin
|
|
Error(83);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {SegmentStatement}
|
|
|
|
|
|
function InPartialList (fName: stringPtr): boolean;
|
|
|
|
{ See if the function is in the partial compile list. }
|
|
{ }
|
|
{ If the function is in the list, the function name is }
|
|
{ removed from the list, and true is returned. If not, }
|
|
{ false is returned. }
|
|
{ }
|
|
{ parameters: }
|
|
{ fName - name of the function to check for }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
ch: char; {work character}
|
|
i,j: integer; {loop variable}
|
|
len: integer; {length of fName}
|
|
|
|
begin {InPartialList}
|
|
i := partialFileGS.theString.size; {strip trailing blanks}
|
|
while (i > 0) and (partialFileGS.theString.theString[i] = ' ') do begin
|
|
partialFileGS.theString.theString[i] := chr(0);
|
|
i := i-1;
|
|
end; {while}
|
|
while partialFileGS.theString.theString[1] = ' ' do {skip leading blanks}
|
|
for i := 1 to partialFileGS.theString.size do
|
|
partialFileGS.theString.theString[i] :=
|
|
partialFileGS.theString.theString[i+1];
|
|
InPartialList := true; {assume success}
|
|
i := 1; {scan the name list}
|
|
len := length(fName^);
|
|
while partialFileGS.theString.theString[i] <> chr(0) do begin
|
|
for j := 1 to len do begin
|
|
if partialFileGS.theString.theString[i+j-1] <> fName^[j] then
|
|
goto 1;
|
|
end; {for}
|
|
if partialFileGS.theString.theString[i+len] in [' ', chr(0)] then begin
|
|
|
|
{found a match - remove from list & return}
|
|
j := i+len;
|
|
while partialFileGS.theString.theString[j] = ' ' do
|
|
j := j+1;
|
|
repeat
|
|
ch := partialFileGS.theString.theString[j];
|
|
partialFileGS.theString.theString[i] := ch;
|
|
i := i+1;
|
|
j := j+1;
|
|
until ch = chr(0);
|
|
goto 2;
|
|
end; {if}
|
|
1: {no match - skip to next name}
|
|
while not (partialFileGS.theString.theString[i] in [chr(0), ' ']) do
|
|
i := i+1;
|
|
while partialFileGS.theString.theString[i] = ' ' do
|
|
i := i+1;
|
|
end; {while}
|
|
InPartialList := false; {no match found}
|
|
2:
|
|
end; {InPartialList}
|
|
|
|
|
|
procedure SkipFunction (isAsm: boolean);
|
|
|
|
{ Skip a function body for a partial compile }
|
|
{ }
|
|
{ Parameters: }
|
|
{ isAsm - are we compiling an asm function? }
|
|
|
|
var
|
|
braceCount: integer; {# of unmatched { chars}
|
|
doingAsm: boolean; {compiling an asm statement?}
|
|
|
|
begin {SkipFunction}
|
|
Match(lbracech,27); {skip to the closing rbrackch}
|
|
braceCount := 1;
|
|
doingAsm := false;
|
|
if isAsm then
|
|
charKinds[ord('#')] := ch_pound;
|
|
while (not (token.kind = eofsy)) and (braceCount <> 0) do begin
|
|
if token.kind = asmsy then begin
|
|
doingAsm := true;
|
|
charKinds[ord('#')] := ch_pound;
|
|
end {if}
|
|
else if token.kind = lbracech then
|
|
braceCount := braceCount+1
|
|
else if token.kind = rbracech then begin
|
|
braceCount := braceCount-1;
|
|
if doingAsm then begin
|
|
doingAsm := false;
|
|
charKinds[ord('#')] := illegal;
|
|
end; {if}
|
|
end; {else if}
|
|
NextToken;
|
|
end; {while}
|
|
nameFound := false; {no pc_nam for the next function (yet)}
|
|
doingFunction := false; {no longer doing a function}
|
|
charKinds[ord('#')] := illegal; {# is a preprocessor command}
|
|
end; {SkipFunction}
|
|
|
|
|
|
begin {DoDeclaration}
|
|
if token.kind = _Static_assertsy then begin
|
|
DoStaticAssert;
|
|
goto 4;
|
|
end; {if}
|
|
lDoingParameters := doingParameters; {record the status}
|
|
noFDefinitions := false; {are function definitions inhibited?}
|
|
if doingPrototypes then {prototypes implies a parm list}
|
|
doingParameters := true
|
|
else
|
|
lastParameter := nil; {init parm list if we're not doing prototypes}
|
|
isFunction := false; {assume it's not a function}
|
|
startLine := lineNumber;
|
|
if not doingFunction then {handle any segment statements}
|
|
while token.kind = segmentsy do
|
|
SegmentStatement;
|
|
inhibitHeader := true; {block imbedded includes in headers}
|
|
lUseGlobalPool := useGlobalPool;
|
|
storageClass := ident;
|
|
{handle a TypeSpecifier/declarator}
|
|
typeFound := token.kind in declarationSpecifiersElement;
|
|
DeclarationSpecifiers(declarationSpecifiersElement, ident);
|
|
isPascal := pascalsy in declarationModifiers;
|
|
isAsm := asmsy in declarationModifiers;
|
|
isInline := inlinesy in declarationModifiers;
|
|
isNoreturn := _Noreturnsy in declarationModifiers;
|
|
alignmentSpecified := _Alignassy in declarationModifiers;
|
|
lisPascal := isPascal;
|
|
if not skipDeclarator then begin
|
|
variable := nil;
|
|
Declarator(typeSpec, variable, variableSpace, doingPrototypes);
|
|
if variable = nil then begin
|
|
inhibitHeader := false;
|
|
if token.kind = semicolonch then
|
|
NextToken
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
isPascal := lisPascal;
|
|
|
|
{make sure variables have some type info}
|
|
if isFunction then begin
|
|
if not typeFound then
|
|
if (lint & lintNoFnType) <> 0 then
|
|
if (lint & lintC99Syntax) = 0 then
|
|
Error(104);
|
|
end {if}
|
|
else
|
|
if not typeFound then
|
|
Error(26);
|
|
|
|
3:
|
|
{handle a function declaration}
|
|
if isFunction then begin
|
|
|
|
if doingParameters then {a function cannot be a parameter}
|
|
Error(28);
|
|
fnType := variable^.itype; {get the type of the function}
|
|
while (fnType <> nil) and (fnType^.kind <> functionType) do
|
|
case fnType^.kind of
|
|
arrayType : fnType := fnType^.aType;
|
|
pointerType: fnType := fnType^.pType;
|
|
definedType: fnType := fnType^.dType;
|
|
otherwise : fnType := nil;
|
|
end; {case}
|
|
if fnType = nil then begin
|
|
SkipStatement;
|
|
goto 1;
|
|
end; {if}
|
|
if isInline then
|
|
if storageClass <> staticsy then
|
|
Error(120);
|
|
if alignmentSpecified then
|
|
Error(142);
|
|
if isPascal then begin {reverse prototyped parameters}
|
|
p1 := fnType^.parameterList;
|
|
if p1 <> nil then begin
|
|
p2 := nil;
|
|
while p1 <> nil do begin
|
|
p3 := p1;
|
|
p1 := p1^.next;
|
|
p3^.next := p2;
|
|
p2 := p3;
|
|
end; {while}
|
|
fnType^.parameterList := p2;
|
|
end; {if}
|
|
end; {if}
|
|
|
|
{handle functions in the parameter list}
|
|
if doingPrototypes then
|
|
PopTable
|
|
|
|
{external or forward declaration}
|
|
else if token.kind in [commach,semicolonch,inlinesy] then begin
|
|
fnType^.isPascal := isPascal; {note if we have pascal parms}
|
|
if token.kind = inlinesy then {handle tool declarations}
|
|
with fnType^ do begin
|
|
NextToken;
|
|
Match(lparench,13);
|
|
if token.kind in
|
|
[intconst,uintconst,charconst,scharconst,ucharconst] then begin
|
|
toolNum := token.ival;
|
|
NextToken;
|
|
end {if}
|
|
else
|
|
Error(18);
|
|
Match(commach,86);
|
|
if token.kind in [longconst,ulongconst] then begin
|
|
dispatcher := token.lval;
|
|
NextToken;
|
|
end {if}
|
|
else if token.kind in
|
|
[intconst,uintconst,charconst,scharconst,ucharconst] then begin
|
|
dispatcher := token.ival;
|
|
NextToken;
|
|
end {if}
|
|
else
|
|
Error(18);
|
|
Match(rparench,12);
|
|
end; {with}
|
|
doingParameters := doingPrototypes; {not doing parms any more}
|
|
if token.kind = semicolonch then begin
|
|
inhibitHeader := false;
|
|
NextToken; {skip the trailing semicolon}
|
|
end {if}
|
|
else if (token.kind = commach) and (not doingPrototypes) then begin
|
|
PopTable; {pop the symbol table}
|
|
NextToken; {allow further declarations}
|
|
variable := nil;
|
|
isFunction := false;
|
|
Declarator (typeSpec, variable, variableSpace, doingPrototypes);
|
|
if variable = nil then begin
|
|
inhibitHeader := false;
|
|
if token.kind = semicolonch then
|
|
NextToken
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
goto 3;
|
|
end {else if}
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
PopTable; {pop the symbol table}
|
|
end {if}
|
|
|
|
{cannot imbed functions...}
|
|
else if doingFunction then begin
|
|
isPascal := false;
|
|
Error(28);
|
|
while token.kind <> eofsy do
|
|
NextToken;
|
|
end {if}
|
|
|
|
{local declaration}
|
|
else begin
|
|
if noFDefinitions then
|
|
Error(22);
|
|
ftype := fnType^.ftype; {record the type of the function}
|
|
while fType^.kind = definedType do
|
|
fType := fType^.dType;
|
|
fIsNoreturn := isNoreturn; {record if function is _Noreturn}
|
|
variable^.state := defined; {note that the function is defined}
|
|
pfunc := variable; {set the identifier for parm checks}
|
|
fnType^.isPascal := isPascal; {note if we have pascal parms}
|
|
doingFunction := true; {read the parameter list}
|
|
doingParameters := true;
|
|
{declare the parameters}
|
|
lp := lastParameter; {(save now; it's volatile)}
|
|
while not (token.kind in [lbracech,eofsy]) do
|
|
if token.kind in declarationSpecifiersElement then
|
|
DoDeclaration(false)
|
|
else begin
|
|
Error(27);
|
|
NextToken;
|
|
end; {else}
|
|
if numberOfParameters <> 0 then {default K&R parm type is int}
|
|
begin
|
|
tlp := lp;
|
|
while tlp <> nil do begin
|
|
if tlp^.itype = nil then begin
|
|
tlp^.itype := intPtr;
|
|
if (lint & lintC99Syntax) <> 0 then
|
|
if (lint & lintNotPrototyped) = 0 then
|
|
Error(147); {C99+ require K&R params to be declared}
|
|
end; {if}
|
|
tlp := tlp^.pnext;
|
|
end; {while}
|
|
end; {if}
|
|
tlp := lp; {make sure all parameters have an}
|
|
while tlp <> nil do begin { identifier and a complete type }
|
|
if tlp^.name^ = '?' then begin
|
|
Error(113);
|
|
tlp := nil;
|
|
end {if}
|
|
else begin
|
|
if tlp^.itype^.size = 0 then
|
|
if not (tlp^.itype^.kind in [arrayType,functionType]) then
|
|
Error(148);
|
|
tlp := tlp^.pnext;
|
|
end; {else}
|
|
end; {while}
|
|
doingParameters := false;
|
|
fName := variable^.name; {skip if this is not needed for a }
|
|
if doingPartial then { partial compile }
|
|
if not InPartialList(fName) then begin
|
|
SkipFunction(isAsm);
|
|
goto 2;
|
|
end; {if}
|
|
TermHeader; {make sure the header file is closed}
|
|
if progress then {write progress information}
|
|
writeln('Compiling ', fName^);
|
|
useGlobalPool := false; {start a local label pool}
|
|
if not codegenStarted and (liDCBGS.kFlag <> 0) then begin {init the code generator (if it needs it)}
|
|
CodeGenInit (outFileGS, liDCBGS.kFlag, doingPartial);
|
|
liDCBGS.kFlag := 3;
|
|
codegenStarted := true;
|
|
end; {if}
|
|
foundFunction := true; {got one...}
|
|
segType := ord(variable^.class = staticsy) * $4000;
|
|
if fnType^.isPascal then begin
|
|
fName := pointer(Malloc(length(variable^.name^)+1));
|
|
CopyString(pointer(fName), pointer(variable^.name));
|
|
for i := 1 to length(fName^) do
|
|
if fName^[i] in ['a'..'z'] then
|
|
fName^[i] := chr(ord(fName^[i]) & $5F);
|
|
Gen2Name (dc_str, segType, 0, fName);
|
|
end {if}
|
|
else
|
|
Gen2Name (dc_str, segType, 0, variable^.name);
|
|
doingMain := variable^.name^ = 'main';
|
|
hasVarargsCall := false;
|
|
firstCompoundStatement := true;
|
|
Gen0 (dc_pin);
|
|
if not isAsm then
|
|
Gen1Name(pc_ent, 0, variable^.name);
|
|
functionName := variable^.name;
|
|
nextLocalLabel := 1; {initialize GetLocalLabel}
|
|
returnLabel := GenLabel; {set up an exit point}
|
|
tempList := nil; {initialize the work label list}
|
|
if not isAsm then {generate traceback, profile code}
|
|
if traceBack or profileFlag then begin
|
|
if traceBack then
|
|
nameFound := true;
|
|
GenPS(pc_nam, variable^.name);
|
|
end; {if}
|
|
nextPdisp := 0; {assign displacements to the parameters}
|
|
if not fnType^.isPascal then begin
|
|
tlp := lp;
|
|
lp := nil;
|
|
while tlp <> nil do begin
|
|
tlp2 := tlp;
|
|
tlp := tlp^.pnext;
|
|
tlp2^.pnext := lp;
|
|
lp := tlp2;
|
|
end; {while}
|
|
end; {if}
|
|
while lp <> nil do begin
|
|
lp^.pdisp := nextPdisp;
|
|
if lp^.itype^.kind = arrayType then
|
|
nextPdisp := nextPdisp + cgPointerSize
|
|
else begin
|
|
if lp^.itype^.kind = scalarType then
|
|
if lp^.itype^.baseType in [cgReal,cgDouble,cgComp] then
|
|
{all floating-points are passed as extended}
|
|
lp^.itype := extendedPtr;
|
|
nextPdisp := nextPdisp + long(lp^.itype^.size).lsw;
|
|
if (long(lp^.itype^.size).lsw = 1)
|
|
and (lp^.itype^.kind = scalarType) then
|
|
nextPdisp := nextPdisp+1;
|
|
end; {else}
|
|
lp := lp^.pnext;
|
|
end; {while}
|
|
gotoList := nil; {initialize the label list}
|
|
{set up struct/union area}
|
|
if variable^.itype^.ftype^.kind in [structType,unionType] then begin
|
|
lp := NewSymbol(@'@struct', variable^.itype^.ftype, staticsy,
|
|
variablespace, declared);
|
|
tk.kind := ident;
|
|
tk.class := identifier;
|
|
tk.name := @'@struct';
|
|
tk.symbolPtr := nil;
|
|
lp := FindSymbol(tk, variableSpace, false, true);
|
|
Gen1Name(pc_lao, 0, lp^.name);
|
|
Gen2t(pc_str, 0, 0, cgULong);
|
|
end; {if}
|
|
fenvAccessInFunction := fenvAccess;
|
|
if isAsm then begin
|
|
AsmFunction(variable); {handle assembly language functions}
|
|
PopTable;
|
|
end {if}
|
|
else begin
|
|
{generate parameter labels}
|
|
if fnType^.overrideKR then
|
|
GenParameters(nil)
|
|
else
|
|
GenParameters(fnType^.parameterList);
|
|
savedVolatile := volatile;
|
|
functionTable := table;
|
|
CompoundStatement(false); {process the statements}
|
|
end; {else}
|
|
end; {else}
|
|
2: ;
|
|
end {if}
|
|
|
|
{handle a variable declaration}
|
|
else {if not isFunction then} begin
|
|
noFDefinitions := true;
|
|
if alignmentSpecified then
|
|
if storageClass in [typedefsy,registersy] then
|
|
Error(142);
|
|
if not SkipDeclarator then
|
|
repeat
|
|
if isPascal then begin
|
|
tp := variable^.itype;
|
|
while tp <> nil do
|
|
case tp^.kind of
|
|
scalarType,
|
|
enumType,
|
|
enumConst,
|
|
definedType,
|
|
structType,
|
|
unionType: begin tp := nil; Error(94); end;
|
|
arrayType: tp := tp^.atype;
|
|
pointerType: tp := tp^.pType;
|
|
functionType: begin tp^.isPascal := true; tp := nil; end;
|
|
end; {case}
|
|
end; {if}
|
|
if isInline then
|
|
Error(119);
|
|
if isNoreturn then
|
|
Error(141);
|
|
if token.kind = eqch then begin
|
|
if storageClass = typedefsy then
|
|
Error(52);
|
|
if doingPrototypes then
|
|
Error(88);
|
|
{allocate copy of incomplete array type,}
|
|
tp := variable^.itype; {so it can be completed by Initializer}
|
|
if (tp^.kind = arrayType) and (tp^.elements = 0) then begin
|
|
variable^.itype := pointer(Malloc(sizeof(typeRecord)));
|
|
variable^.itype^ := tp^;
|
|
variable^.itype^.saveDisp := 0;
|
|
end;
|
|
NextToken; {handle an initializer}
|
|
ltypeSpec := typeSpec;
|
|
Initializer(variable);
|
|
typeSpec := ltypeSpec;
|
|
end; {if}
|
|
{check to insure array sizes are specified}
|
|
if storageClass <> typedefsy then
|
|
CheckArray(variable,
|
|
(storageClass = externsy) or doingParameters or not doingFunction);
|
|
{allocate space}
|
|
if variable^.storage = stackFrame then begin
|
|
variable^.lln := GetLocalLabel;
|
|
Gen2(dc_loc, variable^.lln, long(variable^.itype^.size).lsw);
|
|
if variable^.state = initialized then
|
|
AutoInit(variable, startLine); {initialize auto variable}
|
|
end; {if}
|
|
if (token.kind = commach) and (not doingPrototypes) then begin
|
|
done := false; {allow multiple variables on one line}
|
|
NextToken;
|
|
variable := nil;
|
|
Declarator(typeSpec, variable, variableSpace, doingPrototypes);
|
|
if variable = nil then begin
|
|
if token.kind = semicolonch then
|
|
NextToken
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
goto 3;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
if doingPrototypes then begin
|
|
protoVariable := variable; {make the var available to Declarator}
|
|
if protoVariable = nil then
|
|
protoType := typeSpec
|
|
else
|
|
protoType := protoVariable^.iType;
|
|
end {if}
|
|
else begin
|
|
inhibitHeader := false;
|
|
if token.kind = semicolonch then {must end with a semicolon}
|
|
NextToken
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {else}
|
|
end; {else}
|
|
1:
|
|
doingParameters := lDoingParameters; {restore the status}
|
|
useGlobalPool := lUseGlobalPool;
|
|
inhibitHeader := false;
|
|
4:
|
|
end; {DoDeclaration}
|
|
|
|
|
|
procedure TypeName;
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ outputs: }
|
|
{ typeSpec - pointer to the type }
|
|
|
|
var
|
|
tl,tp: typePtr; {for creating/reversing the type list}
|
|
|
|
|
|
procedure AbstractDeclarator;
|
|
|
|
{ process an abstract declarator }
|
|
{ }
|
|
{ abstract-declarator: }
|
|
{ empty-abstract-declarator }
|
|
{ nonempty-abstract-declarator }
|
|
|
|
|
|
procedure NonEmptyAbstractDeclarator;
|
|
|
|
{ process a nonempty abstract declarator }
|
|
{ }
|
|
{ nonempty-abstract-declarator: }
|
|
{ ( nonempty-abstract-declarator ) }
|
|
{ abstract-declarator ( ) }
|
|
{ abstract-declarator [ expression OPT ] }
|
|
{ * abstract-declarator }
|
|
|
|
var
|
|
pcount: integer; {paren counter}
|
|
tp: typePtr; {work pointer}
|
|
|
|
begin {NonEmptyAbstractDeclarator}
|
|
if token.kind = lparench then begin
|
|
NextToken;
|
|
if token.kind = rparench then begin
|
|
|
|
{create a function type}
|
|
tp := pointer(Calloc(sizeof(typeRecord)));
|
|
{tp^.size := 0;}
|
|
{tp^.saveDisp := 0;}
|
|
{tp^.isConstant := false;}
|
|
tp^.kind := functionType;
|
|
{tp^.varargs := false;}
|
|
{tp^.prototyped := false;}
|
|
{tp^.overrideKR := false;}
|
|
{tp^.parameterList := nil;}
|
|
{tp^.isPascal := false;}
|
|
{tp^.toolNum := 0;}
|
|
{tp^.dispatcher := 0;}
|
|
tp^.fType := tl;
|
|
tl := tp;
|
|
NextToken;
|
|
end {if}
|
|
else begin
|
|
|
|
{handle a parenthesized type}
|
|
if not (token.kind in [lparench,asteriskch,lbrackch]) then
|
|
begin
|
|
Error(82);
|
|
while not (token.kind in
|
|
[eofsy,lparench,asteriskch,lbrackch,rparench]) do
|
|
NextToken;
|
|
end; {if}
|
|
if token.kind in [lparench,asteriskch,lbrackch] then
|
|
NonEmptyAbstractDeclarator;
|
|
Match(rparench,12);
|
|
end; {else}
|
|
end {if token.kind = lparench}
|
|
else if token.kind = asteriskch then begin
|
|
|
|
{create a pointer type}
|
|
NextToken;
|
|
tp := pointer(Malloc(sizeof(typeRecord)));
|
|
tp^.size := cgLongSize;
|
|
tp^.saveDisp := 0;
|
|
tp^.isConstant := false;
|
|
tp^.kind := pointerType;
|
|
while token.kind in [constsy,volatilesy] do begin
|
|
if token.kind = constsy then
|
|
tp^.isConstant := true
|
|
else {if token.kind = volatilesy then}
|
|
volatile := true;
|
|
NextToken;
|
|
end; {while}
|
|
AbstractDeclarator;
|
|
tp^.fType := tl;
|
|
tl := tp;
|
|
end {else if token.kind = asteriskch}
|
|
else {if token.kind = lbrackch then} begin
|
|
|
|
{create an array type}
|
|
NextToken;
|
|
if token.kind = rbrackch then
|
|
expressionValue := 0
|
|
else begin
|
|
Expression(arrayExpression, [rbrackch]);
|
|
if expressionValue <= 0 then begin
|
|
Error(45);
|
|
expressionValue := 1;
|
|
end; {if}
|
|
end; {else}
|
|
tp := pointer(Malloc(sizeof(typeRecord)));
|
|
tp^.saveDisp := 0;
|
|
tp^.kind := arrayType;
|
|
tp^.elements := expressionValue;
|
|
tp^.fType := tl;
|
|
tl := tp;
|
|
Match(rbrackch,24);
|
|
end; {else}
|
|
|
|
if token.kind = lparench then begin
|
|
{create a function type}
|
|
NextToken;
|
|
pcount := 1;
|
|
while (token.kind <> eofsy) and (pcount <> 0) do begin
|
|
if token.kind = rparench then
|
|
pcount := pcount-1
|
|
else if token.kind = lparench then
|
|
pcount := pcount+1;
|
|
NextToken;
|
|
end; {while}
|
|
tp := pointer(Calloc(sizeof(typeRecord)));
|
|
{tp^.size := 0;}
|
|
{tp.saveDisp := 0;}
|
|
{tp^.isConstant := false;}
|
|
tp^.kind := functionType;
|
|
{tp^.varargs := false;}
|
|
{tp^.prototyped := false;}
|
|
{tp^.overrideKR := false;}
|
|
{tp^.parameterList := nil;}
|
|
{tp^.isPascal := false;}
|
|
{tp^.toolNum := 0;}
|
|
{tp^.dispatcher := 0;}
|
|
tp^.fType := tl;
|
|
tl := tp;
|
|
end; {if}
|
|
end; {NonEmptyAbstractDeclarator}
|
|
|
|
|
|
begin {AbstractDeclarator}
|
|
while token.kind in [lparench,asteriskch,lbrackch] do
|
|
NonEmptyAbstractDeclarator;
|
|
end; {AbstractDeclarator}
|
|
|
|
|
|
begin {TypeName}
|
|
{read and process the type specifier}
|
|
DeclarationSpecifiers(specifierQualifierListElement, rparench);
|
|
|
|
{_Alignas is not allowed in most uses of type names. }
|
|
{It would be allowed in compound literals, if we supported them.}
|
|
if _Alignassy in declarationModifiers then
|
|
Error(142);
|
|
|
|
{handle the abstract-declarator part}
|
|
tl := nil; {no types so far}
|
|
AbstractDeclarator; {create the type list}
|
|
while tl <> nil do begin {reverse the list & compute array sizes}
|
|
tp := tl^.aType; {NOTE: assumes aType, pType and fType overlap in typeRecord}
|
|
tl^.aType := typeSpec;
|
|
if tl^.kind = arrayType then
|
|
tl^.size := tl^.elements * typeSpec^.size;
|
|
typeSpec := tl;
|
|
tl := tp;
|
|
end; {while}
|
|
end; {TypeName}
|
|
|
|
|
|
procedure DoStatement;
|
|
|
|
{ process a statement from a function }
|
|
|
|
var
|
|
lToken: tokenType; {temporary copy of old token}
|
|
nToken: tokenType; {new token}
|
|
hasStatementNext: boolean; {is a stmt next within a compound stmt?}
|
|
lPrintMacroExpansions: boolean; {local copy of printMacroExpansions}
|
|
|
|
begin {DoStatement}
|
|
case statementList^.kind of
|
|
|
|
compoundSt: begin
|
|
hasStatementNext := true;
|
|
if token.kind = rbracech then begin
|
|
hasStatementNext := false;
|
|
EndCompoundStatement;
|
|
end {if}
|
|
else if (statementList^.doingDeclaration or allowMixedDeclarations)
|
|
and (token.kind in localDeclarationStart)
|
|
then begin
|
|
hasStatementNext := false;
|
|
if token.kind <> typedef then
|
|
DoDeclaration(false)
|
|
else begin
|
|
lToken := token;
|
|
lPrintMacroExpansions := printMacroExpansions; {inhibit token echo}
|
|
printMacroExpansions := false;
|
|
NextToken;
|
|
printMacroExpansions := lPrintMacroExpansions;
|
|
nToken := token;
|
|
PutBackToken(nToken, false);
|
|
token := lToken;
|
|
if nToken.kind <> colonch then
|
|
DoDeclaration(false)
|
|
else
|
|
hasStatementNext := true;
|
|
end {else}
|
|
end; {else if}
|
|
|
|
if hasStatementNext then begin
|
|
if statementList^.doingDeclaration then begin
|
|
statementList^.doingDeclaration := false;
|
|
if firstCompoundStatement then begin
|
|
Gen1Name(dc_sym, ord(doingMain), pointer(table));
|
|
firstCompoundStatement := false;
|
|
end; {if}
|
|
end; {if}
|
|
Statement;
|
|
end; {else}
|
|
end;
|
|
|
|
ifSt:
|
|
EndIfStatement;
|
|
|
|
elseSt:
|
|
EndElseStatement;
|
|
|
|
doSt:
|
|
EndDoStatement;
|
|
|
|
whileSt:
|
|
EndWhileStatement;
|
|
|
|
forSt:
|
|
EndForStatement;
|
|
|
|
switchSt:
|
|
EndSwitchStatement;
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end; {DoStatement}
|
|
|
|
|
|
procedure AutoInit {variable: identPtr, line: integer};
|
|
|
|
{ generate code to initialize an auto variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - the variable to initialize }
|
|
{ line - line number (used for debugging) }
|
|
|
|
var
|
|
count: integer; {initializer counter}
|
|
iPtr: initializerPtr; {pointer to the next initializer}
|
|
|
|
|
|
procedure Initialize (id: identPtr; disp: longint; itype: typePtr);
|
|
|
|
{ initialize a variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ id - pointer to the identifier }
|
|
{ disp - disp past the identifier to initialize }
|
|
{ itype - type of the variable to initialize }
|
|
{ }
|
|
{ variables: }
|
|
{ count - number of times to re-use the initializer }
|
|
{ ip - pointer to the initializer record to use }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
elements: longint; {# array elements}
|
|
fp: identPtr; {for tracing field lists}
|
|
size: integer; {fill size}
|
|
union: boolean; {are we doing a union?}
|
|
startDisp,endDisp: longint; {disp at start/end of struct/union}
|
|
|
|
{bit field manipulation}
|
|
{----------------------}
|
|
bitcount: integer; {# if bits so far}
|
|
bitsize,bitdisp: integer; {defines size, location of a bit field}
|
|
|
|
{assignment conversion}
|
|
{---------------------}
|
|
tree: tokenPtr; {expression tree}
|
|
val: longint; {constant expression value}
|
|
isConstant: boolean; {is the expression a constant?}
|
|
|
|
|
|
procedure LoadAddress;
|
|
|
|
{ Load the address of the operand }
|
|
|
|
begin {LoadAddress}
|
|
with id^ do {load the base address}
|
|
case storage of
|
|
stackFrame: Gen2(pc_lda, lln, 0);
|
|
parameter: if itype^.kind = arrayType then
|
|
Gen2t(pc_lod, pln, 0, cgULong)
|
|
else
|
|
Gen2(pc_lda, pln, 0);
|
|
external,
|
|
global,
|
|
private: Gen1Name(pc_lao, 0, name);
|
|
otherwise: ;
|
|
end; {case}
|
|
if disp <> 0 then
|
|
Gen1t(pc_inc, long(disp).lsw, cgULong)
|
|
end; {LoadAddress}
|
|
|
|
|
|
function ZeroFill (elements: longint; itype: typePtr;
|
|
count: integer; iPtr: initializerPtr): boolean;
|
|
|
|
{ See if an array can be zero filled }
|
|
{ }
|
|
{ parameters: }
|
|
{ elements - elements in the array }
|
|
{ itype - type of each array element }
|
|
{ count - remaining initializer repetitions }
|
|
{ iPtr - initializer record }
|
|
|
|
begin {ZeroFill}
|
|
ZeroFill := false;
|
|
if not iPtr^.isConstant then
|
|
if itype^.kind in [scalarType,enumType] then
|
|
if count >= elements then
|
|
with iPtr^.itree^ do
|
|
if token.kind = intconst then
|
|
if token.ival = 0 then
|
|
{don't call ~ZERO for very small arrays}
|
|
if elements * itype^.size > 10 then
|
|
ZeroFill := true;
|
|
end; {ZeroFill}
|
|
|
|
|
|
begin {Initialize}
|
|
while itype^.kind = definedType do
|
|
itype := itype^.dType;
|
|
case itype^.kind of
|
|
|
|
scalarType,pointerType,enumType,functionType: begin
|
|
tree := iptr^.itree;
|
|
if tree = nil then goto 2; {don't generate code in error case}
|
|
LoadAddress; {load the destination address}
|
|
doDispose := count = 1; {generate the expression value}
|
|
{see if this is a constant}
|
|
{do assignment conversions}
|
|
while tree^.token.kind = castoper do
|
|
tree := tree^.left;
|
|
isConstant :=
|
|
tree^.token.class in [intConstant,longConstant,longlongConstant];
|
|
if isConstant then
|
|
if tree^.token.class = intConstant then
|
|
val := tree^.token.ival
|
|
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
|
|
Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; ival = ', tree^.token.ival:1) {debug}
|
|
{ else
|
|
Writeln('loc 2: bitsize = ', iPtr^.bitsize:1, '; lval = ', tree^.token.lval:1) {debug}
|
|
{ else
|
|
Writeln('loc 2: bitsize = ', iPtr^.bitsize:1); {debug}
|
|
|
|
GenerateCode(iptr^.iTree);
|
|
AssignmentConversion(itype, expressionType, isConstant, val, true,
|
|
false);
|
|
case itype^.kind of {save the value}
|
|
scalarType:
|
|
if iptr^.bitsize <> 0 then
|
|
Gen2t(pc_sbf, iptr^.bitdisp, iptr^.bitsize, itype^.basetype)
|
|
else
|
|
Gen0t(pc_sto, itype^.baseType);
|
|
enumType:
|
|
Gen0t(pc_sto, cgWord);
|
|
pointerType,functionType:
|
|
Gen0t(pc_sto, cgULong);
|
|
end; {case}
|
|
2: end;
|
|
|
|
arrayType: begin
|
|
elements := itype^.elements;
|
|
if elements = 0 then goto 1; {don't init flexible array member}
|
|
if itype^.aType^.kind = scalarType then
|
|
if itype^.aType^.baseType in [cgByte,cgUByte] then
|
|
if iPtr^.iTree^.token.kind = stringConst then begin
|
|
GenLdcLong(itype^.elements);
|
|
Gen0t(pc_stk, cgULong);
|
|
GenS(pc_lca, iPtr^.iTree^.token.sval);
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen0t(pc_bno, cgULong);
|
|
LoadAddress;
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen0t(pc_bno, cgULong);
|
|
Gen1tName(pc_cup, 0, cgVoid, @'strncpy');
|
|
iPtr := iPtr^.next;
|
|
goto 1;
|
|
end; {if}
|
|
itype := itype^.atype;
|
|
if ZeroFill(elements, itype, count, iPtr) then begin
|
|
if itype^.kind = enumType then
|
|
size := cgWordSize
|
|
else
|
|
size := TypeSize(itype^.baseType);
|
|
size := size * long(elements).lsw;
|
|
LoadAddress;
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen1t(pc_ldc, size, cgWord);
|
|
Gen0t(pc_stk, cgWord);
|
|
Gen0t(pc_bno, cgULong);
|
|
Gen1tName(pc_cup, 0, cgVoid, @'~ZERO');
|
|
disp := disp + size;
|
|
count := count - long(elements).lsw;
|
|
if count = 0 then begin
|
|
iPtr := iPtr^.next;
|
|
if iPtr <> nil then
|
|
count := iPtr^.count;
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
while elements <> 0 do begin
|
|
Initialize(id, disp, itype);
|
|
if itype^.kind in [scalarType,pointerType,enumType] then begin
|
|
count := count-1;
|
|
if count = 0 then begin
|
|
iPtr := iPtr^.next;
|
|
if iPtr <> nil then
|
|
count := iPtr^.count;
|
|
end; {if}
|
|
end; {if}
|
|
disp := disp+itype^.size;
|
|
elements := elements-1;
|
|
end; {while}
|
|
end; {else}
|
|
1: end;
|
|
|
|
structType,unionType: begin
|
|
startDisp := disp;
|
|
endDisp := disp + itype^.size;
|
|
if iPtr^.isStructOrUnion then begin
|
|
LoadAddress; {load the destination address}
|
|
GenerateCode(iptr^.iTree); {load the struct address}
|
|
{do the assignment}
|
|
AssignmentConversion(itype, expressionType, isConstant, val,
|
|
true, false);
|
|
with expressionType^ do
|
|
Gen2(pc_mov, long(size).msw, long(size).lsw);
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
end {if}
|
|
else begin
|
|
union := itype^.kind = unionType;
|
|
fp := itype^.fieldList;
|
|
while fp <> nil do begin
|
|
itype := fp^.itype;
|
|
disp := startDisp + fp^.disp;
|
|
bitdisp := fp^.bitdisp;
|
|
bitsize := fp^.bitsize;
|
|
{ writeln('Initialize: disp = ', disp:3, '; fp^. Disp = ', fp^.disp:3, 'itype^.size = ', itype^.size:1); {debug}
|
|
{ writeln(' bitDisp = ', bitDisp:3, '; fp^.bitDisp = ', fp^.bitDisp:3); {debug}
|
|
{ writeln(' bitSize = ', bitSize:3, '; fp^.bitSize = ', fp^.bitSize:3); {debug}
|
|
Initialize(id, disp, itype);
|
|
if bitsize = 0 then begin
|
|
if bitcount <> 0 then begin
|
|
bitcount := 0;
|
|
end {if}
|
|
else if fp^.bitSize <> 0 then begin
|
|
bitcount := 8;
|
|
while (fp <> nil) and (bitcount > 0) do begin
|
|
bitcount := bitcount - fp^.bitSize;
|
|
if bitcount > 0 then
|
|
if fp^.next <> nil then
|
|
if fp^.next^.bitSize <> 0 then
|
|
fp := fp^.next
|
|
else
|
|
bitcount := 0;
|
|
end; {while}
|
|
bitcount := 0;
|
|
end; {else if}
|
|
end {if}
|
|
else if fp^.bitSize = 0 then begin
|
|
bitsize := 0;
|
|
end {else if}
|
|
else begin
|
|
bitcount := bitsize + bitdisp;
|
|
end; {else}
|
|
if itype^.kind in [scalarType,pointerType,enumType] then begin
|
|
count := count-1;
|
|
if count = 0 then begin
|
|
iPtr := iPtr^.next;
|
|
if iPtr <> nil then begin
|
|
count := iPtr^.count;
|
|
bitsize := iPtr^.bitsize;
|
|
bitdisp := iPtr^.bitdisp;
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
if union then
|
|
fp := nil
|
|
else
|
|
fp := fp^.next;
|
|
end; {while}
|
|
end; {else}
|
|
disp := endDisp;
|
|
end;
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end; {Initialize}
|
|
|
|
|
|
begin {AutoInit}
|
|
iPtr := variable^.iPtr;
|
|
count := iPtr^.count;
|
|
if variable^.class <> staticsy then begin
|
|
if traceBack or debugFlag then
|
|
if nameFound or debugFlag then
|
|
if (statementList <> nil) and not statementList^.doingDeclaration then
|
|
if lastLine <> line then begin
|
|
lastLine := line;
|
|
Gen2(pc_lnm, line, ord(debugType));
|
|
end; {if}
|
|
Initialize(variable, 0, variable^.itype);
|
|
end; {if}
|
|
end; {AutoInit}
|
|
|
|
|
|
function MakeFuncIdentifier{: identPtr};
|
|
|
|
{ Make the predefined identifier __func__. }
|
|
{ }
|
|
{ It is inserted in the symbol table as if the following }
|
|
{ declaration appeared at the beginning of the function body: }
|
|
{ }
|
|
{ static const char __func__[] = "function-name"; }
|
|
{ }
|
|
{ This must only be called within a function body. }
|
|
|
|
var
|
|
lTable: symbolTablePtr; {saved copy of current symbol table}
|
|
tp: typePtr; {the type of __func__}
|
|
id: identPtr; {the identifier for __func__}
|
|
sval: longstringPtr; {the initializer string}
|
|
iPtr: initializerPtr; {the initializer}
|
|
i: integer; {loop variable}
|
|
len: integer; {string length}
|
|
|
|
begin {MakeFuncIdentifier}
|
|
lTable := table;
|
|
table := functionTable;
|
|
|
|
len := ord(functionName^[0]) + 1;
|
|
tp := pointer(GCalloc(sizeof(typeRecord)));
|
|
tp^.size := len;
|
|
tp^.saveDisp := 0;
|
|
tp^.isConstant := false;
|
|
tp^.kind := arrayType;
|
|
tp^.aType := constCharPtr;
|
|
tp^.elements := len;
|
|
id := NewSymbol(@'__func__', tp, staticsy, variableSpace, initialized);
|
|
|
|
sval := pointer(GCalloc(len + sizeof(integer)));
|
|
sval^.length := len;
|
|
for i := 1 to len-1 do
|
|
sval^.str[i] := functionName^[i];
|
|
sval^.str[len] := chr(0);
|
|
iPtr := pointer(GCalloc(sizeof(initializerRecord)));
|
|
iPtr^.next := nil;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
iPtr^.isConstant := true;
|
|
iPtr^.itype := cgString;
|
|
iPtr^.sval := sval;
|
|
id^.iPtr := iPtr;
|
|
|
|
table := lTable;
|
|
MakeFuncIdentifier := id;
|
|
end; {MakeFuncIdentifier}
|
|
|
|
|
|
procedure InitParser;
|
|
|
|
{ Initialize the parser }
|
|
|
|
var
|
|
typeSpecifierStart: tokenSet;
|
|
storageClassSpecifiers: tokenSet;
|
|
typeQualifiers: tokenSet;
|
|
functionSpecifiers: tokenSet;
|
|
alignmentSpecifiers: tokenSet;
|
|
|
|
begin {InitParser}
|
|
doingFunction := false; {not doing a function (yet)}
|
|
doingParameters := false; {not processing parameters}
|
|
lastLine := 0; {no pc_lnm generated yet}
|
|
nameFound := false; {no pc_nam generated yet}
|
|
statementList := nil; {no open statements}
|
|
codegenStarted := false; {code generator is not started}
|
|
doingForLoopClause1 := false; {not doing a for loop}
|
|
fIsNoreturn := false; {not doing a noreturn function}
|
|
|
|
{init syntactic classes of tokens}
|
|
{See C17 section 6.7 ff.}
|
|
typeSpecifierStart :=
|
|
[voidsy,charsy,shortsy,intsy,longsy,floatsy,doublesy,signedsy,unsignedsy,
|
|
extendedsy,compsy,_Boolsy,_Complexsy,_Imaginarysy,_Atomicsy,
|
|
structsy,unionsy,enumsy,typedef];
|
|
|
|
storageClassSpecifiers :=
|
|
[typedefsy,externsy,staticsy,_Thread_localsy,autosy,registersy];
|
|
|
|
typeQualifiers :=
|
|
[constsy,volatilesy,restrictsy,_Atomicsy];
|
|
|
|
functionSpecifiers := [inlinesy,_Noreturnsy,pascalsy,asmsy];
|
|
|
|
alignmentSpecifiers := [_Alignassy];
|
|
|
|
declarationSpecifiersElement := typeSpecifierStart + storageClassSpecifiers
|
|
+ typeQualifiers + functionSpecifiers + alignmentSpecifiers;
|
|
|
|
specifierQualifierListElement :=
|
|
typeSpecifierStart + typeQualifiers + alignmentSpecifiers;
|
|
|
|
structDeclarationStart := specifierQualifierListElement + [_Static_assertsy];
|
|
|
|
topLevelDeclarationStart :=
|
|
declarationSpecifiersElement + [ident,segmentsy,_Static_assertsy];
|
|
|
|
localDeclarationStart :=
|
|
declarationSpecifiersElement + [_Static_assertsy] - [asmsy];
|
|
end; {InitParser}
|
|
|
|
|
|
procedure TermParser;
|
|
|
|
{ shut down the parser }
|
|
|
|
begin {TermParser}
|
|
if statementList <> nil then
|
|
case statementList^.kind of
|
|
compoundSt : Error(34);
|
|
doSt : Error(33);
|
|
elseSt : Error(67);
|
|
forSt : Error(69);
|
|
ifSt : Error(32);
|
|
switchSt : Error(70);
|
|
whileSt : Error(68);
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end; {TermParser}
|
|
|
|
end.
|