mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-26 19:29:17 +00:00
20f9170343
This prohibits initializers in "extern" declarations within a function, and in the parameter declarations of non-prototyped functions.
Here are examples illustrating these cases:
int main(void) {
extern int i = 50;
}
void f(i)
int i = 60;
{
}
4847 lines
179 KiB
ObjectPascal
4847 lines
179 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 }
|
|
|
|
|
|
function TypeName: typePtr;
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ returns: a pointer to the type }
|
|
|
|
|
|
procedure AutoInit (variable: identPtr; line: longint;
|
|
isCompoundLiteral: boolean);
|
|
|
|
{ generate code to initialize an auto variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - the variable to initialize }
|
|
{ line - line number (used for debugging) }
|
|
{ isCompoundLiteral - initializing a compound literal? }
|
|
|
|
|
|
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. }
|
|
|
|
|
|
function MakeCompoundLiteral(tp: typePtr): identPtr;
|
|
|
|
{ Make the identifier for a compound literal. }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - the type of the compound literal }
|
|
|
|
|
|
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;
|
|
|
|
{type info for a declaration}
|
|
{---------------------------}
|
|
declSpecifiersRecord = record
|
|
storageClass: tokenEnum; {storage class of the declaration}
|
|
typeSpec: typePtr; {type specifier}
|
|
declarationModifiers: tokenSet; {all storage class specifiers, type }
|
|
{qualifiers, function specifiers, & }
|
|
{alignment specifiers in declaration}
|
|
end;
|
|
|
|
var
|
|
anonNumber: integer; {number for next anonymous struct/union}
|
|
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?}
|
|
returnLabel: integer; {label for exit point}
|
|
statementList: statementPtr; {list of open statements}
|
|
savedVolatile: boolean; {saved copy of volatile}
|
|
doingForLoopClause1: boolean; {doing the first clause of a for loop?}
|
|
compoundLiteralNumber: integer; {number of compound literal}
|
|
compoundLiteralToAllocate: identPtr; {compound literal that needs space allocated}
|
|
vaInfoLLN: integer; {label number of internal va info (0 for none)}
|
|
declaredTagOrEnumConst: boolean; {was a tag or enum const declared?}
|
|
returnCount: integer; {number of return statements}
|
|
skipReturn: boolean; {skip the ordinary return at end of function?}
|
|
structReturnVar: identPtr; {static variable to hold a struct/union return value}
|
|
|
|
{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}
|
|
|
|
{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;
|
|
|
|
{-- External conversion functions; imported from CGC.pas -------}
|
|
|
|
procedure CnvXLL (var result: longlong; val: extended); extern;
|
|
|
|
procedure CnvXULL (var result: longlong; val: extended); extern;
|
|
|
|
function CnvLLX (val: longlong): extended; extern;
|
|
|
|
function CnvULLX (val: longlong): extended; 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}
|
|
while compoundLiteralToAllocate <> nil do begin {allocate compound literals}
|
|
Gen2(dc_loc, compoundLiteralToAllocate^.lln,
|
|
long(compoundLiteralToAllocate^.itype^.size).lsw);
|
|
compoundLiteralToAllocate := compoundLiteralToAllocate^.clnext;
|
|
end {while};
|
|
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 not skipReturn then begin
|
|
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);
|
|
if vaInfoLLN <> 0 then begin {clean up variable args, if any}
|
|
Gen2(pc_lda, vaInfoLLN, 0);
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen1tName(pc_cup, -1, cgVoid, @'__va_end');
|
|
end; {if}
|
|
with fType^ do {generate the pc_ret instruction}
|
|
case kind of
|
|
scalarType : Gen0t(pc_ret, baseType);
|
|
arrayType : ;
|
|
structType ,
|
|
unionType : begin
|
|
Gen1Name(pc_lao, 0, structReturnVar^.name);
|
|
Gen0t(pc_rev, cgULong);
|
|
end;
|
|
pointerType : Gen0t(pc_ret, cgULong);
|
|
functionType: ;
|
|
enumConst : ;
|
|
enumType : Gen0t(pc_ret, cgWord);
|
|
definedType : ;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end; {if}
|
|
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 RecordLineNumber (lineNumber: longint);
|
|
|
|
{ generate debug code to record the line number as specified }
|
|
|
|
var
|
|
newSourceFileGS: gsosOutStringPtr;
|
|
|
|
begin {RecordLineNumber}
|
|
if (lastLine <> lineNumber) or changedSourceFile then begin
|
|
lastLine := lineNumber;
|
|
if changedSourceFile then begin
|
|
newSourceFileGS := pointer(Malloc(sizeof(gsosOutString)));
|
|
newSourceFileGS^ := sourceFileGS;
|
|
Gen2Name(pc_lnm, ord(lineNumber), ord(debugType), pointer(newSourceFileGS));
|
|
changedSourceFile := false;
|
|
end {if}
|
|
else
|
|
Gen2Name(pc_lnm, ord(lineNumber), ord(debugType), nil);
|
|
end; {if}
|
|
end; {RecordLineNumber}
|
|
|
|
|
|
procedure Statement;
|
|
|
|
{ handle a statement }
|
|
|
|
label 1;
|
|
|
|
var
|
|
lToken,tToken: tokenType; {for look-ahead}
|
|
lSuppressMacroExpansions: boolean; {local copy of suppressMacroExpansions}
|
|
|
|
|
|
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}
|
|
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}
|
|
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
|
|
size: longint; {size of the struct/union}
|
|
|
|
|
|
procedure ReturnValue (tp: baseTypeEnum);
|
|
|
|
{ generate code to return a value of specified type }
|
|
|
|
begin {ReturnValue}
|
|
if (returnCount = 0)
|
|
and (token.kind = rbracech)
|
|
and (statementList^.next = nil)
|
|
and (vaInfoLLN = 0)
|
|
and (tp in [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])
|
|
then begin
|
|
Gen0t(pc_rev, tp);
|
|
skipReturn := true;
|
|
end {if}
|
|
else
|
|
Gen2t(pc_str, 0, 0, tp);
|
|
end; {ReturnValue}
|
|
|
|
|
|
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
|
|
Gen1Name(pc_lao, 0, structReturnVar^.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);
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
case fType^.kind of
|
|
scalarType: if fType^.baseType in [cgQuad,cgUQuad] then
|
|
Gen0t(pc_sto, fType^.baseType)
|
|
else
|
|
ReturnValue(fType^.baseType);
|
|
enumType: ReturnValue(cgWord);
|
|
pointerType: ReturnValue(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);
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
end; {else}
|
|
if not skipReturn then
|
|
Gen1(pc_ujp, returnLabel); {branch to the exit point}
|
|
returnCount := returnCount + 1;
|
|
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
|
|
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
|
|
RecordLineNumber(lineNumber);
|
|
|
|
{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
|
|
lSuppressMacroExpansions := suppressMacroExpansions;
|
|
suppressMacroExpansions := true;
|
|
lToken := token;
|
|
NextToken;
|
|
tToken := token;
|
|
PutBackToken(token, true, false);
|
|
token := lToken;
|
|
suppressMacroExpansions := lSuppressMacroExpansions;
|
|
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
|
|
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}
|
|
lSuppressMacroExpansions: boolean; {local copy of suppressMacroExpansions}
|
|
|
|
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, false);
|
|
ltoken.kind := semicolonch;
|
|
ltoken.class := reservedSymbol;
|
|
PutBackToken(ltoken, false, false);
|
|
while tl <> nil do begin
|
|
PutBackToken(tl^.token, false, false);
|
|
tk := tl;
|
|
tl := tl^.next;
|
|
dispose(tk);
|
|
end; {while}
|
|
lSuppressMacroExpansions := suppressMacroExpansions; {inhibit token echo}
|
|
suppressMacroExpansions := true;
|
|
NextToken; {evaluate the expression}
|
|
Expression(normalExpression, [semicolonch]);
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
NextToken; {skip the semicolon}
|
|
suppressMacroExpansions := lSuppressMacroExpansions;
|
|
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(declSpecifiers: declSpecifiersRecord;
|
|
var variable: identPtr; space: spaceType; doingPrototypes: boolean);
|
|
|
|
{ handle a declarator }
|
|
{ }
|
|
{ parameters: }
|
|
{ declSpecifiers - type/specifiers 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;
|
|
qualifiers: typeQualifierSet;
|
|
end;
|
|
|
|
var
|
|
i: integer; {loop variable}
|
|
lastWasIdentifier: boolean; {for deciding if the declarator is a function}
|
|
lastWasPointer: boolean; {was the last type a pointer?}
|
|
madeFunctionTable: boolean; {made symbol table for function type?}
|
|
newName: stringPtr; {new symbol name}
|
|
parameterStorage: boolean; {is the new symbol in a parm list?}
|
|
state: stateKind; {declaration state of the variable}
|
|
tPtr: typePtr; {type of declaration}
|
|
tPtr2: typePtr; {work pointer}
|
|
tsPtr: typeDefPtr; {work pointer}
|
|
typeStack: typeDefPtr; {stack of type definitions}
|
|
lTable: symbolTablePtr; {saved copy of table}
|
|
|
|
{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;
|
|
|
|
{ stack the declaration operators }
|
|
|
|
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}
|
|
gotStatic: boolean; {got 'static' in array declarator?}
|
|
|
|
{variables used to preserve states}
|
|
{ across recursive calls }
|
|
{---------------------------------}
|
|
lisFunction: boolean; {local copy of isFunction}
|
|
lLastParameter: identPtr; {next parameter to process}
|
|
lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions}
|
|
ldeclaredTagOrEnumConst: boolean; {local copy of declaredTagOrEnumConst}
|
|
|
|
begin {StackDeclarations}
|
|
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 declSpecifiers.storageClass = typedefsy then begin
|
|
tPtr2 := pointer(Calloc(sizeof(typeRecord)));
|
|
{tPtr2^.size := 0;}
|
|
{tPtr2^.saveDisp := 0;}
|
|
tPtr2^.kind := definedType;
|
|
{tPtr2^.qualifiers := [];}
|
|
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^.qualifiers := [];
|
|
while token.kind in [_Alignassy..whilesy] do begin
|
|
if token.kind = constsy then
|
|
cpList^.qualifiers := cpList^.qualifiers + [tqConst]
|
|
else if token.kind = volatilesy then begin
|
|
cpList^.qualifiers := cpList^.qualifiers + [tqVolatile];
|
|
volatile := true
|
|
end {else if}
|
|
else if token.kind = restrictsy then {always allowed for now}
|
|
cpList^.qualifiers := cpList^.qualifiers + [tqRestrict]
|
|
else
|
|
Error(9);
|
|
NextToken;
|
|
end; {while}
|
|
end; {while}
|
|
StackDeclarations;
|
|
end;
|
|
|
|
lparench: begin {handle '(' 'declarator' ')'}
|
|
NextToken;
|
|
isPtr := token.kind = asteriskch;
|
|
StackDeclarations;
|
|
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
|
|
PushTable; {create a symbol table}
|
|
{determine if it's a function}
|
|
isFunction := lastWasIdentifier or isFunction;
|
|
tPtr2 := pointer(GCalloc(sizeof(typeRecord))); {create the function type}
|
|
{tPtr2^.size := 0;}
|
|
{tPtr2^.saveDisp := 0;}
|
|
tPtr2^.kind := functionType;
|
|
{tPtr2^.qualifiers := [];}
|
|
{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}
|
|
lSuppressMacroExpansions := suppressMacroExpansions;
|
|
suppressMacroExpansions := true;
|
|
NextToken;
|
|
suppressMacroExpansions := lSuppressMacroExpansions;
|
|
if token.kind = rparench then begin
|
|
PutBackToken(token, false, false);
|
|
NextToken;
|
|
tPtr2^.prototyped := true;
|
|
end
|
|
else begin
|
|
PutBackToken(token, false, 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}
|
|
done2 := false;
|
|
lisFunction := isFunction; {preserve global variables}
|
|
with tPtr2^ do begin
|
|
prototyped := true; {it is prototyped}
|
|
repeat {collect the declarations}
|
|
if token.kind in declarationSpecifiersElement then begin
|
|
ldeclaredTagOrEnumConst := declaredTagOrEnumConst;
|
|
lLastParameter := lastParameter;
|
|
DoDeclaration(true);
|
|
lastParameter := lLastParameter;
|
|
declaredTagOrEnumConst :=
|
|
ldeclaredTagOrEnumConst or declaredTagOrEnumConst;
|
|
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 = dotdotdotsy then begin
|
|
NextToken;
|
|
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}
|
|
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, false);
|
|
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}
|
|
if madeFunctionTable or not lastWasIdentifier then
|
|
PopTable
|
|
else
|
|
madeFunctionTable := true;
|
|
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^.qualifiers := [];}
|
|
tPtr2^.kind := arrayType;
|
|
{tPtr2^.elements := 0;}
|
|
NextToken;
|
|
gotStatic := false;
|
|
if doingParameters and (typeStack = nil) then begin
|
|
tPtr2^.kind := pointerType; {adjust to pointer type}
|
|
tPtr2^.size := cgPointerSize;
|
|
if token.kind = staticsy then begin
|
|
gotStatic := true;
|
|
NextToken;
|
|
end; {if}
|
|
while token.kind in [constsy,volatilesy,restrictsy] do begin
|
|
if token.kind = constsy then
|
|
tPtr2^.qualifiers := tPtr2^.qualifiers + [tqConst]
|
|
else if token.kind = volatilesy then begin
|
|
tPtr2^.qualifiers := tPtr2^.qualifiers + [tqVolatile];
|
|
volatile := true;
|
|
end {else}
|
|
else {if token.kind = restrictsy then}
|
|
tPtr2^.qualifiers := tPtr2^.qualifiers + [tqRestrict];
|
|
NextToken;
|
|
end; {while}
|
|
if not gotStatic then
|
|
if token.kind = staticsy then begin
|
|
gotStatic := true;
|
|
NextToken;
|
|
end; {if}
|
|
end; {if}
|
|
new(ttPtr);
|
|
ttPtr^.next := typeStack;
|
|
typeStack := ttPtr;
|
|
ttPtr^.typeDef := tPtr2;
|
|
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}
|
|
else if gotStatic then
|
|
Error(35);
|
|
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^.qualifiers := cpList^.qualifiers;
|
|
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}
|
|
tPtr := declSpecifiers.typeSpec;
|
|
newName := nil; {no identifier, yet}
|
|
unnamedParm := false; {not an unnamed parameter}
|
|
if declSpecifiers.storageClass = externsy then {decide on a storage state}
|
|
state := declared
|
|
else
|
|
state := defined;
|
|
madeFunctionTable := false; {no symbol table for function}
|
|
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; {stack the type records}
|
|
while typeStack <> nil do begin {reverse the type stack}
|
|
tsPtr := typeStack;
|
|
typeStack := tsPtr^.next;
|
|
tPtr2 := tsPtr^.typeDef;
|
|
dispose(tsPtr);
|
|
case tPtr2^.kind of
|
|
pointerType: begin
|
|
tPtr2^.pType := tPtr;
|
|
end;
|
|
functionType: begin
|
|
while tPtr^.kind = definedType do
|
|
tPtr := tPtr^.dType;
|
|
tPtr2^.fType := Unqualify(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;
|
|
end; {while}
|
|
|
|
if pascalsy in declSpecifiers.declarationModifiers then
|
|
tptr := MakePascalType(tptr);
|
|
|
|
if doingParameters then {adjust array parameters to pointers}
|
|
if tPtr^.kind = arrayType then
|
|
tPtr := MakePointerTo(tPtr^.aType);
|
|
|
|
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 (t1^.kind = functionType) and CompTypes(t1, tPtr) then begin
|
|
if t1^.prototyped and tPtr^.prototyped then begin
|
|
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);
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
if (t1^.kind = functionType) and CompTypes(t1^.fType,tPtr^.fType) then
|
|
Error(47)
|
|
else
|
|
Error(42);
|
|
1: end; {if}
|
|
state := declared;
|
|
end; {if}
|
|
if madeFunctionTable then begin
|
|
lTable := table;
|
|
table := table^.next;
|
|
end; {if}
|
|
if newName <> nil then {declare the variable}
|
|
variable := NewSymbol(newName, tPtr, declSpecifiers.storageClass,
|
|
space, state, inlinesy in declSpecifiers.declarationModifiers)
|
|
else if unnamedParm then
|
|
variable^.itype := tPtr
|
|
else begin
|
|
if token.kind <> semicolonch then
|
|
Error(9);
|
|
variable := nil;
|
|
end; {else}
|
|
if madeFunctionTable then
|
|
table := lTable;
|
|
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 <> declSpecifiers.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
|
|
disp: longint; {disp within overall object being initialized}
|
|
done: boolean; {for loop termination}
|
|
errorFound: boolean; {used to remove bad initializations}
|
|
haveExpression: boolean; {has an expression been parsed but not used?}
|
|
iPtr,jPtr,kPtr: initializerPtr; {for reversing the list}
|
|
ip: identList; {used to place an id in the list}
|
|
isStatic: boolean; {static storage duration (or automatic)?}
|
|
luseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
tToken: tokenType; {temporary copy of token}
|
|
|
|
|
|
procedure InsertInitializerRecord (iPtr: initializerPtr; size: longint);
|
|
|
|
{ Insert an initializer record in the initializer list }
|
|
{ }
|
|
{ parameters: }
|
|
{ iPtr - the record to insert }
|
|
{ size - number of bytes initialized by this record }
|
|
|
|
begin {InsertInitializerRecord}
|
|
iPtr^.disp := disp;
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
{ writeln('Inserted initializer record with size ', size:1, ' at disp ', disp:1); {debug}
|
|
disp := disp + size;
|
|
end; {InsertInitializerRecord}
|
|
|
|
|
|
procedure GetInitializerExpression;
|
|
|
|
{ get the expression for an initializer }
|
|
|
|
begin {GetInitializerExpression}
|
|
if not isStatic then
|
|
Expression(autoInitializerExpression, [commach,rparench,rbracech])
|
|
else
|
|
Expression(initializerExpression, [commach,rparench,rbracech]);
|
|
end; {GetInitializerExpression}
|
|
|
|
|
|
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;
|
|
|
|
var
|
|
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}
|
|
size: longint; {size of item being initialized}
|
|
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,ushortconst,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);
|
|
end {if}
|
|
else begin
|
|
size := 0;
|
|
tp := Subscript(tree);
|
|
end; {else}
|
|
if tp^.kind = arrayType then begin
|
|
tp := tp^.atype;
|
|
offset := offset + size*tp^.size;
|
|
Subscript := tp;
|
|
end {if}
|
|
else if tp^.kind = functionType then begin
|
|
Subscript := tp;
|
|
end {else 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, variableSpace, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
iPtr^.pName := @'?';
|
|
end {if}
|
|
else begin
|
|
if ip^.storage in [stackFrame,parameter] then begin
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {if}
|
|
Subscript := ip^.itype;
|
|
iPtr^.pName := ip^.name;
|
|
end; {else}
|
|
end {else if}
|
|
else if tree^.token.kind = stringConst then begin
|
|
Subscript := StringType(tree^.token.prefix);
|
|
iPtr^.isName := false;
|
|
iPtr^.pStr := tree^.token.sval;
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
end; {else}
|
|
end; {Subscript}
|
|
|
|
|
|
begin {GetInitializerValue}
|
|
if not haveExpression then
|
|
GetInitializerExpression
|
|
else begin
|
|
NextToken;
|
|
haveExpression := false;
|
|
end; {else}
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
if bitsize <> 0 then
|
|
size := (bitdisp + bitsize + 7) div 8
|
|
else
|
|
size := tp^.size;
|
|
InsertInitializerRecord(iPtr, size);
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := bitdisp;
|
|
iPtr^.bitsize := bitsize;
|
|
etype := expressionType;
|
|
AssignmentConversion(tp, expressionType, isConstant, expressionValue,
|
|
false, false);
|
|
if variable^.storage = external then
|
|
variable^.storage := global;
|
|
if isConstant and isStatic 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^.basetype := tp^.baseType;
|
|
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;
|
|
if tp^.cType = ctBool then
|
|
iPtr^.iVal := ord(expressionValue <> 0);
|
|
goto 2;
|
|
end; {if}
|
|
if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
|
if etype^.baseType in [cgByte..cgULong] then begin
|
|
iPtr^.rVal := expressionValue;
|
|
if etype^.baseType = cgULong then
|
|
if expressionValue < 0 then
|
|
iPtr^.rVal := iPtr^.rVal + 4294967296.0;
|
|
end {if}
|
|
else if etype^.baseType in
|
|
[cgReal,cgDouble,cgComp,cgExtended] then
|
|
iPtr^.rval := realExpressionValue
|
|
else if eType^.baseType = cgQuad then
|
|
iPtr^.rVal := CnvLLX(llExpressionValue)
|
|
else if eType^.baseType = cgUQuad then
|
|
iPtr^.rVal := CnvULLX(llExpressionValue);
|
|
goto 2;
|
|
end; {if}
|
|
if (etype^.baseType in [cgReal,cgDouble,cgComp,cgExtended])
|
|
and (bKind in [cgByte..cgULong,cgQuad,cgUQuad]) then begin
|
|
if tp^.cType = ctBool then
|
|
iPtr^.iVal := ord(realExpressionValue <> 0)
|
|
else if bKind = cgUQuad then
|
|
CnvXULL(iPtr^.qVal, realExpressionValue)
|
|
else
|
|
CnvXLL(iPtr^.qVal, realExpressionValue);
|
|
goto 2;
|
|
end;
|
|
Error(47);
|
|
errorFound := true;
|
|
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) or (etype = utf16StringTypePtr)
|
|
or (etype = utf32StringTypePtr) then begin
|
|
iPtr^.isConstant := true;
|
|
iPtr^.basetype := 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^.basetype := 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^.basetype := 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^.basetype := 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^.basetype := ccPointer;
|
|
if isStatic 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,ushortconst,longConst,
|
|
ulongconst,longlongConst,ulonglongconst,charconst,
|
|
scharconst,ucharconst] then begin
|
|
if kind in [intConst,charconst,scharconst,ucharconst] then
|
|
offSet2 := ival
|
|
else if kind in [uintConst,ushortconst] 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, variableSpace, 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, variableSpace, 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}
|
|
|
|
{handle auto variables}
|
|
if isStatic then begin
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {else}
|
|
iPtr^.isConstant := false;
|
|
iPtr^.iTree := initializerTree;
|
|
iPtr^.iType := tp;
|
|
end; {else}
|
|
1:
|
|
end; {GetInitializerValue}
|
|
|
|
|
|
procedure Fill (count: longint);
|
|
|
|
{ fill in space in an initialized data structure with 0 bytes }
|
|
{ }
|
|
{ parameters: }
|
|
{ count - number of zero bytes to create }
|
|
|
|
var
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
tk: tokenPtr; {expression record}
|
|
|
|
begin {Fill}
|
|
while count <> 0 do begin
|
|
iPtr := pointer(Calloc(sizeof(initializerRecord)));
|
|
iPtr^.isConstant := isStatic;
|
|
{iPtr^.bitdisp := 0;}
|
|
{iPtr^.bitsize := 0;}
|
|
if iPtr^.isConstant then
|
|
iPtr^.basetype := cgUByte
|
|
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;
|
|
iPtr^.iType := charPtr;
|
|
end; {else}
|
|
if count <= maxint then begin
|
|
iPtr^.count := ord(count);
|
|
count := 0;
|
|
end {if}
|
|
else begin
|
|
iPtr^.count := maxint;
|
|
count := count-maxint;
|
|
end; {else}
|
|
InsertInitializerRecord(iPtr, iPtr^.count);
|
|
end; {while}
|
|
end; {Fill}
|
|
|
|
|
|
procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer;
|
|
main, nestedDesignator: 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? }
|
|
{ nestedDesignator - handling second or later level of }
|
|
{ designator in a designator list? }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
bfp: identPtr; {pointer to bit-field in field list}
|
|
bfsize: integer; {number of bytes used by bit-field}
|
|
braces: boolean; {is the initializer inclosed in braces?}
|
|
count,maxCount: longint; {for tracking the size of an initializer}
|
|
ep: tokenPtr; {for forming string expression}
|
|
fillSize: longint; {size to fill with zeros}
|
|
hasNestedDesignator: boolean; {nested designator in current designation?}
|
|
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}
|
|
lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions}
|
|
maxDisp: longint; {maximum disp value so far}
|
|
newDisp: longint; {new disp set by a designator}
|
|
nextTokenKind: tokenEnum; {kind of next token}
|
|
startingDisp: longint; {disp at start of this term}
|
|
stringElementType: typePtr; {element type of string literal}
|
|
stringLength: integer; {elements in a string literal}
|
|
|
|
|
|
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}
|
|
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
kind := tp^.kind;
|
|
{check for designators that need to}
|
|
{be handled at an outer level }
|
|
if token.kind in [dotch,lbrackch] then
|
|
if not (braces or nestedDesignator) then
|
|
goto 1;
|
|
startingDisp := disp;
|
|
|
|
{handle arrays}
|
|
if kind = arrayType then begin
|
|
ktp := tp^.atype;
|
|
while ktp^.kind = definedType do
|
|
ktp := ktp^.dType;
|
|
kind := ktp^.kind;
|
|
|
|
{handle arrays initialized with a string constant}
|
|
if (token.kind = stringConst) and (kind = scalarType) then begin
|
|
stringElementType := StringType(token.prefix)^.aType;
|
|
if ((ktp^.baseType in [cgByte,cgUByte]) and (stringElementType^.size=1))
|
|
or CompTypes(ktp,stringElementType) then begin
|
|
tToken := token;
|
|
NextToken;
|
|
nextTokenKind := token.kind;
|
|
PutBackToken(token, false, true);
|
|
token := tToken;
|
|
if nextTokenKind in [commach, rbracech, semicolonch] then begin
|
|
stringLength :=
|
|
token.sval^.length div ord(stringElementType^.size);
|
|
if tp^.elements = 0 then begin
|
|
tp^.elements := stringLength;
|
|
RecomputeSizes(variable^.itype);
|
|
end {if}
|
|
else if tp^.elements < stringLength-1 then begin
|
|
Error(44);
|
|
errorFound := true;
|
|
end; {else if}
|
|
with ktp^ do begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
if isStatic then begin
|
|
InsertInitializerRecord(iPtr, token.sval^.length);
|
|
iPtr^.isConstant := true;
|
|
iPtr^.basetype := cgString;
|
|
iPtr^.sval := token.sval;
|
|
count := tp^.elements - stringLength;
|
|
if count > 0 then
|
|
Fill(count * stringElementType^.size)
|
|
else if count = -1 then begin
|
|
iPtr^.sval := pointer(GMalloc(token.sval^.length+2));
|
|
CopyLongString(iPtr^.sval, token.sval);
|
|
iPtr^.sval^.length :=
|
|
iPtr^.sval^.length - ord(stringElementType^.size);
|
|
end; {else if}
|
|
end {if}
|
|
else begin
|
|
InsertInitializerRecord(iPtr,
|
|
tp^.elements * stringElementType^.size);
|
|
iPtr^.isConstant := false;
|
|
new(ep);
|
|
iPtr^.iTree := ep;
|
|
iPtr^.iType := tp;
|
|
ep^.next := nil;
|
|
ep^.left := nil;
|
|
ep^.middle := nil;
|
|
ep^.right := nil;
|
|
ep^.token := token;
|
|
end; {else}
|
|
end; {with}
|
|
NextToken;
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
|
|
{handle arrays not initialized with a string constant}
|
|
if kind in
|
|
[scalarType,pointerType,enumType,arrayType,structType,unionType] then
|
|
begin
|
|
count := 0; {get the expressions|initializers}
|
|
maxCount := tp^.elements;
|
|
maxDisp := disp;
|
|
if token.kind <> rbracech then
|
|
repeat
|
|
hasNestedDesignator := false;
|
|
{handle designators}
|
|
if token.kind in [lbrackch,dotch] then begin
|
|
if not (braces or (nestedDesignator and (disp=startingDisp)))
|
|
then begin
|
|
PutBackToken(token, false, true);
|
|
token.kind := commach;
|
|
token.class := reservedSymbol;
|
|
goto 1;
|
|
end; {if}
|
|
Match(lbrackch, 35);
|
|
Expression(arrayExpression, [rbrackch]);
|
|
if (expressionValue < 0)
|
|
or ((maxCount <> 0) and (expressionValue >= maxCount)) then
|
|
begin
|
|
Error(183);
|
|
errorFound := true;
|
|
count := 0;
|
|
end {if}
|
|
else begin
|
|
count := expressionValue;
|
|
end; {else}
|
|
Match(rbrackch, 24);
|
|
if token.kind in [dotch,lbrackch] then
|
|
hasNestedDesignator := true
|
|
else
|
|
Match(eqch, 182);
|
|
newDisp := startingDisp + count * ktp^.size;
|
|
if braces then begin
|
|
fillSize := newDisp - maxDisp;
|
|
if hasNestedDesignator then
|
|
fillSize := fillSize + ktp^.size;
|
|
if fillSize > 0 then begin
|
|
disp := maxDisp;
|
|
Fill(fillSize);
|
|
maxDisp := disp;
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
|
|
disp := startingDisp + count * ktp^.size;
|
|
InitializeTerm(ktp, 0, 0, false, hasNestedDesignator);
|
|
if disp > maxDisp then
|
|
maxDisp := disp;
|
|
count := count+1;
|
|
if (count = maxCount) and not braces then
|
|
done := true
|
|
else if (token.kind = commach) then begin
|
|
NextToken;
|
|
done := token.kind = rbracech;
|
|
if not done then
|
|
if count = maxCount then
|
|
if not (token.kind = lbrackch) then begin
|
|
Error(183);
|
|
errorFound := true;
|
|
count := 0;
|
|
end; {if}
|
|
end {else if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
if maxCount = 0 then begin {set the array size}
|
|
if maxDisp <> startingDisp then begin
|
|
maxCount := (maxDisp - startingDisp + ktp^.size-1) div ktp^.size;
|
|
tp^.elements := maxCount;
|
|
RecomputeSizes(variable^.itype);
|
|
end {if}
|
|
else begin
|
|
Error(49);
|
|
errorFound := true;
|
|
end; {else}
|
|
end; {if}
|
|
if braces then begin
|
|
disp := startingDisp + maxCount * ktp^.size;
|
|
if disp > maxDisp then begin {if there weren't enough initializers...}
|
|
fillSize := disp - maxDisp;
|
|
disp := maxDisp;
|
|
Fill(fillSize); { fill in the blank spots}
|
|
end; {if}
|
|
end; {if}
|
|
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
|
|
|
|
{handle initialization with an expression of struct/union type}
|
|
if not braces then
|
|
if not nestedDesignator then
|
|
if not isStatic then
|
|
if (token.kind in startExpression-[stringconst]) then begin
|
|
if not haveExpression then begin
|
|
GetInitializerExpression;
|
|
haveExpression := true;
|
|
PutBackToken(token, false, true);
|
|
token.kind := ident; {dummy expression-starting token}
|
|
token.class := identifier;
|
|
token.name := @'__';
|
|
token.symbolPtr := nil;
|
|
while expressionType^.kind = definedType do
|
|
expressionType := expressionType^.dType;
|
|
end; {if}
|
|
if CompTypes(tp, expressionType) then begin
|
|
GetInitializerValue(tp, 0, 0);
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
|
|
{handle struct/union initialization with an initializer list}
|
|
if braces or (not main) then begin
|
|
ip := tp^.fieldList;
|
|
maxDisp := disp;
|
|
lSuppressMacroExpansions := suppressMacroExpansions;
|
|
while true do begin
|
|
if token.kind = rbracech then {fill remainder with zeros}
|
|
goto 2;
|
|
hasNestedDesignator := false;
|
|
{handle designators}
|
|
if token.kind in [dotch,lbrackch] then begin
|
|
if not (braces or (nestedDesignator and (disp=startingDisp)))
|
|
then begin
|
|
PutBackToken(token, false, true);
|
|
token.kind := commach;
|
|
token.class := reservedSymbol;
|
|
goto 1;
|
|
end; {if}
|
|
Match(dotch, 35);
|
|
if token.kind in [ident,typedef] then begin
|
|
ip := tp^.fieldList;
|
|
done := false;
|
|
while (ip <> nil) and not done do
|
|
if ip^.name^ = token.name^ then
|
|
done := true
|
|
else
|
|
ip := ip^.next;
|
|
if ip = nil then begin
|
|
Error(81);
|
|
errorFound := true;
|
|
end; {if}
|
|
if (ip <> nil) and ip^.anonMemberField then begin
|
|
PutBackToken(token, false, true);
|
|
token.kind := dotch;
|
|
token.class := reservedSymbol;
|
|
token.isDigraph := false;
|
|
ip := ip^.anonMember;
|
|
end {if}
|
|
else
|
|
NextToken;
|
|
if token.kind in [dotch,lbrackch] then
|
|
hasNestedDesignator := true
|
|
else
|
|
Match(eqch, 182);
|
|
newDisp := startingDisp + ip^.disp;
|
|
if braces then begin
|
|
fillSize := newDisp - maxDisp;
|
|
if hasNestedDesignator and (ip^.bitsize = 0) then
|
|
fillSize := fillSize + ip^.itype^.size;
|
|
if fillSize > 0 then begin
|
|
disp := maxDisp;
|
|
Fill(fillSize);
|
|
maxDisp := disp;
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else begin
|
|
Error(9);
|
|
errorFound := true;
|
|
goto 2;
|
|
end; {else}
|
|
end; {if}
|
|
|
|
if (ip = nil) or (ip^.itype^.size = 0) then
|
|
goto 2;
|
|
if ip^.isForwardDeclared then
|
|
ResolveForwardReference(ip);
|
|
disp := startingDisp + ip^.disp;
|
|
if ip^.bitsize <> 0 then begin {zero out padding bits in bitfields}
|
|
bfp := ip;
|
|
while (bfp^.next <> nil) and (bfp^.next^.disp = bfp^.disp)
|
|
and (bfp^.next^.bitsize <> 0) do
|
|
bfp := bfp^.next;
|
|
bfsize := (bfp^.bitdisp + bfp^.bitsize + 7) div 8;
|
|
if disp + bfsize > maxDisp then
|
|
if (bfp <> ip) or (ip^.bitdisp <> 0)
|
|
or (ip^.bitsize mod 8 <> 0) then begin
|
|
Fill(bfsize);
|
|
maxDisp := disp;
|
|
disp := startingDisp + ip^.disp;
|
|
end; {if}
|
|
end; {if}
|
|
InitializeTerm(ip^.itype, ip^.bitsize, ip^.bitdisp, false,
|
|
hasNestedDesignator);
|
|
if disp > maxDisp then
|
|
maxDisp := disp;
|
|
if kind = unionType then
|
|
ip := nil
|
|
else begin
|
|
ip := ip^.next;
|
|
while (ip <> nil) and ip^.anonMemberField do
|
|
ip := ip^.next;
|
|
end; {else}
|
|
if ((ip = nil) or (ip^.itype^.size = 0)) and not braces then
|
|
goto 2;
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = commach then
|
|
if ip = nil then
|
|
if braces then begin
|
|
Error(23);
|
|
errorFound := true;
|
|
end; {if}
|
|
end {if}
|
|
else if token.kind <> rbracech then
|
|
ip := nil;
|
|
end; {while}
|
|
2: if braces then begin
|
|
disp := startingDisp + tp^.size;
|
|
if disp > maxDisp then begin {if there weren't enough initializers...}
|
|
fillSize := disp - maxDisp;
|
|
disp := maxDisp;
|
|
Fill(fillSize); { fill in the blank spots}
|
|
end; {if}
|
|
end; {if}
|
|
suppressMacroExpansions := lSuppressMacroExpansions;
|
|
end {if}
|
|
else begin {struct/union assignment initializer}
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
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}
|
|
1:
|
|
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}
|
|
disp := 0; {start at beginning of the object}
|
|
errorFound := false; {no errors found so far}
|
|
haveExpression := false; {no expression parsed yet}
|
|
{static or automatic initialization?}
|
|
isStatic := variable^.storage in [external,global,private];
|
|
luseGlobalPool := useGlobalPool; {use global memory for global vars}
|
|
useGlobalPool := isStatic 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, false); {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 isStatic then {if doing static initialization }
|
|
if variable^.itype^.kind in [structType,unionType,definedType,arrayType]
|
|
then begin
|
|
disp := 0; {...ensure unnamed members are 0}
|
|
Fill(variable^.itype^.size);
|
|
end; {if}
|
|
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 (var declSpecifiers: declSpecifiersRecord;
|
|
allowedTokens: tokenSet; badNextTokenError: integer);
|
|
|
|
{ handle declaration specifiers or a specifier-qualifier list }
|
|
{ }
|
|
{ parameters: }
|
|
{ declSpecifiers - record to hold result type & specifiers}
|
|
{ allowedTokens - specifiers/qualifiers that can be used }
|
|
{ badNextTokenError - error code for an unexpected token }
|
|
{ following the declaration specifiers }
|
|
{ }
|
|
{ outputs: }
|
|
{ isForwardDeclared - is the field list component }
|
|
{ referencing a forward struct/union? }
|
|
{ declaredTagOrEnumConst - set if a tag or an enum const }
|
|
{ is declared (otherwise unchanged) }
|
|
|
|
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}
|
|
|
|
typeQualifiers: typeQualifierSet; {set of type qualifiers found}
|
|
|
|
myIsForwardDeclared: boolean; {value of isForwardDeclared to generate}
|
|
myTypeSpec: typePtr; {value of typeSpec to generate}
|
|
myDeclarationModifiers: tokenSet; {all modifiers in this declaration}
|
|
myStorageClass: tokenEnum; {storage class}
|
|
|
|
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;
|
|
|
|
type
|
|
anonNameString = packed array [0..11] of char;
|
|
|
|
var
|
|
anonName: ^anonNameString; {name for anonymous struct/union field}
|
|
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}
|
|
maxDisp: longint; {for determining union sizes}
|
|
variable: identPtr; {variable being defined}
|
|
didFlexibleArray: boolean; {have we seen a flexible array member?}
|
|
fieldDeclSpecifiers: declSpecifiersRecord; {decl specifiers for field}
|
|
tPtr: typePtr; {for building types}
|
|
anonMember: boolean; {processing an anonymous struct/union?}
|
|
|
|
procedure AddField(variable: identPtr; anonMember: identPtr);
|
|
|
|
{ add a field to the field list }
|
|
{ }
|
|
{ parameters }
|
|
{ variable - field to add }
|
|
{ anonMember - anonymous struct/union that this field }
|
|
{ came from, if any (nil if not an anonymous }
|
|
{ member field) }
|
|
|
|
label 1;
|
|
|
|
var
|
|
tfl: identPtr; {for traversing field list}
|
|
|
|
begin {AddField}
|
|
tfl := fl; {(check for dups)}
|
|
while tfl <> nil do begin
|
|
if tfl^.name^ = variable^.name^ then begin
|
|
Error(42);
|
|
goto 1;
|
|
end; {if}
|
|
tfl := tfl^.next;
|
|
end; {while}
|
|
1: variable^.next := fl;
|
|
if anonMember <> nil then begin
|
|
variable^.anonMemberField := true;
|
|
variable^.anonMember := anonMember;
|
|
end {if}
|
|
else
|
|
variable^.anonMemberField := false;
|
|
fl := variable;
|
|
end; {AddField}
|
|
|
|
begin {FieldList}
|
|
ldoingParameters := doingParameters; {allow fields in K&R dec. area}
|
|
doingParameters := false;
|
|
lisForwardDeclared := isForwardDeclared; {stack this value}
|
|
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(fieldDeclSpecifiers, specifierQualifierListElement, 176);
|
|
repeat {declare the variables...}
|
|
if didFlexibleArray then
|
|
Error(118);
|
|
variable := nil;
|
|
anonMember := false;
|
|
if token.kind <> colonch then begin
|
|
if (token.kind = semicolonch) then begin
|
|
tPtr := fieldDeclSpecifiers.typeSpec;
|
|
while tPtr^.kind = definedType do
|
|
tPtr := tPtr^.dType;
|
|
if (tPtr^.kind in [structType,unionType])
|
|
and (tPtr^.sName = nil)
|
|
and ((structsy in fieldDeclSpecifiers.declarationModifiers)
|
|
or (unionsy in fieldDeclSpecifiers.declarationModifiers))
|
|
then begin
|
|
anonName := pointer(Malloc(sizeof(anonNameString)));
|
|
anonName^ := concat('~anon', cnvis(anonNumber));
|
|
anonNumber := anonNumber+1;
|
|
variable := NewSymbol(anonName, tPtr, ident,
|
|
fieldListSpace, defined, false);
|
|
anonMember := true;
|
|
TermHeader; {cannot record anon member in .sym file}
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
Declarator(fieldDeclSpecifiers, variable, fieldListSpace, false);
|
|
if variable <> nil then {enter the var in the field list}
|
|
AddField(variable, nil);
|
|
end; {if}
|
|
if kind = unionType then begin
|
|
disp := 0;
|
|
bitdisp := 0;
|
|
end; {if}
|
|
if token.kind = colonch then {handle a bit field}
|
|
begin
|
|
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 := fieldDeclSpecifiers.typeSpec;
|
|
bitdisp := bitdisp+long(expressionValue).lsw;
|
|
if kind = unionType then
|
|
if ((bitDisp+7) div 8) > maxDisp then
|
|
maxDisp := ((bitDisp+7) div 8);
|
|
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 _Alignassy in fieldDeclSpecifiers.declarationModifiers 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}
|
|
variable^.disp := disp;
|
|
variable^.bitdisp := bitdisp;
|
|
variable^.bitsize := 0;
|
|
if anonMember then begin
|
|
tfl := variable^.itype^.fieldList;
|
|
while tfl <> nil do begin
|
|
ufl := pointer(Malloc(sizeof(identRecord)));
|
|
ufl^ := tfl^;
|
|
AddField(ufl, variable);
|
|
ufl^.disp := ufl^.disp + disp;
|
|
tfl := tfl^.next;
|
|
end; {while}
|
|
end; {if}
|
|
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 begin {handle flexible array member}
|
|
didFlexibleArray := true;
|
|
tp^.flexibleArrayMember := true;
|
|
end {if}
|
|
else
|
|
Error(117);
|
|
end {if}
|
|
else
|
|
Error(116);
|
|
|
|
if variable <> nil then {check for a const member}
|
|
tPtr := variable^.itype
|
|
else
|
|
tPtr := fieldDeclSpecifiers.typeSpec;
|
|
while tPtr^.kind in [definedType,arrayType] do begin
|
|
if tqConst in tPtr^.qualifiers then
|
|
tp^.constMember := true;
|
|
if tPtr^.kind = definedType then
|
|
tPtr := tPtr^.dType
|
|
else {if tPtr^.kind = arrayType then}
|
|
tPtr := tPtr^.aType;
|
|
end; {while}
|
|
if tqConst in tPtr^.qualifiers then
|
|
tp^.constMember := true;
|
|
if tPtr^.kind in [structType,unionType] then begin
|
|
if tPtr^.constMember then
|
|
tp^.constMember := true;
|
|
if tPtr^.flexibleArrayMember then
|
|
if kind = structType then
|
|
Error(169)
|
|
else {if kind = unionType then}
|
|
tp^.flexibleArrayMember := true;
|
|
end; {if}
|
|
|
|
if token.kind = commach then {allow repeated declarations}
|
|
begin
|
|
NextToken;
|
|
done := false;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
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}
|
|
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
|
|
Error(badNextTokenError);
|
|
end; {ResolveType}
|
|
|
|
|
|
begin {DeclarationSpecifiers}
|
|
myTypeSpec := nil;
|
|
myIsForwardDeclared := false; {not doing a forward reference (yet)}
|
|
myDeclarationModifiers := [];
|
|
myStorageClass := ident;
|
|
typeQualifiers := [];
|
|
typeSpecifiers := [];
|
|
typeDone := 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 myStorageClass <> ident then begin
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
Error(badNextTokenError)
|
|
else
|
|
Error(26);
|
|
end; {if}
|
|
myStorageClass := 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 myStorageClass 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 (myStorageClass in [autosy,registersy]) then
|
|
Error(127);
|
|
if _Thread_localsy in myDeclarationModifiers then
|
|
if not (myStorageClass in [staticsy,externsy]) then
|
|
Error(177);
|
|
NextToken;
|
|
end;
|
|
|
|
_Thread_localsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
if doingParameters then
|
|
Error(87);
|
|
if not (myStorageClass in [ident,staticsy,externsy]) then
|
|
Error(177);
|
|
NextToken;
|
|
end;
|
|
|
|
{function specifiers}
|
|
inlinesy,_Noreturnsy,asmsy,pascalsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
NextToken;
|
|
end;
|
|
|
|
{type qualifiers}
|
|
constsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
typeQualifiers := typeQualifiers + [tqConst];
|
|
NextToken;
|
|
end;
|
|
|
|
volatilesy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
typeQualifiers := typeQualifiers + [tqVolatile];
|
|
volatile := true;
|
|
NextToken;
|
|
end;
|
|
|
|
restrictsy: begin
|
|
myDeclarationModifiers := myDeclarationModifiers + [token.kind];
|
|
typeQualifiers := typeQualifiers + [tqRestrict];
|
|
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
|
|
Error(badNextTokenError);
|
|
NextToken;
|
|
myTypeSpec := TypeName;
|
|
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
|
|
Error(badNextTokenError)
|
|
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
|
|
Error(badNextTokenError);
|
|
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
|
|
Error(badNextTokenError)
|
|
else if restrictsy in myDeclarationModifiers then
|
|
Error(143);
|
|
NextToken; {skip the 'enum' token}
|
|
if token.kind in [ident,typedef] then begin {handle a type definition}
|
|
ttoken := token;
|
|
NextToken;
|
|
variable :=
|
|
FindSymbol(ttoken, tagSpace, token.kind = lbracech, true);
|
|
if token.kind = lbracech then begin
|
|
if (variable <> nil) and (variable^.itype^.kind = enumType) then
|
|
if not looseTypeChecks then
|
|
Error(53);
|
|
end {if}
|
|
else
|
|
if (variable <> nil) and (variable^.itype^.kind = enumType) then
|
|
begin
|
|
if looseTypeChecks then
|
|
declaredTagOrEnumConst := true;
|
|
goto 1;
|
|
end {if}
|
|
else begin
|
|
declaredTagOrEnumConst := true;
|
|
if not looseTypeChecks then
|
|
Error(171);
|
|
end; {else}
|
|
tPtr := pointer(Malloc(sizeof(typeRecord)));
|
|
tPtr^.size := cgWordSize;
|
|
tPtr^.saveDisp := 0;
|
|
tPtr^.qualifiers := [];
|
|
tPtr^.kind := enumType;
|
|
variable :=
|
|
NewSymbol(ttoken.name, tPtr, ident, tagSpace, defined, false);
|
|
end {if}
|
|
else if token.kind <> lbracech then
|
|
Error(9);
|
|
enumVal := 0; {set the default value}
|
|
if token.kind = lbracech then begin
|
|
declaredTagOrEnumConst := true;
|
|
NextToken; {skip the '{'}
|
|
repeat {declare the enum constants}
|
|
tPtr := pointer(Malloc(sizeof(typeRecord)));
|
|
tPtr^.size := cgWordSize;
|
|
tPtr^.saveDisp := 0;
|
|
tPtr^.qualifiers := [];
|
|
tPtr^.kind := enumConst;
|
|
if token.kind = ident then begin
|
|
variable := NewSymbol(token.name, tPtr, ident, variableSpace,
|
|
defined, false);
|
|
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)
|
|
else if enumVal < 0 then
|
|
if expressionType^.kind = scalarType then
|
|
if expressionType^.baseType in [cgULong,cgUQuad] 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: myTypeSpec := intPtr;
|
|
typeDone := true;
|
|
end;
|
|
|
|
structsy, {struct}
|
|
unionsy: begin {union}
|
|
if typeDone or (typeSpecifiers <> []) then
|
|
Error(badNextTokenError)
|
|
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 (token.kind = lbracech) or
|
|
((token.kind = semicolonch) and (myDeclarationModifiers = []))
|
|
then
|
|
declaredTagOrEnumConst := true;
|
|
if structPtr = nil then begin {if the name hasn't been defined then...}
|
|
if token.kind <> lbracech then
|
|
if (token.kind <> semicolonch) or
|
|
(myDeclarationModifiers <> []) 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^.qualifiers := [];}
|
|
structTypePtr^.kind := tkind;
|
|
{structTypePtr^.fieldList := nil;}
|
|
{structTypePtr^.sName := nil;}
|
|
{structTypePtr^.constMember := false;}
|
|
{structTypePtr^.flexibleArrayMember := false;}
|
|
structPtr := NewSymbol(ttoken.name, structTypePtr, ident,
|
|
tagSpace, defined, false);
|
|
structTypePtr^.sName := structPtr^.name;
|
|
declaredTagOrEnumConst := true;
|
|
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}
|
|
declaredTagOrEnumConst := true; {avoid extra errors}
|
|
structPtr := nil;
|
|
end {else}
|
|
else begin {record the existing structure type}
|
|
structTypePtr := structPtr^.itype;
|
|
end; {else}
|
|
end {if}
|
|
else if token.kind <> lbracech then begin
|
|
Error(9); {its an error if there's no name or struct}
|
|
declaredTagOrEnumConst := true; {avoid extra errors}
|
|
end; {else if}
|
|
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^.qualifiers := [];}
|
|
structTypePtr^.kind := tkind;
|
|
{structTypePtr^.fieldList := nil;}
|
|
{structTypePtr^.sName := nil;}
|
|
{structTypePtr^.constMember := false;}
|
|
{structTypePtr^.flexibleArrayMember := false;}
|
|
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;
|
|
if tKind = structType then
|
|
myDeclarationModifiers := myDeclarationModifiers + [structsy]
|
|
else
|
|
myDeclarationModifiers := myDeclarationModifiers + [unionsy];
|
|
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
|
|
tPtr := TypeName;
|
|
with tPtr^ 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;
|
|
declSpecifiers.declarationModifiers := myDeclarationModifiers;
|
|
if _Thread_localsy in myDeclarationModifiers then
|
|
if myStorageClass = ident then
|
|
if doingFunction then
|
|
Error(177);
|
|
if myTypeSpec = nil then begin
|
|
myTypeSpec := intPtr; {under C89, default type is int}
|
|
if (lint & lintC99Syntax) <> 0 then
|
|
Error(151);
|
|
end; {if}
|
|
declSpecifiers.typeSpec := {apply type qualifiers}
|
|
MakeQualifiedType(myTypeSpec, typeQualifiers);
|
|
declSpecifiers.storageClass := myStorageClass;
|
|
end; {DeclarationSpecifiers}
|
|
|
|
|
|
{-- Externally available subroutines ---------------------------}
|
|
|
|
procedure DoDeclaration {doingPrototypes: boolean};
|
|
|
|
{ process a variable or function declaration }
|
|
{ }
|
|
{ parameters: }
|
|
{ doingPrototypes - is this a prototype parameter decl? }
|
|
|
|
label 1,2,3,4;
|
|
|
|
var
|
|
declarationSpecifierFound: boolean; {has some decl specifier been found?}
|
|
first: boolean; {handling first declarator in decl?}
|
|
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}
|
|
lInhibitHeader: boolean; {local copy of inhibitHeader}
|
|
lp,tlp,tlp2: identPtr; {for tracing parameter list}
|
|
lUseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
nextPdisp: integer; {for calculating parameter disps}
|
|
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}
|
|
startLine: longint; {line where this declaration starts}
|
|
declSpecifiers: declSpecifiersRecord; {type & specifiers for the declaration}
|
|
|
|
|
|
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}
|
|
if tp^.aType^.kind in [structType,unionType] then
|
|
if tp^.aType^.flexibleArrayMember then
|
|
Error(169);
|
|
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;
|
|
defaultSegmentKind := segmentKind;
|
|
inhibitHeader := lInhibitHeader;
|
|
Match(semicolonch,22);
|
|
inhibitHeader := true;
|
|
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}
|
|
|
|
begin {SkipFunction}
|
|
Match(lbracech,27); {skip to the closing rbrackch}
|
|
braceCount := 1;
|
|
while (not (token.kind = eofsy)) and (braceCount <> 0) do begin
|
|
if token.kind = lbracech then
|
|
braceCount := braceCount+1
|
|
else if token.kind = rbracech then
|
|
braceCount := braceCount-1;
|
|
NextToken;
|
|
end; {while}
|
|
nameFound := false; {no pc_nam for the next function (yet)}
|
|
doingFunction := false; {no longer doing a function}
|
|
end; {SkipFunction}
|
|
|
|
|
|
begin {DoDeclaration}
|
|
lInhibitHeader:= inhibitHeader;
|
|
inhibitHeader := true; {block imbedded includes in headers}
|
|
if token.kind = _Static_assertsy then begin
|
|
DoStaticAssert;
|
|
goto 4;
|
|
end; {if}
|
|
lDoingParameters := doingParameters; {record the status}
|
|
first := true; {preparing to handle first declarator}
|
|
if doingPrototypes then {prototypes implies a parm list}
|
|
doingParameters := true
|
|
else
|
|
lastParameter := nil; {init parm list if we're not doing prototypes}
|
|
startLine := lineNumber;
|
|
if not doingFunction then {handle any segment statements}
|
|
while token.kind = segmentsy do
|
|
SegmentStatement;
|
|
lUseGlobalPool := useGlobalPool;
|
|
{handle a TypeSpecifier/declarator}
|
|
declarationSpecifierFound := token.kind in declarationSpecifiersElement;
|
|
declaredTagOrEnumConst := false;
|
|
DeclarationSpecifiers(declSpecifiers, declarationSpecifiersElement, 176);
|
|
isAsm := asmsy in declSpecifiers.declarationModifiers;
|
|
isInline := inlinesy in declSpecifiers.declarationModifiers;
|
|
isNoreturn := _Noreturnsy in declSpecifiers.declarationModifiers;
|
|
alignmentSpecified := _Alignassy in declSpecifiers.declarationModifiers;
|
|
if token.kind = semicolonch then
|
|
if not doingPrototypes then
|
|
if not declaredTagOrEnumConst then
|
|
Error(176);
|
|
|
|
3:
|
|
isFunction := false; {assume it's not a function}
|
|
variable := nil;
|
|
Declarator(declSpecifiers, variable, variableSpace, doingPrototypes);
|
|
if variable = nil then begin
|
|
inhibitHeader := lInhibitHeader;
|
|
if token.kind = semicolonch then begin
|
|
if not first then
|
|
Error(176);
|
|
NextToken;
|
|
end {if}
|
|
else begin
|
|
Error(22);
|
|
SkipStatement;
|
|
end; {else}
|
|
goto 1;
|
|
end; {if}
|
|
|
|
{handle a function declaration}
|
|
if isFunction then begin
|
|
|
|
if not declarationSpecifierFound then
|
|
if first then
|
|
if doingPrototypes or (token.kind in [commach,semicolonch]) then
|
|
Error(26)
|
|
else
|
|
if (lint & lintNoFnType) <> 0 then
|
|
if (lint & lintC99Syntax) = 0 then
|
|
Error(104);
|
|
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 or isNoreturn then
|
|
if not (isNewDeskAcc or isClassicDeskAcc or isCDev or isNBA or isXCMD) then
|
|
if variable^.name^ = 'main' then
|
|
Error(181);
|
|
if alignmentSpecified then
|
|
Error(142);
|
|
if _Thread_localsy in declSpecifiers.declarationModifiers then
|
|
Error(178);
|
|
|
|
{handle functions in the parameter list}
|
|
if doingPrototypes then
|
|
PopTable
|
|
|
|
{external or forward declaration}
|
|
else if token.kind in [commach,semicolonch,inlinesy] then begin
|
|
if token.kind = inlinesy then {handle tool declarations}
|
|
with fnType^ do begin
|
|
NextToken;
|
|
Match(lparench,13);
|
|
if token.kind in
|
|
[intconst,uintconst,ushortconst,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,ushortconst,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 := lInhibitHeader;
|
|
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}
|
|
first := false;
|
|
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
|
|
Error(28);
|
|
while token.kind <> eofsy do
|
|
NextToken;
|
|
end {if}
|
|
|
|
{local declaration}
|
|
else begin
|
|
if (not first) or (declSpecifiers.storageClass = typedefsy) then
|
|
Error(22);
|
|
if variable^.state = defined then
|
|
Error(42);
|
|
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}
|
|
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 (variable^.storage = external) and variable^.inlineDefinition then begin
|
|
new(fname);
|
|
fname^ := concat('~inline~', variable^.name^);
|
|
segType := $4000;
|
|
end {if}
|
|
else 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);
|
|
end; {if}
|
|
Gen2Name(dc_str, segType, 0, fName);
|
|
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;
|
|
debugSourceFileGS := sourceFileGS;
|
|
GenPS(pc_nam, variable^.name);
|
|
end; {if}
|
|
changedSourceFile := false;
|
|
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) and
|
|
(lp^.itype^.baseType in [cgReal,cgDouble,cgComp]) then begin
|
|
if extendedParameters then
|
|
{all floating-point params are treated as extended}
|
|
lp^.itype :=
|
|
MakeQualifiedType(extendedPtr, lp^.itype^.qualifiers);
|
|
nextPdisp := nextPdisp + cgExtendedSize;
|
|
end {if}
|
|
else begin
|
|
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}
|
|
end; {else}
|
|
lp := lp^.pnext;
|
|
end; {while}
|
|
gotoList := nil; {initialize the label list}
|
|
fenvAccessInFunction := fenvAccess;
|
|
skipReturn := false;
|
|
returnCount := 0;
|
|
if isAsm then begin
|
|
AsmFunction(variable); {handle assembly language functions}
|
|
PopTable;
|
|
end {if}
|
|
else begin
|
|
{set up struct/union area}
|
|
if variable^.itype^.ftype^.kind in [structType,unionType] then
|
|
structReturnVar := NewSymbol(@'@struct', variable^.itype^.ftype,
|
|
staticsy, variablespace, declared, false);
|
|
{generate parameter labels}
|
|
if fnType^.overrideKR then
|
|
GenParameters(nil)
|
|
else
|
|
GenParameters(fnType^.parameterList);
|
|
savedVolatile := volatile;
|
|
functionTable := table;
|
|
if fnType^.varargs then begin {make internal va info for varargs funcs}
|
|
lp := NewSymbol(@'__orcac_va_info', vaInfoPtr, autosy,
|
|
variableSpace, declared, false);
|
|
lp^.lln := GetLocalLabel;
|
|
lp^.used := true;
|
|
Gen2(dc_loc, lp^.lln, ord(vaInfoPtr^.size));
|
|
Gen2(pc_lda, lastParameterLLN, lastParameterSize);
|
|
Gen2t(pc_cop, lp^.lln, 0, cgULong);
|
|
Gen2t(pc_str, lp^.lln, cgPointerSize, cgULong);
|
|
vaInfoLLN := lp^.lln;
|
|
end {if}
|
|
else
|
|
vaInfoLLN := 0;
|
|
CompoundStatement(false); {process the statements}
|
|
end; {else}
|
|
end; {else}
|
|
2: ;
|
|
end {if}
|
|
|
|
{handle a variable declaration}
|
|
else {if not isFunction then} begin
|
|
if not declarationSpecifierFound then
|
|
if first then
|
|
Error(26);
|
|
if alignmentSpecified then
|
|
if declSpecifiers.storageClass in [typedefsy,registersy] then
|
|
Error(142);
|
|
if isInline then
|
|
Error(119);
|
|
if isNoreturn then
|
|
Error(141);
|
|
if token.kind = eqch then begin
|
|
if declSpecifiers.storageClass = typedefsy then
|
|
Error(52)
|
|
else if declSpecifiers.storageClass = externsy then
|
|
if doingFunction then
|
|
Error(22);
|
|
if doingPrototypes or doingParameters 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;
|
|
TermHeader; {make sure the header file is closed}
|
|
NextToken; {handle an initializer}
|
|
Initializer(variable);
|
|
end; {if}
|
|
{check to insure array sizes are specified}
|
|
if declSpecifiers.storageClass <> typedefsy then
|
|
CheckArray(variable,
|
|
(declSpecifiers.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, false); {initialize auto variable}
|
|
end; {if}
|
|
if (token.kind = commach) and (not doingPrototypes) then begin
|
|
NextToken; {allow multiple variables on one line}
|
|
first := false;
|
|
goto 3;
|
|
end; {if}
|
|
if doingPrototypes then begin
|
|
protoVariable := variable; {make the var available to Declarator}
|
|
if protoVariable = nil then
|
|
protoType := declSpecifiers.typeSpec
|
|
else
|
|
protoType := protoVariable^.iType;
|
|
end {if}
|
|
else begin
|
|
inhibitHeader := lInhibitHeader;
|
|
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;
|
|
4:
|
|
inhibitHeader := lInhibitHeader;
|
|
end; {DoDeclaration}
|
|
|
|
|
|
function TypeName{: typePtr};
|
|
|
|
{ process a type name (used for casts and sizeof/_Alignof) }
|
|
{ }
|
|
{ returns: a pointer to the type }
|
|
|
|
var
|
|
tl,tp: typePtr; {for creating/reversing the type list}
|
|
declSpecifiers: declSpecifiersRecord; {type & specifiers for the type name}
|
|
|
|
|
|
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^.qualifiers := [];}
|
|
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 := Unqualify(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 := cgPointerSize;
|
|
tp^.saveDisp := 0;
|
|
tp^.qualifiers := [];
|
|
tp^.kind := pointerType;
|
|
while token.kind in [constsy,volatilesy,restrictsy] do begin
|
|
if token.kind = constsy then
|
|
tp^.qualifiers := tp^.qualifiers + [tqConst]
|
|
else if token.kind = volatilesy then begin
|
|
tp^.qualifiers := tp^.qualifiers + [tqVolatile];
|
|
volatile := true;
|
|
end {else}
|
|
else {if token.kind = restrictsy then}
|
|
tp^.qualifiers := tp^.qualifiers + [tqRestrict];
|
|
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^.qualifiers := [];}
|
|
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 := Unqualify(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(declSpecifiers, specifierQualifierListElement, 12);
|
|
|
|
{_Alignas is not allowed in most uses of type names. }
|
|
{TODO: _Alignas should be allowed in compound literals. }
|
|
if _Alignassy in declSpecifiers.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 := declSpecifiers.typeSpec;
|
|
if tl^.kind = arrayType then
|
|
tl^.size := tl^.elements * declSpecifiers.typeSpec^.size;
|
|
declSpecifiers.typeSpec := tl;
|
|
tl := tp;
|
|
end; {while}
|
|
if pascalsy in declSpecifiers.declarationModifiers then
|
|
declSpecifiers.typeSpec := MakePascalType(declSpecifiers.typeSpec);
|
|
TypeName := declSpecifiers.typeSpec;
|
|
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?}
|
|
lSuppressMacroExpansions: boolean; {local copy of suppressMacroExpansions}
|
|
|
|
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;
|
|
lSuppressMacroExpansions := suppressMacroExpansions;
|
|
suppressMacroExpansions := true; {inhibit token echo}
|
|
NextToken;
|
|
suppressMacroExpansions := lSuppressMacroExpansions;
|
|
nToken := token;
|
|
PutBackToken(nToken, false, 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: longint;
|
|
isCompoundLiteral: boolean};
|
|
|
|
{ generate code to initialize an auto variable }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - the variable to initialize }
|
|
{ line - line number (used for debugging) }
|
|
{ isCompoundLiteral - initializing a compound literal? }
|
|
|
|
var
|
|
iPtr: initializerPtr; {pointer to the next initializer}
|
|
codeCount: longint; {number of initializer expressions}
|
|
treeCount: integer; {current number of distinct trees}
|
|
ldoDispose: boolean; {local copy of doDispose}
|
|
|
|
|
|
procedure InitializeOneElement;
|
|
|
|
{ initialize (part of) a variable using the initializer iPtr }
|
|
{ }
|
|
{ variables: }
|
|
{ variable - the variable to initialize }
|
|
{ count - number of times to re-use the initializer }
|
|
{ iPtr - pointer to the initializer record to use }
|
|
|
|
label 1,2,3,4;
|
|
|
|
var
|
|
count: integer; {initializer counter}
|
|
disp: longint; {displacement to initialize at}
|
|
elements: longint; {# array elements}
|
|
itype: typePtr; {the type being initialized}
|
|
size: integer; {fill size}
|
|
|
|
{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}
|
|
if variable^.storage = stackFrame then
|
|
Gen2(pc_lda, variable^.lln, ord(disp))
|
|
else
|
|
Error(57);
|
|
end; {LoadAddress}
|
|
|
|
|
|
procedure AddOperation;
|
|
|
|
{ Deal with a new initializer expression in a compound }
|
|
{ literal, adding expression tree nodes as appropriate. }
|
|
{ This aims to produce a balanced binary tree. }
|
|
|
|
var
|
|
val: longint;
|
|
|
|
begin {AddOperation}
|
|
treeCount := treeCount + 1;
|
|
codeCount := codeCount + 1;
|
|
val := codeCount;
|
|
while (val & 1) = 0 do begin
|
|
Gen0t(pc_bno, cgVoid);
|
|
treeCount := treeCount - 1;
|
|
val := val >> 1;
|
|
end; {end}
|
|
end; {AddOperation}
|
|
|
|
|
|
begin {InitializeOneElement}
|
|
disp := iPtr^.disp;
|
|
count := iPtr^.count;
|
|
3: itype := iPtr^.iType;
|
|
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}
|
|
{generate the expression value}
|
|
doDispose := ldoDispose and (count = 1);
|
|
{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 val = 0 then
|
|
if count > 1 then
|
|
if itype^.size = 1 then begin
|
|
{call ~ZERO for > 50 zero bytes}
|
|
if count > 50 then begin
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen1t(pc_ldc, count, cgWord);
|
|
Gen0t(pc_stk, cgWord);
|
|
Gen0t(pc_bno, cgWord);
|
|
Gen1tName(pc_cup, -1, cgVoid, @'~ZERO');
|
|
if isCompoundLiteral then
|
|
AddOperation;
|
|
goto 4;
|
|
end {if}
|
|
else begin {zero-initialize two bytes at a time}
|
|
itype := shortPtr;
|
|
count := count - 1;
|
|
end; {else}
|
|
end; {if}
|
|
|
|
{ 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}
|
|
if isCompoundLiteral then
|
|
AddOperation;
|
|
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 iPtr^.iTree^.token.kind = stringConst then begin
|
|
elements := elements * itype^.aType^.size;
|
|
size := iPtr^.iTree^.token.sval^.length;
|
|
if size >= elements then
|
|
size := ord(elements)
|
|
else
|
|
size := size-1;
|
|
if size <> 0 then begin
|
|
LoadAddress;
|
|
GenS(pc_lca, iPtr^.iTree^.token.sval);
|
|
Gen2(pc_mov, 0, size);
|
|
Gen0t(pc_pop, cgULong);
|
|
if isCompoundLiteral then
|
|
AddOperation;
|
|
end; {if}
|
|
if size < elements then begin
|
|
elements := elements - size;
|
|
disp := disp + size;
|
|
LoadAddress;
|
|
Gen0t(pc_stk, cgULong);
|
|
Gen1t(pc_ldc, ord(elements), cgWord);
|
|
Gen0t(pc_stk, cgWord);
|
|
Gen0t(pc_bno, cgWord);
|
|
Gen1tName(pc_cup, -1, cgVoid, @'~ZERO');
|
|
if isCompoundLiteral then
|
|
AddOperation;
|
|
end; {if}
|
|
end; {if}
|
|
1: end;
|
|
|
|
structType,unionType: 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);
|
|
if isCompoundLiteral then
|
|
AddOperation;
|
|
end; {if}
|
|
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
if count <> 1 then begin
|
|
count := count - 1;
|
|
disp := disp + itype^.size;
|
|
goto 3;
|
|
end; {if}
|
|
4:
|
|
end; {InitializeOneElement}
|
|
|
|
|
|
begin {AutoInit}
|
|
iPtr := variable^.iPtr;
|
|
if isCompoundLiteral then begin
|
|
treeCount := 0;
|
|
codeCount := 0;
|
|
ldoDispose := doDispose;
|
|
end {if}
|
|
else
|
|
ldoDispose := true;
|
|
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 lineNumber <> 0 then
|
|
RecordLineNumber(line);
|
|
while iPtr <> nil do begin
|
|
InitializeOneElement;
|
|
iPtr := iPtr^.next;
|
|
end; {while}
|
|
end; {if}
|
|
if isCompoundLiteral then begin
|
|
while treeCount > 1 do begin
|
|
Gen0t(pc_bno, cgVoid);
|
|
treeCount := treeCount - 1;
|
|
end; {while}
|
|
doDispose := lDoDispose;
|
|
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^.qualifiers := [];}
|
|
tp^.kind := arrayType;
|
|
tp^.aType := constCharPtr;
|
|
tp^.elements := len;
|
|
id := NewSymbol(@'__func__', tp, staticsy, variableSpace, initialized, false);
|
|
|
|
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^.isConstant := true;
|
|
iPtr^.basetype := cgString;
|
|
iPtr^.sval := sval;
|
|
id^.iPtr := iPtr;
|
|
|
|
table := lTable;
|
|
MakeFuncIdentifier := id;
|
|
end; {MakeFuncIdentifier}
|
|
|
|
|
|
function MakeCompoundLiteral{tp: typePtr): identPtr};
|
|
|
|
{ Make the identifier for a compound literal. }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - the type of the compound literal }
|
|
|
|
type
|
|
nameString = packed array [0..24] of char;
|
|
|
|
var
|
|
id: identPtr; {the identifier for the literal}
|
|
name: ^nameString; {the name for the identifier}
|
|
class: tokenEnum; {storage class}
|
|
|
|
begin {MakeCompoundLiteral}
|
|
if functionTable <> nil then
|
|
class := autosy
|
|
else
|
|
class := staticsy;
|
|
name := pointer(Malloc(25));
|
|
name^ := concat('~CompoundLiteral', cnvis(compoundLiteralNumber));
|
|
id := NewSymbol(name, tp, class, variableSpace, defined, false);
|
|
compoundLiteralNumber := compoundLiteralNumber + 1;
|
|
if compoundLiteralNumber = 0 then
|
|
Error(57);
|
|
Initializer(id);
|
|
MakeCompoundLiteral := id;
|
|
if class = autosy then begin
|
|
id^.lln := GetLocalLabel;
|
|
id^.clnext := compoundLiteralToAllocate;
|
|
compoundLiteralToAllocate := id;
|
|
end;
|
|
end; {MakeCompoundLiteral}
|
|
|
|
|
|
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}
|
|
compoundLiteralNumber := 1; {no compound literals yet}
|
|
compoundLiteralToAllocate := nil; {no compound literals needing space yet}
|
|
anonNumber := 0; {no anonymous structs/unions yet}
|
|
|
|
{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 + [pascalsy];
|
|
|
|
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.
|