ORCA-C/Parser.pas
Stephen Heumann 81934109fc Fix issues with type names in the third expression of a for loop.
There were a couple issues here:
*If the type name contained a semicolon (for struct/union member declarations), a spurious error would be reported.
*Tags or enumeration constants declared in the type name should be in scope within the loop, but were not.

These both stemmed from the way the parser handled the third expression, which was to save the tokens from it and re-inject them at the end of the loop. To get the scope issues right, the expression really needs to be evaluated at the point where it occurs, so we now do that. To enable that while still placing the code at the end of the loop, a mechanism to remove and re-insert sections of generated code is introduced.

Here is an example illustrating the issues:

int main(void) {
        int i, j, x;
        for (i = 0; i < 123; i += sizeof(struct {int a;}))
                for (j = 0; j < 123; j += sizeof(enum E {A,B,C}))
                        x = i + j + A;
}
2024-03-13 22:09:25 -05:00

4797 lines
177 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;
{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}
e3Code: codeRef; {code 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
e3Start: codeRef; {ref to start of code for expression 3}
forLoop, continueLab, breakLab: integer; {branch points}
stPtr: statementPtr; {work pointer}
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);
e3Start := GetCodeLocation; {generate and save code for expression 3}
if token.kind <> rparench then begin
Expression(normalExpression, [rparench]);
Gen0t(pc_pop, UsualUnaryConversions);
end; {if}
stPtr^.e3Code := RemoveCode(e3Start);
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
stPtr: statementPtr; {work pointer}
begin {EndForStatement}
if c99Scope then PopTable;
stPtr := statementList;
Gen1(dc_lab, stPtr^.continueLab); {define the continue label}
InsertCode(stPtr^.e3Code); {insert code for expression 3}
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}