mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-30 14:31:04 +00:00
2958619726
Varargs-only stack repair (i.e. using #pragma optimize bit 3 but not bit 6) was broken by commit32975b720f. It removed some code that was needed to allocate the direct page location used to hold the stack pointer value in that case. This would lead to invalid code being produced, which could cause a crash when run. The fix is to revert the erroneous parts of commit32975b720f(which do not affect its core purpose of enabling intermediate code peephole optimization to be used when stack repair code is active).
4843 lines
179 KiB
ObjectPascal
4843 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}
|
|
lType: typePtr; {type of "left" expression}
|
|
parencount: integer; {number of unmatched '(' chars}
|
|
stPtr: statementPtr; {work pointer}
|
|
tl,tk: tokenStackPtr; {for forming expression list}
|
|
|
|
begin {ForStatement}
|
|
NextToken; {skip the 'for' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := forSt;
|
|
forLoop := GenLabel; {create the branch labels}
|
|
continueLab := GenLabel;
|
|
breakLab := GenLabel;
|
|
stPtr^.forLoop := forLoop;
|
|
stPtr^.continueLab := continueLab;
|
|
stPtr^.breakLab := breakLab;
|
|
|
|
if c99Scope then PushTable;
|
|
Match(lparench,13); {evaluate the start condition}
|
|
if allowMixedDeclarations and (token.kind in localDeclarationStart) then begin
|
|
doingForLoopClause1 := true;
|
|
DoDeclaration(false);
|
|
doingForLoopClause1 := false;
|
|
end {if}
|
|
else if token.kind <> semicolonch then begin
|
|
Expression(normalExpression, [semicolonch]);
|
|
Gen0t(pc_pop, UsualUnaryConversions);
|
|
Match(semicolonch,22);
|
|
end {else if}
|
|
else
|
|
NextToken;
|
|
|
|
Gen1(dc_lab, forLoop); {this label points to the condition}
|
|
if token.kind <> semicolonch then {handle the loop test}
|
|
begin {evaluate the expression}
|
|
Expression(normalExpression, [semicolonch]);
|
|
CompareToZero(pc_neq); {Evaluate the condition}
|
|
Gen1(pc_fjp, breakLab);
|
|
end; {if}
|
|
Match(semicolonch,22);
|
|
|
|
tl := nil; {collect the tokens for the last expression}
|
|
parencount := 0;
|
|
errorFound := false;
|
|
while (token.kind <> eofsy)
|
|
and ((token.kind <> rparench) or (parencount <> 0))
|
|
and (token.kind <> semicolonch) do begin
|
|
new(tk); {place the token in the list}
|
|
tk^.next := tl;
|
|
tl := tk;
|
|
tk^.token := token;
|
|
if token.kind = lparench then {allow parens in the expression}
|
|
parencount := parencount+1
|
|
else if token.kind = rparench then
|
|
parencount := parencount-1;
|
|
NextToken; {next token}
|
|
end; {while}
|
|
if errorFound then {if an error was found, dump the list}
|
|
while tl <> nil do begin
|
|
tk := tl;
|
|
tl := tl^.next;
|
|
dispose(tk);
|
|
end; {while}
|
|
stPtr^.e3List := tl; {save the list}
|
|
Match(rparench,12); {get the closing for loop paren}
|
|
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {ForStatement}
|
|
|
|
|
|
procedure IfStatement;
|
|
|
|
{ handle an if statement }
|
|
|
|
var
|
|
lab: integer; {branch label}
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {IfStatement}
|
|
NextToken; {skip the 'if' token}
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
|
|
lab := GenLabel; {create the branch label}
|
|
CompareToZero(pc_neq); {evaluate the condition}
|
|
Gen1(pc_fjp, lab);
|
|
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := ifSt;
|
|
stPtr^.ifLab := lab;
|
|
if c99Scope then PushTable;
|
|
Statement; {process the 'true' statement}
|
|
end; {IfStatement}
|
|
|
|
|
|
procedure GotoStatement;
|
|
|
|
{ handle a goto statement }
|
|
|
|
begin {GotoStatement}
|
|
NextToken; {skip the 'goto' token}
|
|
if token.kind in [ident,typedef] then begin
|
|
GotoLabel(pc_ujp); {jump to the label}
|
|
NextToken; {skip the token}
|
|
end {if}
|
|
else
|
|
Error(9); {flag the error}
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
end; {GotoStatement}
|
|
|
|
|
|
procedure LabelStatement;
|
|
|
|
{ handle a labeled statement }
|
|
|
|
begin {LabelStatement}
|
|
GotoLabel(dc_lab); {define the label}
|
|
NextToken; {skip the label}
|
|
if token.kind = colonch then {if present, skip the colon}
|
|
NextToken
|
|
else begin {bad statement - flag error and skip it}
|
|
Error(31);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {LabelStatement}
|
|
|
|
|
|
procedure ReturnStatement;
|
|
|
|
{ handle a return statement }
|
|
|
|
var
|
|
id: identPtr; {structure id}
|
|
size: longint; {size of the struct/union}
|
|
|
|
|
|
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
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
top, endl: integer; {branch points}
|
|
|
|
begin {WhileStatement}
|
|
NextToken; {skip the 'while' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := whileSt;
|
|
top := GenLabel; {create the branch labels}
|
|
endl := GenLabel;
|
|
stPtr^.whileTop := top;
|
|
stPtr^.whileEnd := endl;
|
|
stPtr^.breakLab := endl;
|
|
stPtr^.continueLab := top;
|
|
Gen1(dc_lab, top); {define the top label}
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
CompareToZero(pc_neq); {evaluate the condition}
|
|
Gen1(pc_fjp, endl);
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {WhileStatement}
|
|
|
|
begin {Statement}
|
|
1:
|
|
{if trace names are enabled and a line # is due, generate it}
|
|
if traceBack or debugFlag then
|
|
if nameFound or debugFlag then
|
|
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
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndDoStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {get the statement record}
|
|
if token.kind = whilesy then begin {if a while clause exists, process it}
|
|
NextToken; {skip the 'while' token}
|
|
if stPtr^.continueLab <> 0 then {create the continue label}
|
|
Gen1(dc_lab, stPtr^.continueLab);
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
CompareToZero(pc_equ); {evaluate the condition}
|
|
Gen1(pc_fjp, stPtr^.doLab);
|
|
Match(semicolonch, 22); {process the closing ';'}
|
|
end {if}
|
|
else
|
|
Error(30); {'while' expected}
|
|
if stPtr^.breakLab <> 0 then {create the break label}
|
|
Gen1(dc_lab, stPtr^.breakLab);
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndDoStatement}
|
|
|
|
|
|
procedure EndIfStatement;
|
|
|
|
{ finish off an if statement }
|
|
|
|
var
|
|
lab1,lab2: integer; {branch labels}
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndIfStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {get the label to branch to}
|
|
lab1 := stPtr^.ifLab;
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
|
|
if token.kind = elsesy then begin {if an else clause exists, process it}
|
|
NextToken; {skip 'else'}
|
|
lab2 := GenLabel; {create the branch label}
|
|
Gen1(pc_ujp, lab2); {branch past the else clause}
|
|
Gen1(dc_lab, lab1); {create label for if to branch to}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := elseSt;
|
|
stPtr^.elseLab := lab2;
|
|
if c99Scope then PushTable;
|
|
Statement; {evaluate the else clause}
|
|
end {if}
|
|
else begin
|
|
Gen1(dc_lab, lab1); {create label for if to branch to}
|
|
if c99Scope then PopTable;
|
|
end; {else}
|
|
end; {EndIfStatement}
|
|
|
|
|
|
procedure EndElseStatement;
|
|
|
|
{ finish off an else clause }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
|
|
begin {EndElseStatement}
|
|
if c99Scope then PopTable;
|
|
stPtr := statementList; {create the label to branch to}
|
|
Gen1(dc_lab, stPtr^.elseLab);
|
|
statementList := stPtr^.next; {pop the statement record}
|
|
dispose(stPtr);
|
|
if c99Scope then PopTable;
|
|
end; {EndElseStatement}
|
|
|
|
|
|
procedure EndForStatement;
|
|
|
|
{ finish off a for statement }
|
|
|
|
var
|
|
ltoken: tokenType; {for putting ; on stack}
|
|
stPtr: statementPtr; {work pointer}
|
|
tl,tk: tokenStackPtr; {for forming expression list}
|
|
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, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
Subscript := intPtr;
|
|
iPtr^.pName := @'?';
|
|
end {if}
|
|
else begin
|
|
Subscript := ip^.itype;
|
|
iPtr^.pName := ip^.name;
|
|
end; {else}
|
|
end {else if}
|
|
else 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, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
end {if}
|
|
else begin
|
|
tKind := ip^.itype^.kind;
|
|
if tKind = functionType then begin
|
|
if operator in [plusch,minusch] then begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {if}
|
|
end {if}
|
|
else if (tKind = arrayType)
|
|
and (ip^.storage in [external,global,private]) then begin
|
|
offset := offset*ip^.itype^.atype^.size;
|
|
end {else if}
|
|
else if tKind = pointerType then begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := true;
|
|
iPtr^.pName := ip^.name;
|
|
end; {if}
|
|
end {if}
|
|
else if kind = uand then begin
|
|
tree := tree^.left;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := true;
|
|
if tree^.token.kind = ident then begin
|
|
ip := FindSymbol(tree^.token, allSpaces, false, true);
|
|
if ip = nil then begin
|
|
Error(31);
|
|
errorFound := true;
|
|
end {if}
|
|
else
|
|
if ip^.storage in [external,global,private] then begin
|
|
offset := offset*ip^.itype^.size;
|
|
iPtr^.pName := ip^.name;
|
|
end {if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
tp := Subscript(tree);
|
|
if offset > 0 then
|
|
iPtr^.pPlus := true
|
|
else begin
|
|
iPtr^.pPlus := false;
|
|
offset := -offset;
|
|
end; {else}
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
end {else if}
|
|
else if kind in [dotch,uasterisk] then begin
|
|
iPtr^.isName := true;
|
|
tp := Subscript(tree);
|
|
if offset > 0 then
|
|
iPtr^.pPlus := true
|
|
else begin
|
|
iPtr^.pPlus := false;
|
|
offset := -offset;
|
|
end; {else}
|
|
iPtr^.pval := offset;
|
|
end {else if}
|
|
else if kind = stringConst then begin
|
|
iPtr^.pval := offset;
|
|
iPtr^.pPlus := true;
|
|
iPtr^.isName := false;
|
|
iPtr^.pStr := tree^.token.sval;
|
|
end {else if}
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
DisposeTree(initializerTree);
|
|
goto 1;
|
|
end; {if}
|
|
end; {if}
|
|
|
|
{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;
|
|
Match(semicolonch,22);
|
|
end {if}
|
|
else begin
|
|
Error(83);
|
|
SkipStatement;
|
|
end; {else}
|
|
end; {SegmentStatement}
|
|
|
|
|
|
function InPartialList (fName: stringPtr): boolean;
|
|
|
|
{ See if the function is in the partial compile list. }
|
|
{ }
|
|
{ If the function is in the list, the function name is }
|
|
{ removed from the list, and true is returned. If not, }
|
|
{ false is returned. }
|
|
{ }
|
|
{ parameters: }
|
|
{ fName - name of the function to check for }
|
|
|
|
label 1,2;
|
|
|
|
var
|
|
ch: char; {work character}
|
|
i,j: integer; {loop variable}
|
|
len: integer; {length of fName}
|
|
|
|
begin {InPartialList}
|
|
i := partialFileGS.theString.size; {strip trailing blanks}
|
|
while (i > 0) and (partialFileGS.theString.theString[i] = ' ') do begin
|
|
partialFileGS.theString.theString[i] := chr(0);
|
|
i := i-1;
|
|
end; {while}
|
|
while partialFileGS.theString.theString[1] = ' ' do {skip leading blanks}
|
|
for i := 1 to partialFileGS.theString.size do
|
|
partialFileGS.theString.theString[i] :=
|
|
partialFileGS.theString.theString[i+1];
|
|
InPartialList := true; {assume success}
|
|
i := 1; {scan the name list}
|
|
len := length(fName^);
|
|
while partialFileGS.theString.theString[i] <> chr(0) do begin
|
|
for j := 1 to len do begin
|
|
if partialFileGS.theString.theString[i+j-1] <> fName^[j] then
|
|
goto 1;
|
|
end; {for}
|
|
if partialFileGS.theString.theString[i+len] in [' ', chr(0)] then begin
|
|
|
|
{found a match - remove from list & return}
|
|
j := i+len;
|
|
while partialFileGS.theString.theString[j] = ' ' do
|
|
j := j+1;
|
|
repeat
|
|
ch := partialFileGS.theString.theString[j];
|
|
partialFileGS.theString.theString[i] := ch;
|
|
i := i+1;
|
|
j := j+1;
|
|
until ch = chr(0);
|
|
goto 2;
|
|
end; {if}
|
|
1: {no match - skip to next name}
|
|
while not (partialFileGS.theString.theString[i] in [chr(0), ' ']) do
|
|
i := i+1;
|
|
while partialFileGS.theString.theString[i] = ' ' do
|
|
i := i+1;
|
|
end; {while}
|
|
InPartialList := false; {no match found}
|
|
2:
|
|
end; {InPartialList}
|
|
|
|
|
|
procedure SkipFunction (isAsm: boolean);
|
|
|
|
{ Skip a function body for a partial compile }
|
|
{ }
|
|
{ Parameters: }
|
|
{ isAsm - are we compiling an asm function? }
|
|
|
|
var
|
|
braceCount: integer; {# of unmatched { chars}
|
|
|
|
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 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);
|
|
if doingPrototypes then
|
|
Error(88);
|
|
{allocate copy of incomplete array type,}
|
|
tp := variable^.itype; {so it can be completed by Initializer}
|
|
if (tp^.kind = arrayType) and (tp^.elements = 0) then begin
|
|
variable^.itype := pointer(Malloc(sizeof(typeRecord)));
|
|
variable^.itype^ := tp^;
|
|
variable^.itype^.saveDisp := 0;
|
|
end;
|
|
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.
|