mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-09-10 11:54:44 +00:00
4fe9c90942
This accords with its definition in the C standards. For the time being, the old form of three separate tokens is still accepted too, because the ... token may not be scanned correctly in the obscure case where there is a line continuation between the second and third dots. One observable effect of this is that there are no longer spaces between the dots in #pragma expand output.
4849 lines
178 KiB
ObjectPascal
4849 lines
178 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: integer;
|
|
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
|
|
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}
|
|
skipDeclarator: boolean; {for enum,struct,union with no declarator}
|
|
statementList: statementPtr; {list of open statements}
|
|
savedVolatile: boolean; {saved copy of volatile}
|
|
doingForLoopClause1: boolean; {doing the first clause of a for loop?}
|
|
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?}
|
|
|
|
{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;
|
|
|
|
{-- 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 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 ,
|
|
pointerType : Gen0t(pc_ret, cgULong);
|
|
functionType: ;
|
|
enumConst : ;
|
|
enumType : Gen0t(pc_ret, cgWord);
|
|
definedType : ;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
Gen0 (dc_enp); {finish the segment}
|
|
CheckGotoList; {make sure all labels are declared}
|
|
while tempList <> nil do begin {dump the local labels}
|
|
tl := tempList;
|
|
tempList := tl^.next;
|
|
dispose(tl);
|
|
end; {while}
|
|
dumpLocal := true; {dump the local pool}
|
|
nameFound := false; {no pc_nam for the next function (yet)}
|
|
volatile := savedVolatile; {local volatile vars are out of scope}
|
|
fIsNoreturn := false; {not doing a noreturn function}
|
|
functionTable := nil;
|
|
functionName := nil;
|
|
end; {if}
|
|
PopTable; {remove this symbol table}
|
|
fenvAccess := stPtr^.lFenvAccess; {restore old value of fenvAccess}
|
|
dispose(stPtr); {dump the record}
|
|
if dumpLocal then begin
|
|
useGlobalPool := true; {start using the global memory pool}
|
|
LInit; {dispose of the local memory pool}
|
|
end; {if}
|
|
NextToken; {remove the rbracech token}
|
|
end; {EndCompoundStatement}
|
|
|
|
|
|
procedure RecordLineNumber (lineNumber: integer);
|
|
|
|
{ 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, lineNumber, ord(debugType), pointer(newSourceFileGS));
|
|
changedSourceFile := false;
|
|
end {if}
|
|
else
|
|
Gen2Name(pc_lnm, 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}
|
|
tk: tokenType; {structure name token}
|
|
|
|
begin {ReturnStatement}
|
|
if fIsNoreturn then
|
|
if (lint & lintReturn) <> 0 then
|
|
Error(153);
|
|
NextToken; {skip the 'return' token}
|
|
if token.kind <> semicolonch then {if present, evaluate the return value}
|
|
begin
|
|
if fType^.kind in [structType,unionType] then begin
|
|
tk.kind := ident;
|
|
tk.class := identifier;
|
|
tk.name := @'@struct';
|
|
tk.symbolPtr := nil;
|
|
id := FindSymbol(tk, variableSpace, false, true);
|
|
Gen1Name(pc_lao, 0, id^.name);
|
|
size := fType^.size;
|
|
end {if}
|
|
else if fType^.kind = scalarType then
|
|
if fType^.baseType in [cgQuad,cgUQuad] then
|
|
Gen2t(pc_lod, 0, 0, cgULong);
|
|
Expression(normalExpression, [semicolonch]);
|
|
AssignmentConversion(fType, expressionType, lastWasConst, lastConst,
|
|
true, false);
|
|
case fType^.kind of
|
|
scalarType: if fType^.baseType in [cgQuad,cgUQuad] then
|
|
Gen0t(pc_sto, fType^.baseType)
|
|
else
|
|
Gen2t(pc_str, 0, 0, fType^.baseType);
|
|
enumType: Gen2t(pc_str, 0, 0, cgWord);
|
|
pointerType: Gen2t(pc_str, 0, 0, cgULong);
|
|
structType,
|
|
unionType: begin
|
|
Gen2(pc_mov, long(size).msw, long(size).lsw);
|
|
Gen0t(pc_pop, cgULong);
|
|
end;
|
|
otherwise: ;
|
|
end; {case}
|
|
end {if}
|
|
else begin
|
|
if (fType^.kind <> scalarType) or (fType^.baseType <> cgVoid) then
|
|
if ((lint & lintC99Syntax) <> 0) or ((lint & lintReturn) <> 0) then
|
|
Error(152);
|
|
end; {else}
|
|
Gen1(pc_ujp, returnLabel); {branch to the exit point}
|
|
Match(semicolonch, 22); {insist on a closing ';'}
|
|
end; {ReturnStatement}
|
|
|
|
|
|
procedure SwitchStatement;
|
|
|
|
{ handle a switch statement }
|
|
|
|
var
|
|
stPtr: statementPtr; {work pointer}
|
|
tp: typePtr; {for checking type}
|
|
|
|
begin {SwitchStatement}
|
|
NextToken; {skip the 'switch' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := switchSt;
|
|
stPtr^.maxVal := -maxint4;
|
|
stPtr^.labelCount := 0;
|
|
stPtr^.switchLab := GenLabel;
|
|
stPtr^.switchExit := GenLabel;
|
|
stPtr^.breakLab := stPtr^.switchExit;
|
|
stPtr^.switchList := nil;
|
|
stPtr^.switchDefault := 0;
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression,[rparench]);
|
|
Match(rparench, 12);
|
|
tp := expressionType; {make sure the expression is integral}
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
case tp^.kind of
|
|
|
|
scalarType:
|
|
if tp^.baseType in [cgQuad,cgUQuad] then begin
|
|
stPtr^.size := cgQuadSize;
|
|
stPtr^.ln := GetTemp(cgQuadSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgQuad);
|
|
end {if}
|
|
else if tp^.baseType in [cgLong,cgULong] then begin
|
|
stPtr^.size := cgLongSize;
|
|
stPtr^.ln := GetTemp(cgLongSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgLong);
|
|
end {if}
|
|
else if tp^.baseType in [cgByte,cgUByte,cgWord,cgUWord] then begin
|
|
stPtr^.size := cgWordSize;
|
|
stPtr^.ln := GetTemp(cgWordSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgWord);
|
|
end {else if}
|
|
else
|
|
Error(71);
|
|
|
|
enumType: begin
|
|
stPtr^.size := cgWordSize;
|
|
stPtr^.ln := GetTemp(cgWordSize);
|
|
Gen2t(pc_str, stPtr^.ln, 0, cgWord);
|
|
end;
|
|
|
|
otherwise:
|
|
Error(71);
|
|
end; {case}
|
|
Gen1(pc_ujp, stPtr^.switchLab); {branch to the xjp instruction}
|
|
if c99Scope then PushTable;
|
|
Statement; {process the loop body statement}
|
|
end; {SwitchStatement}
|
|
|
|
|
|
procedure WhileStatement;
|
|
|
|
{ handle a while statement }
|
|
|
|
var
|
|
lType: typePtr; {type of "left" expression}
|
|
stPtr: statementPtr; {work pointer}
|
|
top, endl: integer; {branch points}
|
|
|
|
begin {WhileStatement}
|
|
NextToken; {skip the 'while' token}
|
|
new(stPtr); {create a statement record}
|
|
stPtr^.next := statementList;
|
|
statementList := stPtr;
|
|
stPtr^.kind := whileSt;
|
|
top := GenLabel; {create the branch labels}
|
|
endl := GenLabel;
|
|
stPtr^.whileTop := top;
|
|
stPtr^.whileEnd := endl;
|
|
stPtr^.breakLab := endl;
|
|
stPtr^.continueLab := top;
|
|
Gen1(dc_lab, top); {define the top label}
|
|
if c99Scope then PushTable;
|
|
Match(lparench, 13); {evaluate the condition}
|
|
Expression(normalExpression, [rparench]);
|
|
Match(rparench, 12);
|
|
CompareToZero(pc_neq); {evaluate the condition}
|
|
Gen1(pc_fjp, endl);
|
|
if c99Scope then PushTable;
|
|
Statement; {process the first loop body statement}
|
|
end; {WhileStatement}
|
|
|
|
begin {Statement}
|
|
1:
|
|
{if trace names are enabled and a line # is due, generate it}
|
|
if traceBack or debugFlag then
|
|
if nameFound or debugFlag then
|
|
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);
|
|
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);
|
|
ltoken.kind := semicolonch;
|
|
ltoken.class := reservedSymbol;
|
|
PutBackToken(ltoken, false);
|
|
while tl <> nil do begin
|
|
PutBackToken(tl^.token, false);
|
|
tk := tl;
|
|
tl := tl^.next;
|
|
dispose(tk);
|
|
end; {while}
|
|
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?}
|
|
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}
|
|
firstIteration: boolean; {first iteration of type-unstacking loop?}
|
|
|
|
{for checking function compatibility}
|
|
{-----------------------------------}
|
|
checkParms: boolean; {do we need to do type checking on the parm?}
|
|
compatible: boolean; {are the parameters compatible?}
|
|
ftoken: tokenType; {for checking extern functions}
|
|
p1,p2,p3: parameterPtr; {used to trace parameter lists}
|
|
pt1,pt2: typePtr; {parameter types}
|
|
t1: typePtr; {function type}
|
|
tk1,tk2: typeKind; {parameter type kinds}
|
|
unnamedParm: boolean; {is this an unnamed prototype?}
|
|
|
|
|
|
procedure StackDeclarations;
|
|
|
|
{ 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}
|
|
luseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions}
|
|
|
|
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);
|
|
NextToken;
|
|
tPtr2^.prototyped := true;
|
|
end
|
|
else begin
|
|
PutBackToken(token, false);
|
|
token.kind := voidsy;
|
|
token.class := reservedSymbol;
|
|
end; {else}
|
|
end; {if}
|
|
{see if we are doing a prototyped list}
|
|
if token.kind in declarationSpecifiersElement then begin
|
|
{handle a prototype variable list}
|
|
numberOfParameters := 0; {don't allow K&R parm declarations}
|
|
luseGlobalPool := useGlobalPool; {use global memory}
|
|
useGlobalPool := true;
|
|
done2 := false;
|
|
lisFunction := isFunction; {preserve global variables}
|
|
with tPtr2^ do begin
|
|
prototyped := true; {it is prototyped}
|
|
repeat {collect the declarations}
|
|
if token.kind in declarationSpecifiersElement then begin
|
|
lLastParameter := lastParameter;
|
|
DoDeclaration(true);
|
|
lastParameter := lLastParameter;
|
|
if protoType <> nil then begin
|
|
wp := pointer(Malloc(sizeof(parameterRecord)));
|
|
wp^.next := parameterList;
|
|
parameterList := wp;
|
|
wp^.parameter := protoVariable;
|
|
wp^.parameterType := protoType;
|
|
if protoVariable <> nil then begin
|
|
protoVariable^.pnext := lastParameter;
|
|
lastParameter := protoVariable;
|
|
end; {if}
|
|
end; {if}
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = dotdotdotsy then begin
|
|
NextToken;
|
|
varargs := true;
|
|
done2 := true;
|
|
end {if}
|
|
else if token.kind = dotch then begin
|
|
NextToken;
|
|
Match(dotch,89);
|
|
Match(dotch,89);
|
|
varargs := true;
|
|
done2 := true;
|
|
end; {else 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}
|
|
useGlobalPool := luseGlobalPool;
|
|
end {if prototype}
|
|
else if token.kind = ident then begin
|
|
|
|
{handle a K&R variable list}
|
|
if (lint & lintNotPrototyped) <> 0 then
|
|
Error(105);
|
|
if doingFunction or doingPrototypes then
|
|
Error(12)
|
|
else begin
|
|
numberOfParameters := 0; {no function parms yet}
|
|
end; {else}
|
|
repeat {make a list of parameters}
|
|
if not doingFunction then begin
|
|
if token.kind <> ident then begin
|
|
Error(9);
|
|
while not (token.kind in [rparench,commach,ident]) do
|
|
NextToken;
|
|
end; {if}
|
|
if token.kind = ident then begin
|
|
pvar := NewSymbol(token.name, nil, ident, variableSpace,
|
|
declared);
|
|
pvar^.storage := parameter;
|
|
pvar^.pnext := lastParameter;
|
|
lastParameter := pvar;
|
|
numberOfParameters := numberOfParameters+1;
|
|
pvar^.bitdisp := numberOfParameters;
|
|
NextToken;
|
|
end; {if}
|
|
end; {if}
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
done := false;
|
|
end {if}
|
|
else
|
|
done := true;
|
|
until done or (token.kind = eofsy);
|
|
end {else if}
|
|
else if (lint & lintNotPrototyped) <> 0 then
|
|
if not tPtr2^.prototyped then
|
|
Error(105);
|
|
Match(rparench,12); {insist on a closing ')' token}
|
|
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;
|
|
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}
|
|
firstIteration := true;
|
|
while typeStack <> nil do begin {reverse the type stack}
|
|
tsPtr := typeStack;
|
|
typeStack := tsPtr^.next;
|
|
if isFunction and (not useGlobalPool) then begin
|
|
tPtr2 := pointer(GMalloc(sizeof(typeRecord)));
|
|
tPtr2^ := tsPtr^.typeDef^;
|
|
tPtr2^.saveDisp := 0;
|
|
end {if}
|
|
else
|
|
tPtr2 := tsPtr^.typeDef;
|
|
dispose(tsPtr);
|
|
if tPtr^.kind = functionType then
|
|
if not firstIteration then
|
|
PopTable; {balance push in StackDeclarations}
|
|
case tPtr2^.kind of
|
|
pointerType: begin
|
|
tPtr2^.pType := tPtr;
|
|
end;
|
|
functionType: begin
|
|
while tPtr^.kind = definedType do
|
|
tPtr := tPtr^.dType;
|
|
tPtr2^.fType := 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;
|
|
firstIteration := false;
|
|
end; {while}
|
|
|
|
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
|
|
if pascalsy in declSpecifiers.declarationModifiers then begin
|
|
{reverse the parameter list}
|
|
p2 := tptr^.parameterList;
|
|
p1 := nil;
|
|
while p2 <> nil do begin
|
|
p3 := p2;
|
|
p2 := p2^.next;
|
|
p3^.next := p1;
|
|
p1 := p3;
|
|
end; {while}
|
|
tPtr^.parameterList := p1;
|
|
end; {if}
|
|
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:
|
|
if pascalsy in declSpecifiers.declarationModifiers then begin
|
|
{reverse the parameter list}
|
|
p2 := tptr^.parameterList;
|
|
p1 := nil;
|
|
while p2 <> nil do begin
|
|
p3 := p2;
|
|
p2 := p2^.next;
|
|
p3^.next := p1;
|
|
p1 := p3;
|
|
end; {while}
|
|
tPtr^.parameterList := p1;
|
|
end; {if}
|
|
end; {if}
|
|
end; {if}
|
|
if tPtr^.kind = functionType then
|
|
state := declared;
|
|
if newName <> nil then {declare the variable}
|
|
variable := NewSymbol(newName, tPtr, declSpecifiers.storageClass, space, state)
|
|
else if unnamedParm then
|
|
variable^.itype := tPtr
|
|
else begin
|
|
if token.kind <> semicolonch then
|
|
Error(9);
|
|
variable := nil;
|
|
end; {else}
|
|
if variable <> nil then begin
|
|
if parameterStorage then
|
|
variable^.storage := parameter;
|
|
if isForwardDeclared then begin {handle forward declarations}
|
|
tPtr := variable^.itype;
|
|
lastWasPointer := false;
|
|
while tPtr^.kind in
|
|
[pointerType,arrayType,functionType,definedType] do begin
|
|
if tPtr^.kind = pointerType then
|
|
lastWasPointer := true
|
|
else if tPtr^.kind <> definedType then
|
|
lastWasPointer := false;
|
|
tPtr := tPtr^.pType;
|
|
end; {while}
|
|
if ((tPtr <> 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
|
|
bitcount: integer; {# if bits initialized}
|
|
bitvalue: longint; {bit field initializer value}
|
|
done: boolean; {for loop termination}
|
|
errorFound: boolean; {used to remove bad initializations}
|
|
iPtr,jPtr,kPtr: initializerPtr; {for reversing the list}
|
|
ip: identList; {used to place an id in the list}
|
|
luseGlobalPool: boolean; {local copy of useGlobalPool}
|
|
|
|
|
|
procedure InitializeBitField;
|
|
|
|
{ If bit fields have been initialized, fill them in }
|
|
{ }
|
|
{ Inputs: }
|
|
{ bitcount - # of bits initialized }
|
|
{ bitvalue - value of initializer }
|
|
|
|
var
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
|
|
begin {InitializeBitField}
|
|
if bitcount <> 0 then begin {skip if there has been no initializer}
|
|
{ writeln('InitializeBitField; bitcount = ', bitcount:1); {debug}
|
|
{create the initializer entry}
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
iPtr^.iVal := bitvalue;
|
|
if bitcount <= 8 then
|
|
iPtr^.itype := cgUByte
|
|
else if bitcount <= 16 then
|
|
iPtr^.itype := cgUWord
|
|
else if bitcount > 24 then
|
|
iPtr^.itype := cgULong
|
|
else begin {3-byte bitfield: split into two parts}
|
|
iPtr^.itype := cgUWord;
|
|
iPtr^.iVal := bitvalue & $0000FFFF;
|
|
bitcount := bitcount - 16;
|
|
bitvalue := bitvalue >> 16;
|
|
InitializeBitField;
|
|
end;
|
|
bitcount := 0; {reset the bit field values}
|
|
bitvalue := 0;
|
|
end; {if}
|
|
end; {InitializeBitField}
|
|
|
|
|
|
procedure GetInitializerValue (tp: typePtr; bitsize,bitdisp: integer);
|
|
|
|
{ get the value of an initializer from a single expression }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type of the variable being initialized }
|
|
{ bitsize - size of bit field (0 for non-bit fields) }
|
|
{ bitdisp - disp of bit field; unused if bitsize = 0 }
|
|
|
|
label 1,2,3;
|
|
|
|
var
|
|
bitmask: longint; {used to add a value to a bit field}
|
|
bKind: baseTypeEnum; {type of constant}
|
|
etype: typePtr; {expression type}
|
|
i: integer; {loop variable}
|
|
ip: identPtr; {ident in pointer constant}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
kind: tokenEnum; {kind of constant}
|
|
offset, offset2: longint; {integer offset from a pointer}
|
|
operator: tokenEnum; {operator for constant pointers}
|
|
tKind: typeKind; {type of constant}
|
|
tree: tokenPtr; {for evaluating pointer constants}
|
|
|
|
|
|
function Subscript (tree: tokenPtr): typePtr;
|
|
|
|
{ handle subscripts in a pointer constant }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - subscript operators }
|
|
{ }
|
|
{ returns: type of the variable }
|
|
{ }
|
|
{ variables: }
|
|
{ iPtr - initializer location to store the array name }
|
|
{ offset - bytes past the start of the array }
|
|
|
|
var
|
|
ip: identPtr; {ident pointer}
|
|
rtree: tokenPtr; {work pointer}
|
|
tp: typePtr; {for tracking types}
|
|
select: longint; {selector size}
|
|
size: longint; {subscript value}
|
|
|
|
begin {Subscript}
|
|
if tree^.token.kind = uasterisk then begin
|
|
tree := tree^.left;
|
|
if tree^.token.kind = plusch then begin
|
|
rtree := tree^.right;
|
|
if rtree^.token.kind in
|
|
[intconst,uintconst,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 token.kind in [dotch,lbrackch] then begin
|
|
{designated initializer: give error and skip over it}
|
|
Error(150);
|
|
while token.kind in [dotch,lbrackch] do begin
|
|
if token.kind = lbrackch then begin
|
|
NextToken;
|
|
Expression(arrayExpression, [rbrackch]);
|
|
if token.kind = rbrackch then
|
|
NextToken;
|
|
end {if}
|
|
else {if token.kind = dotch then} begin
|
|
NextToken;
|
|
if token.kind in [ident,typedef] then
|
|
NextToken;
|
|
end {if}
|
|
end; {while}
|
|
if token.kind = eqch then
|
|
NextToken;
|
|
end; {if}
|
|
if variable^.storage = stackFrame then
|
|
Expression(autoInitializerExpression, [commach,rparench,rbracech])
|
|
else
|
|
Expression(initializerExpression, [commach,rparench,rbracech]);
|
|
if bitsize = 0 then begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
end; {if}
|
|
etype := expressionType;
|
|
AssignmentConversion(tp, expressionType, isConstant, expressionValue,
|
|
false, false);
|
|
if variable^.storage = external then
|
|
variable^.storage := global;
|
|
if isConstant and (variable^.storage in [external,global,private]) then begin
|
|
if bitsize = 0 then begin
|
|
if etype^.baseType in [cgQuad,cgUQuad] then begin
|
|
iPtr^.qVal := llExpressionValue;
|
|
end {if}
|
|
else begin
|
|
iPtr^.qval.hi := 0;
|
|
iPtr^.iVal := expressionValue;
|
|
end; {else}
|
|
iPtr^.itype := tp^.baseType;
|
|
InitializeBitField;
|
|
end; {if}
|
|
case tp^.kind of
|
|
|
|
scalarType: begin
|
|
bKind := tp^.baseType;
|
|
if (etype^.baseType in [cgByte..cgULong,cgQuad,cgUQuad])
|
|
and (bKind in [cgByte..cgULong,cgQuad,cgUQuad]) then begin
|
|
if bKind in [cgLong,cgULong,cgQuad,cgUQuad] then
|
|
if eType^.baseType = cgUByte then
|
|
iPtr^.iVal := iPtr^.iVal & $000000FF
|
|
else if eType^.baseType = cgUWord then
|
|
iPtr^.iVal := iPtr^.iVal & $0000FFFF;
|
|
if bKind in [cgQuad,cgUQuad] then
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
if (etype^.baseType in [cgByte,cgWord,cgLong])
|
|
and (iPtr^.iVal < 0) then
|
|
iPtr^.qVal.hi := -1
|
|
else
|
|
iPtr^.qVal.hi := 0;
|
|
goto 3;
|
|
end; {if}
|
|
if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
iPtr^.rVal := expressionValue
|
|
else if etype^.baseType in
|
|
[cgReal,cgDouble,cgComp,cgExtended] then
|
|
iPtr^.rval := realExpressionValue;
|
|
goto 3;
|
|
end; {if}
|
|
Error(47);
|
|
errorFound := true;
|
|
goto 2;
|
|
|
|
3: if bitsize <> 0 then begin
|
|
|
|
{set up a bit field value}
|
|
if bitdisp < bitcount then
|
|
InitializeBitField;
|
|
bitmask := 0;
|
|
for i := 1 to bitsize do
|
|
bitmask := (bitmask << 1) | 1;
|
|
bitmask := bitmask & expressionValue;
|
|
for i := 1 to bitdisp do
|
|
bitmask := bitmask << 1;
|
|
bitvalue := bitvalue | bitmask;
|
|
bitcount := bitcount + bitsize;
|
|
end; {if}
|
|
end;
|
|
|
|
arrayType: begin
|
|
if tp^.aType^.kind = scalarType then
|
|
if tp^.aType^.baseType in [cgByte,cgUByte] then
|
|
if eType^.baseType = cgString then
|
|
goto 2;
|
|
Error(46);
|
|
errorFound := true;
|
|
end;
|
|
|
|
pointerType:
|
|
if (etype = stringTypePtr) or (etype = utf16StringTypePtr)
|
|
or (etype = utf32StringTypePtr) then begin
|
|
iPtr^.isConstant := true;
|
|
iPtr^.iType := ccPointer;
|
|
iPtr^.pval := 0;
|
|
iPtr^.pPlus := false;
|
|
iPtr^.isName := false;
|
|
iPtr^.pStr := longstringPtr(expressionValue);
|
|
end {if}
|
|
else if etype^.kind = scalarType then
|
|
if etype^.baseType in [cgByte..cgULong] then
|
|
if expressionValue = 0 then
|
|
iPtr^.iType := cgULong
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end {else}
|
|
else if etype^.baseType in [cgQuad,cgUQuad] then
|
|
if (llExpressionValue.hi = 0) and
|
|
(llExpressionValue.lo = 0) then
|
|
iPtr^.iType := cgULong
|
|
else begin
|
|
Error(47);
|
|
errorFound := true;
|
|
end {else}
|
|
else begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end {else}
|
|
else if etype^.kind = pointerType then begin
|
|
iPtr^.iType := cgULong;
|
|
iPtr^.pval := expressionValue;
|
|
end {else if}
|
|
else begin
|
|
Error(48);
|
|
errorFound := true;
|
|
end; {else}
|
|
|
|
structType,unionType,enumType: begin
|
|
Error(46);
|
|
errorFound := true;
|
|
end;
|
|
|
|
otherwise:
|
|
Error(57);
|
|
|
|
end; {case}
|
|
2: DisposeTree(initializerTree);
|
|
end {if}
|
|
else begin
|
|
if ((tp^.kind = pointerType)
|
|
or ((tp^.kind = scalarType) and (tp^.baseType in [cgLong,cgULong])))
|
|
and (bitsize = 0)
|
|
then begin
|
|
iPtr^.iType := ccPointer;
|
|
if variable^.storage in [external,global,private] then begin
|
|
|
|
{do pointer constants with + or -}
|
|
iPtr^.isConstant := true;
|
|
tree := initializerTree;
|
|
while tree^.token.kind = castoper do
|
|
tree := tree^.left;
|
|
offset := 0;
|
|
operator := tree^.token.kind;
|
|
while operator in [plusch,minusch] do begin
|
|
with tree^.right^.token do
|
|
if kind in [intConst,uintconst,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}
|
|
else if tp^.kind in [structType,unionType] then
|
|
iPtr^.isStructOrUnion := true;
|
|
|
|
{handle auto variables}
|
|
if bitsize <> 0 then begin
|
|
iPtr := pointer(Malloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := isConstant;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := bitdisp;
|
|
iPtr^.bitsize := bitsize;
|
|
iPtr^.isStructOrUnion := false;
|
|
end; {if}
|
|
if variable^.storage in [external,global,private] then begin
|
|
Error(41);
|
|
errorFound := true;
|
|
end; {else}
|
|
iPtr^.isConstant := false;
|
|
iPtr^.iTree := initializerTree;
|
|
iPtr^.bitdisp := bitdisp;
|
|
iPtr^.bitsize := bitsize;
|
|
end; {else}
|
|
1:
|
|
end; {GetInitializerValue}
|
|
|
|
|
|
procedure InitializeTerm (tp: typePtr; bitsize,bitdisp: integer;
|
|
main: boolean);
|
|
|
|
{ initialize one level of the type }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - pointer to the type being initialized }
|
|
{ bitsize - size of bit field (0 for non-bit fields) }
|
|
{ bitdisp - disp of bit field; unused if bitsize = 0 }
|
|
{ main - is this a call from the main level? }
|
|
|
|
var
|
|
bitCount: integer; {# of bits in a union}
|
|
braces: boolean; {is the initializer inclosed in braces?}
|
|
count,maxCount: longint; {for tracking the size of an initializer}
|
|
ep: tokenPtr; {for forming string expression}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
ip: identPtr; {for tracing field lists}
|
|
kind: typeKind; {base type of an initializer}
|
|
ktp: typePtr; {array type with definedTypes removed}
|
|
lSuppressMacroExpansions: boolean;{local copy of suppressMacroExpansions}
|
|
stringElementType: typePtr; {element type of string literal}
|
|
stringLength: integer; {elements in a string literal}
|
|
|
|
|
|
procedure Fill (count: longint; tp: typePtr);
|
|
|
|
{ fill in unspecified space in an initialized array with 0 }
|
|
{ }
|
|
{ parameters: }
|
|
{ count - ^ elements of this type to create }
|
|
{ tp - ptr to type of elements to create }
|
|
|
|
var
|
|
i: longint; {loop variable}
|
|
iPtr: initializerPtr; {for creating an initializer entry}
|
|
tk: tokenPtr; {expression record}
|
|
ip: identPtr; {pointer to next field in a structure}
|
|
|
|
begin {Fill}
|
|
{ writeln('Fill tp^.kind = ', ord(tp^.kind):1, '; count = ', count:1); {debug}
|
|
InitializeBitField; {if needed, do the bit field}
|
|
if tp^.kind = arrayType then
|
|
|
|
{fill an array}
|
|
Fill(count*tp^.elements ,tp^.aType)
|
|
else if tp^.kind = structType then begin
|
|
|
|
{fill a structure}
|
|
if variable^.storage in [external,global,private] then
|
|
Fill(count * tp^.size, sCharPtr)
|
|
else begin
|
|
i := count;
|
|
while i <> 0 do begin
|
|
ip := tp^.fieldList;
|
|
while ip <> nil do begin
|
|
Fill(1, ip^.iType);
|
|
ip := ip^.next;
|
|
end; {while}
|
|
i := i-1;
|
|
end; {while}
|
|
end; {else}
|
|
end {else if}
|
|
else if tp^.kind = unionType then begin
|
|
|
|
{fill a union}
|
|
if variable^.storage in [external,global,private] then
|
|
Fill(count * tp^.size, sCharPtr)
|
|
else
|
|
Fill(count, tp^.fieldList^.iType);
|
|
end {else if}
|
|
else
|
|
|
|
{fill a single value}
|
|
while count <> 0 do begin
|
|
iPtr := pointer(Calloc(sizeof(initializerRecord)));
|
|
iPtr^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.isConstant := variable^.storage in [external,global,private];
|
|
{iPtr^.bitdisp := 0;}
|
|
{iPtr^.bitsize := 0;}
|
|
{iPtr^.isStructOrUnion := false;}
|
|
if iPtr^.isConstant then begin
|
|
if tp^.kind = scalarType then
|
|
iPtr^.itype := tp^.baseType
|
|
else if tp^.kind = pointertype then begin
|
|
iPtr^.itype := cgULong;
|
|
{iPtr^.iVal := 0;}
|
|
end {else if}
|
|
else begin
|
|
iPtr^.itype := cgWord;
|
|
Error(47);
|
|
errorFound := true;
|
|
end; {else}
|
|
end {if}
|
|
else begin
|
|
new(tk);
|
|
tk^.next := nil;
|
|
tk^.left := nil;
|
|
tk^.middle := nil;
|
|
tk^.right := nil;
|
|
tk^.token.kind := intconst;
|
|
tk^.token.class := intConstant;
|
|
tk^.token.ival := 0;
|
|
iPtr^.iTree := tk;
|
|
end; {else}
|
|
if count < 16384 then begin
|
|
iPtr^.count := long(count).lsw;
|
|
count := 0;
|
|
end {if}
|
|
else begin
|
|
iPtr^.count := 16384;
|
|
count := count-16384;
|
|
end; {else}
|
|
end; {while}
|
|
end; {Fill}
|
|
|
|
|
|
procedure RecomputeSizes (tp: typePtr);
|
|
|
|
{ a size has been inferred from an initializer - set the }
|
|
{ appropriate type size values }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type to check }
|
|
|
|
begin {RecomputeSizes}
|
|
if tp^.aType^.kind = arrayType then
|
|
RecomputeSizes(tp^.aType);
|
|
with tp^ do
|
|
size := aType^.size*elements;
|
|
end; {RecomputeSizes}
|
|
|
|
begin {InitializeTerm}
|
|
braces := false; {allow for an opening brace}
|
|
if token.kind = lbracech then begin
|
|
NextToken;
|
|
braces := true;
|
|
end; {if}
|
|
|
|
{handle arrays}
|
|
while tp^.kind = definedType do
|
|
tp := tp^.dType;
|
|
kind := tp^.kind;
|
|
if kind = arrayType then begin
|
|
ktp := tp^.atype;
|
|
while ktp^.kind = definedType do
|
|
ktp := ktp^.dType;
|
|
kind := ktp^.kind;
|
|
|
|
{handle string constants}
|
|
if token.kind = stringConst then
|
|
stringElementType := StringType(token.prefix)^.aType;
|
|
if (token.kind = stringConst) and (kind = scalarType) and
|
|
(((ktp^.baseType in [cgByte,cgUByte])
|
|
and (stringElementType = charPtr))
|
|
or CompTypes(ktp,stringElementType)) 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^.next := variable^.iPtr;
|
|
variable^.iPtr := iPtr;
|
|
iPtr^.count := 1;
|
|
iPtr^.bitdisp := 0;
|
|
iPtr^.bitsize := 0;
|
|
iPtr^.isStructOrUnion := false;
|
|
if (variable^.storage in [external,global,private]) then begin
|
|
iPtr^.isConstant := true;
|
|
iPtr^.itype := cgString;
|
|
iPtr^.sval := token.sval;
|
|
count := tp^.elements - stringLength;
|
|
if count > 0 then
|
|
Fill(count, stringElementType)
|
|
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; |