mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-21 16:29:31 +00:00
10ca3bcc73
Global structs and unions with the const qualifier were not being generated in object files. This occurred because they were represented as having "defined types" and the code was not handling those types properly.
The following example demonstrated this problem:
const struct x { int i; } X = {9};
int main(void) {
return X.i;
}
1546 lines
52 KiB
ObjectPascal
1546 lines
52 KiB
ObjectPascal
{$optimize 7}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ Symbol Table }
|
|
{ }
|
|
{ Handle the symbol table. }
|
|
{ }
|
|
{ External Subroutines: }
|
|
{ }
|
|
{ CheckStaticFunctions - check for undefined functions }
|
|
{ CompTypes - Determine if the two types are compatible }
|
|
{ DoGlobals - declare the ~globals and ~arrays segments }
|
|
{ FindSymbol - locate a symbol in the symbol table }
|
|
{ GenParameters - Generate labels and space for the parameters }
|
|
{ GenSymbols - generate a symbol table for the debugger }
|
|
{ InitSymbol - initialize the symbol table handler }
|
|
{ NewSymbol - insert a new symbol in the symbol table }
|
|
{ PopTable - Pop a symbol table (remove definitions local to a }
|
|
{ block) }
|
|
{ PushTable - Create a new symbol table, pushing the old one }
|
|
{ ResolveForwardReference - resolve a forward reference }
|
|
{ }
|
|
{ External Variables: }
|
|
{ }
|
|
{ noDeclarations - have we declared anything at this level? }
|
|
{ table - current symbol table }
|
|
{ }
|
|
{ bytePtr - pointer to the base type for bytes }
|
|
{ uBytePtr - pointer to the base type for unsigned bytes }
|
|
{ wordPtr - pointer to the base type for words }
|
|
{ uWordPtr - pointer to the base type for unsigned words }
|
|
{ longPtr - pointer to the base type for long words }
|
|
{ uLongPtr - pointer to the base type for unsigned long words }
|
|
{ realPtr - pointer to the base type for reals }
|
|
{ doublePtr - pointer to the base type for double precision }
|
|
{ reals }
|
|
{ compPtr - pointer to the base type for comp reals }
|
|
{ extendedPtr - pointer to the base type for extended reals }
|
|
{ voidPtr - pointer to the base type for void }
|
|
{ voidPtrPtr - typeless pointer, for some type casting }
|
|
{ stringTypePtr - pointer to the base type for string }
|
|
{ constants }
|
|
{ defaultStruc - default for structures with errors }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit Symbol;
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
interface
|
|
|
|
uses CCommon, CGI, MM, Scanner;
|
|
|
|
{$segment 'CC'}
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
type
|
|
symbolTablePtr = ^symbolTable;
|
|
symbolTable = record {a symbol table}
|
|
{NOTE: the array of buckets must come first in the record!}
|
|
buckets: array[0..hashSize2] of identPtr; {hash buckets}
|
|
next: symbolTablePtr; {next symbol table}
|
|
staticNum: packed array[1..6] of char; {staticNum at start of table}
|
|
end;
|
|
|
|
var
|
|
noDeclarations: boolean; {have we declared anything at this level?}
|
|
table: symbolTablePtr; {current symbol table}
|
|
globalTable: symbolTablePtr; {global symbol table}
|
|
|
|
bytePtr,uBytePtr,wordPtr,uWordPtr, {base types}
|
|
longPtr,uLongPtr,realPtr,doublePtr,compPtr,extendedPtr,
|
|
stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure CheckStaticFunctions;
|
|
|
|
{ check for undefined functions }
|
|
|
|
|
|
function CompTypes (t1, t2: typePtr): boolean;
|
|
|
|
{ Determine if the two types are compatible }
|
|
|
|
|
|
procedure DoGlobals;
|
|
|
|
{ declare the ~globals and ~arrays segments }
|
|
|
|
|
|
function FindSymbol (var tk: tokenType; class: spaceType; oneLevel: boolean;
|
|
staticAllowed: boolean): identPtr;
|
|
|
|
{ locate a symbol in the symbol table }
|
|
{ }
|
|
{ parameters: }
|
|
{ tk - token record for the identifier to find }
|
|
{ class - the kind of variable space to search }
|
|
{ oneLevel - search one level only? (used to check for }
|
|
{ duplicate symbols) }
|
|
{ staticAllowed - can we check for static variables? }
|
|
{ }
|
|
{ returns: }
|
|
{ A pointer to the symbol table entry is returned. If }
|
|
{ there is no entry, nil is returned. }
|
|
|
|
|
|
procedure GenParameters (pp: parameterPtr);
|
|
|
|
{ Generate labels and space for the parameters }
|
|
{ }
|
|
{ parameters: }
|
|
{ pp - pointer to first parameter }
|
|
|
|
|
|
procedure GenSymbols (sym: symbolTablePtr; doGlobals: boolean);
|
|
|
|
{ generate a symbol table for the debugger }
|
|
{ }
|
|
{ parameters: }
|
|
{ sym - symbol table to generate }
|
|
{ doGlobals - include global symbols in the table }
|
|
{ }
|
|
{ outputs: }
|
|
{ symLength - length of debug symbol table }
|
|
|
|
|
|
procedure InitSymbol;
|
|
|
|
{ Initialize the symbol table module }
|
|
|
|
|
|
function LabelToDisp (lab: integer): integer; extern;
|
|
|
|
{ convert a local label number to a stack frame displacement }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label number }
|
|
|
|
|
|
function NewSymbol (name: stringPtr; itype: typePtr; class: tokenEnum;
|
|
space: spaceType; state: stateKind): identPtr;
|
|
|
|
{ insert a new symbol in the symbol table }
|
|
{ }
|
|
{ parameters: }
|
|
{ name - pointer to the symbol name }
|
|
{ itype - pointer to the symbol type }
|
|
{ class - storage class }
|
|
{ space - the kind of variable space to put the }
|
|
{ identifier in }
|
|
{ state - variable declaration state }
|
|
{ }
|
|
{ returns: pointer to the inserted symbol }
|
|
|
|
|
|
procedure PopTable;
|
|
|
|
{ Pop a symbol table (remove definitions local to a block) }
|
|
|
|
|
|
{procedure PrintOneSymbol (ip: identPtr); {debug}
|
|
|
|
{ Print a symbol }
|
|
{ }
|
|
{ Parameters: }
|
|
{ ip - identifier to print }
|
|
|
|
|
|
{procedure PrintTable (sym: symbolTablePtr); {debug}
|
|
|
|
{ print a symbol table }
|
|
{ }
|
|
{ parameters: }
|
|
{ sym - symbol table to print }
|
|
|
|
|
|
procedure PushTable;
|
|
|
|
{ Create a new symbol table, pushing the old one }
|
|
|
|
|
|
procedure ResolveForwardReference (iPtr: identPtr);
|
|
|
|
{ resolve a forward reference }
|
|
{ }
|
|
{ parameters: }
|
|
{ iPtr - ptr to the forward declared identifier }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
var
|
|
staticNum, {static variable number}
|
|
firstStaticNum: packed array[1..6] of char; {staticNum at start of function}
|
|
|
|
{- Imported from expression.pas --------------------------------}
|
|
|
|
procedure GenerateCode (tree: tokenPtr); extern;
|
|
|
|
{ generate code from a fully formed expression tree }
|
|
{ }
|
|
{ parameters: }
|
|
{ tree - top of the expression tree to generate code from }
|
|
{ }
|
|
{ variables: }
|
|
{ expressionType - result type of the expression }
|
|
|
|
|
|
function UsualUnaryConversions: baseTypeEnum; extern;
|
|
|
|
{ performs the usual unary conversions }
|
|
{ }
|
|
{ inputs: }
|
|
{ expressionType - type of the operand }
|
|
{ }
|
|
{ result: }
|
|
{ The base type of the operation to perform is returned. }
|
|
{ Any conversion code necessary has been generated. }
|
|
{ }
|
|
{ outputs: }
|
|
{ expressionType - set to result type }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure CnOut (i: integer); extern;
|
|
|
|
{ write a byte to the constant buffer }
|
|
{ }
|
|
{ parameters: }
|
|
{ i - byte to write }
|
|
|
|
|
|
procedure CnOut2 (i: integer); extern;
|
|
|
|
{ write a word to the constant buffer }
|
|
{ }
|
|
{ parameters: }
|
|
{ i - word to write }
|
|
|
|
|
|
procedure Out (b: integer); extern;
|
|
|
|
{ write a byte to the output file }
|
|
{ }
|
|
{ parameters: }
|
|
{ b - byte to write }
|
|
|
|
|
|
procedure Out2 (w: integer); extern;
|
|
|
|
{ write a word to the output file }
|
|
{ }
|
|
{ parameters: }
|
|
{ w - word to write }
|
|
|
|
|
|
procedure RefName (lab: stringPtr; disp, len, shift: integer); extern;
|
|
|
|
{ handle a reference to a named label }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label name }
|
|
{ disp - displacement past the label }
|
|
{ len - number of bytes in the reference }
|
|
{ shift - shift factor }
|
|
|
|
|
|
procedure LabelSearch (lab: integer; len, shift, disp: integer); extern;
|
|
|
|
{ resolve a label reference }
|
|
{ }
|
|
{ parameters: }
|
|
{ lab - label number }
|
|
{ len - # bytes for the generated code }
|
|
{ shift - shift factor }
|
|
{ disp - disp past the label }
|
|
{ }
|
|
{ Note 1: maxlabel is reserved for use as the start of the }
|
|
{ string space }
|
|
{ Note 2: negative length indicates relative branch }
|
|
{ Note 3: zero length indicates 2 byte addr -1 }
|
|
|
|
|
|
procedure Purge; extern;
|
|
|
|
{ write any constant bytes to the output buffer }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure ClearTable (table: symbolTable); extern;
|
|
|
|
{ clear the symbol table to all zeros }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
|
|
procedure CheckStaticFunctions;
|
|
|
|
{ check for undefined functions }
|
|
|
|
var
|
|
i: 0..hashSize; {loop variable}
|
|
sp: identPtr; {pointer to a symbol table entry}
|
|
|
|
msg: stringPtr; {error message ptr}
|
|
|
|
begin {CheckStaticFunctions}
|
|
for i := 0 to hashSize do begin
|
|
sp := globalTable^.buckets[i];
|
|
while sp <> nil do begin
|
|
if sp^.storage = private then
|
|
if sp^.itype^.kind = functionType then
|
|
if sp^.state <> defined then begin
|
|
numErrors := numErrors+1;
|
|
new(msg);
|
|
msg^ := concat('The static function ', sp^.name^,
|
|
' was not defined.');
|
|
writeln('*** ', msg^);
|
|
if terminalErrors then begin
|
|
if enterEditor then
|
|
ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
|
|
else
|
|
TermError(0);
|
|
end; {if}
|
|
liDCBGS.merrf := 16;
|
|
end; {if}
|
|
sp := sp^.next;
|
|
end; {while}
|
|
end; {for}
|
|
end; {CheckStaticFunctions}
|
|
|
|
|
|
function CompTypes {t1, t2: typePtr): boolean};
|
|
|
|
{ Determine if the two types are compatible }
|
|
|
|
label 1;
|
|
|
|
var
|
|
el1,el2: longint; {array sizes}
|
|
kind1,kind2: typeKind; {temp variables (for speed)}
|
|
p1, p2: parameterPtr; {for tracing parameter lists}
|
|
pt1,pt2: typePtr; {pointer types}
|
|
|
|
|
|
function IsVoid (tp: typePtr): boolean;
|
|
|
|
{ Check to see if a type is void }
|
|
{ }
|
|
{ Parameters: }
|
|
{ tp - type to check }
|
|
{ }
|
|
{ Returns: True if the type is void, else false }
|
|
|
|
begin {IsVoid}
|
|
IsVoid := false;
|
|
if tp = voidPtr then
|
|
IsVoid := true
|
|
else if tp^.kind = scalarType then
|
|
if tp^.baseType = cgVoid then
|
|
IsVoid := true;
|
|
end; {IsVoid}
|
|
|
|
|
|
begin {CompTypes}
|
|
CompTypes := false; {assume the types are not compatible}
|
|
kind1 := t1^.kind; {get these for efficiency}
|
|
kind2 := t2^.kind;
|
|
if kind2 = definedType then {scan past type definitions}
|
|
CompTypes := CompTypes(t1, t2^.dType)
|
|
else if kind1 = definedType then
|
|
CompTypes := CompTypes(t1^.dType, t2)
|
|
|
|
else
|
|
case kind1 of
|
|
|
|
scalarType:
|
|
if kind2 = scalarType then
|
|
CompTypes := t1^.baseType = t2^.baseType
|
|
else if kind2 = enumType then
|
|
CompTypes := t1^.baseType = cgWord;
|
|
|
|
arrayType:
|
|
if kind2 = arrayType then begin
|
|
el1 := t1^.elements;
|
|
el2 := t2^.elements;
|
|
if el1 = 0 then
|
|
el1 := el2
|
|
else if el2 = 0 then
|
|
el2 := el1;
|
|
if el1 = el2 then
|
|
CompTypes := CompTypes(t1^.atype, t2^.atype);
|
|
end; {if}
|
|
|
|
functionType:
|
|
if kind2 = functionType then
|
|
CompTypes := CompTypes(t1^.ftype,t2^.ftype)
|
|
else if kind2 = pointerType then
|
|
if t2^.ptype^.kind = functionType then
|
|
CompTypes := CompTypes(t1, t2^.ptype);
|
|
|
|
pointerType: begin
|
|
if IsVoid(t1^.ptype) or IsVoid(t2^.ptype) then begin
|
|
CompTypes := true;
|
|
goto 1;
|
|
end; {if}
|
|
if kind2 = pointertype then
|
|
CompTypes := CompTypes(t1^.ptype, t2^.ptype)
|
|
else if kind2 = functionType then
|
|
CompTypes := CompTypes(t1^.ptype, t2);
|
|
end;
|
|
|
|
enumType:
|
|
if kind2 = scalarType then
|
|
CompTypes := t2^.baseType = cgWord
|
|
else if kind2 = enumType then
|
|
CompTypes := true;
|
|
|
|
structType,unionType:
|
|
CompTypes := t1 = t2;
|
|
|
|
otherwise: ;
|
|
|
|
end; {case t1^.kind}
|
|
1:
|
|
end; {CompTypes}
|
|
|
|
|
|
procedure DoGlobals;
|
|
|
|
{ declare the ~globals and ~arrays segments }
|
|
|
|
|
|
procedure GenArrays;
|
|
|
|
{ define global arrays }
|
|
|
|
var
|
|
didOne: boolean; {have we found an array yet?}
|
|
i: 0..hashSize; {loop variable}
|
|
ip: initializerPtr; {used to trace initializer lists}
|
|
lval: longint; {for converting types}
|
|
size: longint; {size of the array}
|
|
sp: identPtr; {pointer to a symbol table entry}
|
|
tPtr: typePtr; {type of global array/struct/union}
|
|
|
|
begin {GenArrays}
|
|
didOne := false;
|
|
for i := 0 to hashSize do begin
|
|
sp := table^.buckets[i];
|
|
while sp <> nil do begin
|
|
if sp^.storage in [global,private] then begin
|
|
tPtr := sp^.itype;
|
|
while tPtr^.kind = definedType do
|
|
tPtr := tPtr^.dType;
|
|
if tPtr^.kind in [arrayType,structType,unionType] then begin
|
|
if not didOne then begin
|
|
if smallMemoryModel then
|
|
currentSegment := ' '
|
|
else
|
|
currentSegment := '~ARRAYS ';
|
|
Gen2Name(dc_str, $4000, 1, @'~ARRAYS');
|
|
didOne := true;
|
|
end; {if}
|
|
if sp^.state = initialized then begin
|
|
Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name);
|
|
ip := sp^.iPtr;
|
|
while ip <> nil do begin
|
|
case ip^.itype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
lval := ip^.ival;
|
|
Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.itype);
|
|
end;
|
|
cgLong,cgULong:
|
|
GenL1(dc_cns, ip^.ival, ip^.count);
|
|
cgReal,cgDouble,cgComp,cgExtended:
|
|
GenR1t(dc_cns, ip^.rval, ip^.count, ip^.itype);
|
|
cgString:
|
|
GenS(dc_cns, ip^.sval);
|
|
ccPointer: begin
|
|
code^.optype := ccPointer;
|
|
code^.r := ord(ip^.pPlus);
|
|
code^.q := ip^.count;
|
|
code^.pVal := ip^.pVal;
|
|
if ip^.isName then begin
|
|
code^.lab := ip^.pName;
|
|
code^.pstr := nil;
|
|
end {if}
|
|
else
|
|
code^.pstr := ip^.pstr;
|
|
Gen0(dc_cns);
|
|
end;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
ip := ip^.next;
|
|
end; {while}
|
|
end {if}
|
|
else begin
|
|
size := sp^.itype^.size;
|
|
Gen2Name(dc_glb, long(size).lsw & $7FFF,
|
|
ord(sp^.storage = private), sp^.name);
|
|
size := size & $FFFF8000;
|
|
while size <> 0 do begin
|
|
Gen1(dc_dst, 16384);
|
|
size := size-16384;
|
|
end; {while}
|
|
end; {else}
|
|
end; {if}
|
|
end; {if}
|
|
sp := sp^.next;
|
|
end; {while}
|
|
end; {for}
|
|
if didOne then
|
|
Gen0(dc_enp);
|
|
end; {GenArrays}
|
|
|
|
|
|
procedure GenGlobals;
|
|
|
|
{ define non-array global variables }
|
|
|
|
var
|
|
i: 0..hashSize; {loop variable}
|
|
ip: initializerPtr; {used to trace initializer lists}
|
|
lval: longint; {for extracting lsw}
|
|
sp: identPtr; {pointer to a symbol table entry}
|
|
|
|
begin {GenGlobals}
|
|
Gen2t(dc_cns, 0, 1, cgByte);
|
|
for i := 0 to hashSize do begin
|
|
sp := table^.buckets[i];
|
|
while sp <> nil do begin
|
|
if sp^.storage in [global,private] then
|
|
if sp^.itype^.kind in [scalarType,pointerType] then begin
|
|
if sp^.state = initialized then begin
|
|
Gen2Name(dc_glb, 0, ord(sp^.storage = private), sp^.name);
|
|
ip := sp^.iPtr;
|
|
case ip^.itype of
|
|
cgByte,cgUByte,cgWord,cgUWord: begin
|
|
lval := ip^.ival;
|
|
Gen2t(dc_cns, long(lval).lsw, 1, ip^.itype);
|
|
end;
|
|
cgLong,cgULong:
|
|
GenL1(dc_cns, ip^.ival, 1);
|
|
cgReal,cgDouble,cgComp,cgExtended:
|
|
GenR1t(dc_cns, ip^.rval, 1, ip^.itype);
|
|
cgString:
|
|
GenS(dc_cns, ip^.sval);
|
|
ccPointer: begin
|
|
code^.optype := ccPointer;
|
|
code^.q := 1;
|
|
code^.r := ord(ip^.pPlus);
|
|
code^.pVal := ip^.pVal;
|
|
if ip^.isName then begin
|
|
code^.lab := ip^.pName;
|
|
code^.pstr := nil;
|
|
end {if}
|
|
else
|
|
code^.pstr := ip^.pstr;
|
|
Gen0(dc_cns);
|
|
end;
|
|
otherwise: Error(57);
|
|
end; {case}
|
|
end {if}
|
|
else
|
|
Gen2Name(dc_glb, ord(sp^.itype^.size),
|
|
ord(sp^.storage = private), sp^.name);
|
|
end;
|
|
sp := sp^.next;
|
|
end; {while}
|
|
end; {for}
|
|
end; {GenGlobals}
|
|
|
|
begin {DoGlobals}
|
|
{print the global symbol table}
|
|
{if printSymbols then {debug}
|
|
{ PrintTable(globalTable); {debug}
|
|
|
|
{these segments are not dynamic!}
|
|
segmentKind := 0;
|
|
|
|
{declare the ~globals segment, which holds non-array data types}
|
|
if smallMemoryModel then
|
|
currentSegment := ' '
|
|
else
|
|
currentSegment := '~GLOBALS ';
|
|
Gen2Name(dc_str, $4000, 0, @'~GLOBALS');
|
|
GenGlobals;
|
|
Gen0(dc_enp);
|
|
|
|
{declare the ~arrays segment, which holds global arrays}
|
|
GenArrays;
|
|
end; {DoGlobals}
|
|
|
|
|
|
function FindSymbol {var tk: tokenType; class: spaceType; oneLevel: boolean;
|
|
staticAllowed: boolean): identPtr};
|
|
|
|
{ locate a symbol in the symbol table }
|
|
{ }
|
|
{ parameters: }
|
|
{ tk - token record for the identifier to find }
|
|
{ class - the kind of variable space to search }
|
|
{ oneLevel - search one level only? (used to check for }
|
|
{ duplicate symbols) }
|
|
{ staticAllowed - can we check for static variables? }
|
|
{ }
|
|
{ returns: }
|
|
{ A pointer to the symbol table entry is returned. If }
|
|
{ there is no entry, nil is returned. }
|
|
|
|
label 1;
|
|
|
|
var
|
|
doTagSpace: boolean; {do we still need to do the tags?}
|
|
hashDisp: longint; {disp into the hash table}
|
|
i: integer; {loop variable}
|
|
iHandle: ^identPtr; {pointer to start of hash bucket}
|
|
iPtr: identPtr; {pointer to the current symbol}
|
|
match: boolean; {for comparing substrings}
|
|
name: stringPtr; {name to search for}
|
|
np: stringPtr; {for searching for static variables}
|
|
sPtr: symbolTablePtr; {^ to current symbol table}
|
|
|
|
begin {FindSymbol}
|
|
{get ready to search}
|
|
staticAllowed := staticAllowed and (staticNum <> '~0000');
|
|
name := tk.name; {use a local variable}
|
|
hashDisp := Hash(name); {get the disp into the symbol table}
|
|
sPtr := table; {initialize the address of the sym. tbl}
|
|
FindSymbol := nil; {assume we won't find it}
|
|
np := nil; {no string buffer, yet}
|
|
|
|
{check for the variable}
|
|
while sPtr <> nil do begin
|
|
iHandle := pointer(hashDisp+ord4(sPtr));
|
|
if class = tagSpace then
|
|
iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
|
|
doTagSpace := class = allSpaces;
|
|
iPtr := iHandle^;
|
|
if iPtr = nil then
|
|
if doTagSpace then begin
|
|
iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
|
|
iPtr := iHandle^;
|
|
doTagSpace := false;
|
|
end; {if}
|
|
|
|
{scan the hash bucket for a global or auto variable}
|
|
while iPtr <> nil do begin
|
|
if iPtr^.name^ = name^ then begin
|
|
FindSymbol := iPtr;
|
|
if iPtr^.isForwardDeclared then
|
|
ResolveForwardReference(iPtr);
|
|
tk.symbolPtr := iPtr;
|
|
goto 1;
|
|
end; {if}
|
|
iPtr := iPtr^.next;
|
|
if iPtr = nil then
|
|
if doTagSpace then begin
|
|
iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
|
|
iPtr := iHandle^;
|
|
doTagSpace := false;
|
|
end; {if}
|
|
end; {while}
|
|
|
|
{rescan for a static variable}
|
|
if staticAllowed then begin
|
|
if np = nil then begin {form the static name}
|
|
if length(name^) < 251 then begin
|
|
new(np);
|
|
np^[0] := chr(5+length(name^));
|
|
for i := 1 to 5 do
|
|
np^[i] := sPtr^.staticNum[i];
|
|
for i := 1 to length(name^) do
|
|
np^[i+5] := name^[i];
|
|
end; {if}
|
|
end {if}
|
|
else
|
|
for i := 2 to 5 do
|
|
np^[i] := sPtr^.StaticNum[i];
|
|
|
|
{scan the hash bucket for the identifier}
|
|
iHandle := pointer(hashDisp+ord4(globalTable));
|
|
if class = tagSpace then
|
|
iHandle := pointer(ord4(iHandle) + (hashSize+1)*4);
|
|
iPtr := iHandle^;
|
|
|
|
while iPtr <> nil do begin
|
|
if iPtr^.name^ = np^ then begin
|
|
FindSymbol := iPtr;
|
|
if iPtr^.isForwardDeclared then
|
|
ResolveForwardReference(iPtr);
|
|
tk.symbolPtr := iPtr;
|
|
goto 1;
|
|
end; {if}
|
|
iPtr := iPtr^.next;
|
|
end; {while}
|
|
end; {if staticAllowed}
|
|
|
|
if oneLevel then
|
|
sPtr := nil
|
|
else
|
|
sPtr := sPtr^.next;
|
|
end; {while}
|
|
|
|
1:
|
|
if np <> nil then
|
|
dispose(np);
|
|
end; {FindSymbol}
|
|
|
|
|
|
procedure GenParameters {pp: parameterPtr};
|
|
|
|
{ Generate labels and space for the parameters }
|
|
{ }
|
|
{ parameters: }
|
|
{ pp - pointer to first parameter }
|
|
|
|
var
|
|
i: 0..hashSize; {loop variable}
|
|
pln: integer; {label number}
|
|
size: integer; {size of the parameter}
|
|
sp: identPtr; {symbol pointer}
|
|
tk: tokenType; {symbol name token}
|
|
|
|
begin {GenParameters}
|
|
if pp <> nil then begin {prototyped parameters}
|
|
tk.kind := ident;
|
|
tk.numString := nil;
|
|
tk.class := identifier;
|
|
while pp <> nil do begin
|
|
pln := GetLocalLabel;
|
|
tk.name := pp^.parameter^.name;
|
|
tk.symbolPtr := nil;
|
|
sp := FindSymbol(tk, variableSpace, true, false);
|
|
if sp = nil then
|
|
sp := pp^.parameter;
|
|
if sp^.itype^.kind = arrayType then
|
|
Gen3(dc_prm, pln, cgPointerSize, sp^.pdisp)
|
|
else begin
|
|
size := long(sp^.itype^.size).lsw;
|
|
if (size = 1) and (sp^.itype^.kind = scalarType) then
|
|
size := 2;
|
|
Gen3(dc_prm, pln, size, sp^.pdisp);
|
|
end; {else}
|
|
sp^.pln := pln;
|
|
pp := pp^.next;
|
|
end; {while}
|
|
end {if}
|
|
else begin {K&R parameters}
|
|
for i := 0 to hashSize do begin
|
|
sp := table^.buckets[i];
|
|
while sp <> nil do begin
|
|
if sp^.storage = parameter then begin
|
|
sp^.pln := GetLocalLabel;
|
|
if sp^.itype^.kind = arrayType then
|
|
Gen3(dc_prm, sp^.lln, cgPointerSize, sp^.pdisp)
|
|
else begin
|
|
size := long(sp^.itype^.size).lsw;
|
|
if (size = 1) and (sp^.itype^.kind = scalarType) then
|
|
size := 2;
|
|
Gen3(dc_prm, sp^.lln, size, sp^.pdisp);
|
|
end; {else}
|
|
end; {if}
|
|
sp := sp^.next;
|
|
end; {while}
|
|
end; {for}
|
|
end; {else}
|
|
end; {GenParameters}
|
|
|
|
|
|
procedure GenSymbols {sym: symbolTablePtr; doGlobals: boolean};
|
|
|
|
{ generate a symbol table for the debugger }
|
|
{ }
|
|
{ parameters: }
|
|
{ sym - symbol table to generate }
|
|
{ doGlobals - include global symbols in the table }
|
|
{ }
|
|
{ outputs: }
|
|
{ symLength - length of debug symbol table }
|
|
|
|
const
|
|
noDisp = -1; {disp returned by GetTypeDisp if the type was not found}
|
|
|
|
type
|
|
tpPtr = ^tpRecord; {type list displacements}
|
|
tpRecord = record
|
|
next: tpPtr;
|
|
tp: typePtr;
|
|
disp: integer;
|
|
end;
|
|
|
|
var
|
|
i: 0..hashSize; {loop/index variable}
|
|
ip: identPtr; {used to trace identifier lists}
|
|
tpList,tp2: tpPtr; {type displacement list}
|
|
|
|
|
|
function GetTypeDisp (tp: typePtr): integer;
|
|
|
|
{ Look for an existing entry for this type }
|
|
{ }
|
|
{ Parameters: }
|
|
{ tp - type to look for }
|
|
{ }
|
|
{ Returns: Disp to a variable of the same type, or noDisp if }
|
|
{ there is no such entry. }
|
|
{ }
|
|
{ Notes: If the type is not in the type list, it is entered }
|
|
{ in the list by this call. }
|
|
|
|
var
|
|
tp1, tp2: tpPtr; {used to manipulate type list}
|
|
|
|
begin {GetTypeDisp}
|
|
tp1 := tpList; {look for the type}
|
|
tp2 := nil;
|
|
while tp1 <> nil do
|
|
if tp1^.tp = tp then begin
|
|
tp2 := tp1;
|
|
tp1 := nil;
|
|
end {if}
|
|
else
|
|
tp1 := tp1^.next;
|
|
if tp2 <> nil then
|
|
GetTypeDisp := tp2^.disp {return disp to entry}
|
|
else begin
|
|
GetTypeDisp := noDisp; {no entry}
|
|
new(tp1); {create a new entry}
|
|
tp1^.next := tpList;
|
|
tpList := tp1;
|
|
tp1^.tp := tp;
|
|
tp1^.disp := symLength;
|
|
end; {else}
|
|
end; {GetTypeDisp}
|
|
|
|
|
|
procedure GenSymbol (ip: identPtr; storage: storageType);
|
|
|
|
{ Generate a single symbol or struct field }
|
|
{ }
|
|
{ parameters: }
|
|
{ ip - identifier to generate }
|
|
{ storage - storage type; none for struct/union fields }
|
|
|
|
var
|
|
disp: integer; {disp to symbol of same type}
|
|
|
|
|
|
procedure WriteAddress (ip: identPtr);
|
|
|
|
{ Write the address and DP flag }
|
|
{ }
|
|
{ parameters: }
|
|
{ ip - identifier }
|
|
|
|
var
|
|
size: longint; {used to break apart longints}
|
|
|
|
begin {WriteAddress}
|
|
if storage in [external,global,private] then begin
|
|
RefName(ip^.name, 0, 4, 0);
|
|
CnOut(1);
|
|
end {if}
|
|
else if storage = none then begin
|
|
size := ip^.disp;
|
|
CnOut2(long(size).lsw);
|
|
CnOut2(long(size).msw);
|
|
CnOut(ord(ip^.next <> nil));
|
|
end {else if}
|
|
else begin
|
|
CnOut2(LabelToDisp(ip^.lln));
|
|
CnOut2(0);
|
|
CnOut(0);
|
|
end; {else}
|
|
end; {WriteAddress}
|
|
|
|
|
|
procedure WriteName (ip: identPtr);
|
|
|
|
{ Write the name field for an identifier }
|
|
{ }
|
|
{ parameters: }
|
|
{ ip - identifier }
|
|
|
|
var
|
|
len: 0..maxint; {string length}
|
|
j: 0..maxint; {loop/index variable}
|
|
|
|
begin {WriteName}
|
|
Purge; {generate the address of the variable }
|
|
Out(235); Out(4); { name }
|
|
LabelSearch(maxLabel, 4, 0, 0);
|
|
if stringsize <> 0 then begin
|
|
Out(129);
|
|
Out2(stringsize); Out2(0);
|
|
Out(1);
|
|
end; {if}
|
|
Out(0);
|
|
len := length(ip^.name^); {place the name in the string buffer}
|
|
if maxstring-stringsize >= len+1 then begin
|
|
stringspace[stringsize+1] := chr(len);
|
|
for j := 1 to len do
|
|
stringspace[j+stringsize+1] := ip^.name^[j];
|
|
stringsize := stringsize+len+1;
|
|
end {if}
|
|
else
|
|
Error(60);
|
|
end; {WriteName}
|
|
|
|
|
|
procedure WriteScalarType (tp: typePtr; modifiers, subscripts: integer);
|
|
|
|
{ Write a scalar type and subscipt field }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - type pointer }
|
|
{ modifiers - value to or with the type code }
|
|
{ subscripts - number of subscripts }
|
|
|
|
var
|
|
val: integer; {type value}
|
|
|
|
begin {WriteScalarType}
|
|
case tp^.baseType of
|
|
cgByte: val := $40;
|
|
cgUByte: val := $00;
|
|
cgWord: val := $01;
|
|
cgUWord: val := $41;
|
|
cgLong: val := $02;
|
|
cgULong: val := $42;
|
|
cgReal: val := $03;
|
|
cgDouble: val := $04;
|
|
cgComp: val := $0A;
|
|
cgExtended: val := $05;
|
|
otherwise: val := $01;
|
|
end; {case}
|
|
CnOut(val | modifiers); {write the format byte}
|
|
CnOut2(subscripts); {write the # of subscripts}
|
|
end; {WriteScalarType}
|
|
|
|
|
|
procedure WritePointerType (tp: typePtr; subscripts: integer);
|
|
|
|
{ write a pointer type field }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - pointer type }
|
|
{ subscripts - number of subscript fields }
|
|
|
|
begin {WritePointerType}
|
|
case tp^.ptype^.kind of
|
|
scalarType: WriteScalarType(tp^.ptype, $80, subscripts);
|
|
enumType,
|
|
functionType: WriteScalarType(wordPtr, $80, subscripts);
|
|
otherwise: begin
|
|
CnOut(11);
|
|
CnOut2(subscripts);
|
|
end;
|
|
end; {case}
|
|
end; {WritePointerType}
|
|
|
|
|
|
procedure ExpandPointerType (tp: typePtr); forward;
|
|
|
|
|
|
procedure ExpandStructType (tp: typePtr);
|
|
|
|
{ write the type entries for a struct or union }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - struct/union type }
|
|
|
|
var
|
|
ip: identPtr; {used to trace the field list}
|
|
|
|
begin {ExpandStructType}
|
|
ip := tp^.fieldList;
|
|
while ip <> nil do begin
|
|
GenSymbol(ip, none);
|
|
ip := ip^.next;
|
|
end; {while}
|
|
end; {ExpandStructType}
|
|
|
|
|
|
procedure WriteArrays (tp: typePtr);
|
|
|
|
{ handle an array type }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - array type }
|
|
|
|
var
|
|
count: 0..maxint; {# of subscripts}
|
|
size: longint; {for converting long numbers}
|
|
tp2: typePtr; {used to trace array type list}
|
|
|
|
begin {WriteArrays}
|
|
count := 0; {count the subscripts}
|
|
tp2 := tp;
|
|
while tp2^.kind = arrayType do begin
|
|
count := count+1;
|
|
tp2 := tp2^.aType;
|
|
end; {while}
|
|
if tp2^.kind = scalarType then {write the type code}
|
|
if tp2^.baseType in [cgByte,cgUByte] then begin
|
|
count := count-1;
|
|
CnOut(6);
|
|
CnOut2(count);
|
|
end {if}
|
|
else
|
|
WriteScalarType(tp2, 0, count)
|
|
else if tp2^.kind = enumType then
|
|
WriteScalarType(wordPtr, 0, count)
|
|
else if tp2^.kind = pointerType then
|
|
WritePointerType(tp2, count)
|
|
else begin
|
|
CnOut(12);
|
|
CnOut2(count);
|
|
end; {else if}
|
|
while count <> 0 do begin {write the subscript entries}
|
|
CnOut2(0); CnOut2(0);
|
|
if tp^.elements = 0 then
|
|
size := $00FFFFFF
|
|
else
|
|
size := tp^.elements-1;
|
|
CnOut2(long(size).lsw); CnOut2(long(size).msw);
|
|
size := tp^.aType^.size;
|
|
CnOut2(long(size).lsw); CnOut2(long(size).msw);
|
|
symLength := symLength+12;
|
|
tp := tp^.aType;
|
|
count := count-1;
|
|
end; {while}
|
|
if tp2^.kind = pointerType then {expand complex types}
|
|
ExpandPointerType(tp2)
|
|
else if tp2^.kind in [structtype,uniontype] then
|
|
ExpandStructType(tp2);
|
|
end; {WriteArrays}
|
|
|
|
|
|
procedure ExpandPointerType {tp: typePtr};
|
|
|
|
{ write the type entries for complex pointer types }
|
|
{ }
|
|
{ parameters: }
|
|
{ tp - pointer type }
|
|
|
|
var
|
|
disp: integer; {disp to symbol of same type}
|
|
|
|
begin {ExpandPointerType}
|
|
if tp^.ptype^.kind in [pointerType,arrayType,structType,unionType] then
|
|
begin
|
|
symLength := symLength+12;
|
|
CnOut2(0); CnOut2(0);
|
|
CnOut2(0); CnOut2(0);
|
|
CnOut(0);
|
|
case tp^.ptype^.kind of
|
|
pointerType: begin
|
|
WritePointerType(tp^.ptype, 0);
|
|
ExpandPointerType(tp^.ptype);
|
|
end;
|
|
arrayType: WriteArrays(tp^.ptype);
|
|
structType,
|
|
unionType: begin
|
|
disp := GetTypeDisp(tp^.ptype);
|
|
if disp = noDisp then begin
|
|
CnOut(12);
|
|
CnOut2(0);
|
|
ExpandStructType(tp^.ptype);
|
|
end {if}
|
|
else begin
|
|
CnOut(13);
|
|
CnOut2(disp);
|
|
end; {else}
|
|
end;
|
|
end; {case}
|
|
end; {if}
|
|
end; {ExpandPointerType}
|
|
|
|
|
|
begin {GenSymbol}
|
|
if ip^.itype^.kind in
|
|
[scalarType,arrayType,pointerType,enumType,structType,unionType]
|
|
then begin
|
|
WriteName(ip); {write the name field}
|
|
WriteAddress(ip); {write the address field}
|
|
case ip^.itype^.kind of
|
|
scalarType: WriteScalarType(ip^.itype, 0, 0);
|
|
enumType: WriteScalarType(wordPtr, 0, 0);
|
|
pointerType: begin
|
|
WritePointerType(ip^.itype, 0);
|
|
ExpandPointerType(ip^.itype);
|
|
end;
|
|
arrayType: WriteArrays(ip^.itype);
|
|
structType,
|
|
unionType: begin
|
|
disp := GetTypeDisp(ip^.itype);
|
|
if disp = noDisp then begin
|
|
CnOut(12);
|
|
CnOut2(0);
|
|
ExpandStructType(ip^.itype);
|
|
end {if}
|
|
else begin
|
|
CnOut(13);
|
|
CnOut2(disp);
|
|
end; {else}
|
|
end;
|
|
end; {case}
|
|
symLength := symLength+12; {update length of symbol table}
|
|
end; {if}
|
|
end; {GenSymbol}
|
|
|
|
|
|
begin {GenSymbols}
|
|
tpList := nil; {no types so far}
|
|
if sym <> nil then
|
|
for i := 0 to hashSize do begin {loop over all hash buckets}
|
|
ip := sym^.buckets[i]; {trace through all symbols in this bucket}
|
|
while ip <> nil do begin
|
|
if ip^.storage <> none then
|
|
GenSymbol(ip, ip^.storage);
|
|
ip := ip^.next; {next symbol}
|
|
end; {while}
|
|
end; {for}
|
|
while tpList <> nil do begin {dispose of type list}
|
|
tp2 := tpList;
|
|
tpList := tp2^.next;
|
|
dispose(tp2);
|
|
end; {while}
|
|
if doGlobals then {do globals}
|
|
GenSymbols(globalTable, false);
|
|
end; {GenSymbols}
|
|
|
|
|
|
procedure InitSymbol;
|
|
|
|
{ Initialize the symbol table module }
|
|
|
|
var
|
|
i: 0..hashSize; {loop variable}
|
|
|
|
begin {InitSymbol}
|
|
staticNum := '~0000'; {no functions processed}
|
|
table := nil; {initialize the global symbol table}
|
|
PushTable;
|
|
globalTable := table;
|
|
noDeclarations := false;
|
|
{declare base types}
|
|
new(bytePtr); {byte}
|
|
with bytePtr^ do begin
|
|
size := cgByteSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgByte;
|
|
end; {with}
|
|
new(uBytePtr); {unsigned byte}
|
|
with uBytePtr^ do begin
|
|
size := cgByteSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgUByte;
|
|
end; {with}
|
|
new(wordPtr); {word}
|
|
with wordPtr^ do begin
|
|
size := cgWordSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgWord;
|
|
end; {with}
|
|
new(uWordPtr); {unsigned word}
|
|
with uWordPtr^ do begin
|
|
size := cgWordSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgUWord;
|
|
end; {with}
|
|
new(longPtr); {long}
|
|
with longPtr^ do begin
|
|
size := cgLongSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgLong;
|
|
end; {with}
|
|
new(uLongPtr); {unsigned long}
|
|
with uLongPtr^ do begin
|
|
size := cgLongSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgULong;
|
|
end; {with}
|
|
new(realPtr); {real}
|
|
with realPtr^ do begin
|
|
size := cgRealSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgReal;
|
|
end; {with}
|
|
new(doublePtr); {double}
|
|
with doublePtr^ do begin
|
|
size := cgDoubleSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgDouble;
|
|
end; {with}
|
|
new(compPtr); {comp}
|
|
with compPtr^ do begin
|
|
size := cgCompSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgComp;
|
|
end; {with}
|
|
new(extendedPtr); {extended}
|
|
with extendedPtr^ do begin
|
|
size := cgExtendedSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgExtended;
|
|
end; {with}
|
|
new(stringTypePtr); {string constant type}
|
|
with stringTypePtr^ do begin
|
|
size := 0;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := arrayType;
|
|
aType := uBytePtr;
|
|
elements := 1;
|
|
end; {with}
|
|
new(voidPtr); {void}
|
|
with voidPtr^ do begin
|
|
size := 0;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := scalarType;
|
|
baseType := cgVoid;
|
|
end; {with}
|
|
new(voidPtrPtr); {typeless pointer}
|
|
with voidPtrPtr^ do begin
|
|
size := 4;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := pointerType;
|
|
pType := voidPtr;
|
|
end; {with}
|
|
new(defaultStruct); {default structure}
|
|
with defaultStruct^ do begin {(for structures with errors)}
|
|
size := cgWordSize;
|
|
saveDisp := 0;
|
|
isConstant := false;
|
|
kind := structType;
|
|
sName := nil;
|
|
new(fieldList);
|
|
with fieldlist^ do begin
|
|
next := nil;
|
|
name := @'field';
|
|
itype := wordPtr;
|
|
class := ident;
|
|
state := declared;
|
|
disp := 0;
|
|
bitdisp := 0;
|
|
end; {with}
|
|
end; {with}
|
|
end; {InitSymbol}
|
|
|
|
|
|
function NewSymbol {name: stringPtr; itype: typePtr; class: tokenEnum;
|
|
space: spaceType; state: stateKind): identPtr};
|
|
|
|
{ insert a new symbol in the symbol table }
|
|
{ }
|
|
{ parameters: }
|
|
{ name - pointer to the symbol name }
|
|
{ itype - pointer to the symbol type }
|
|
{ class - storage class }
|
|
{ space - the kind of variable space to put the }
|
|
{ identifier in }
|
|
{ state - variable declaration state }
|
|
{ }
|
|
{ returns: pointer to the inserted symbol }
|
|
|
|
var
|
|
cs: identPtr; {current symbol}
|
|
hashPtr: ^identPtr; {pointer to hash bucket in symbol table}
|
|
i: integer; {loop variable}
|
|
isGlobal: boolean; {are we using the global table?}
|
|
lUseGlobalPool: boolean; {use the global symbol pool?}
|
|
needSymbol: boolean; {do we need to declare it?}
|
|
np: stringPtr; {for forming static name}
|
|
p: identPtr; {work pointer}
|
|
tk: tokenType; {fake token; for FindSymbol}
|
|
|
|
begin {NewSymbol}
|
|
needSymbol := true; {assume we need a symbol}
|
|
cs := nil; {no current symbol found}
|
|
isGlobal := false; {set up defaults}
|
|
lUseGlobalPool := useGlobalPool;
|
|
tk.name := name;
|
|
tk.symbolPtr := nil;
|
|
if space <> fieldListSpace then begin {are we defining a function?}
|
|
if itype^.kind = functionType then begin
|
|
isGlobal := true;
|
|
useGlobalPool := true;
|
|
if class in [autosy, ident] then
|
|
class := externsy;
|
|
if not lUseGlobalPool then begin
|
|
np := pointer(Malloc(length(name^)+1));
|
|
CopyString(pointer(np), pointer(name));
|
|
tk.name := np;
|
|
name := np;
|
|
end; {if}
|
|
cs := FindSymbol(tk, space, false, true);
|
|
if cs <> nil then begin
|
|
if cs^.state = defined then
|
|
if state = defined then
|
|
Error(42);
|
|
p := cs;
|
|
needSymbol := false;
|
|
if not itype^.prototyped then begin
|
|
itype^.prototyped := cs^.itype^.prototyped;
|
|
itype^.parameterList := cs^.itype^.parameterList;
|
|
end; {if}
|
|
end; {if}
|
|
end {if}
|
|
else if (itype^.kind in [structType,unionType]) and (itype^.fieldList = nil)
|
|
and doingParameters then begin
|
|
isGlobal := true;
|
|
useGlobalPool := true;
|
|
end; {else if}
|
|
if noDeclarations then begin {if we need a symbol table, create it}
|
|
if not isGlobal then
|
|
noDeclarations := false;
|
|
end {if}
|
|
else begin {check for duplicates}
|
|
cs := FindSymbol(tk, space, true, false);
|
|
if cs <> nil then begin
|
|
if (not CompTypes(cs^.itype, itype))
|
|
or ((cs^.state = initialized) and (state = initialized))
|
|
or (globalTable <> table) then
|
|
if (not doingParameters) or (cs^.state <> declared) then
|
|
Error(42);
|
|
p := cs;
|
|
needSymbol := false;
|
|
end; {if}
|
|
end; {else}
|
|
end; {if}
|
|
if class = staticsy then {statics go in the global symbol table}
|
|
if not isGLobal then
|
|
if globalTable <> table then begin
|
|
cs := FindSymbol(tk, space, true, true);
|
|
if cs <> nil then begin {check for duplicates}
|
|
if (not CompTypes(cs^.itype, itype))
|
|
or ((cs^.state = defined) and (state <> initialized))
|
|
or (cs^.state = initialized) then
|
|
Error(42);
|
|
p := cs;
|
|
needSymbol := false;
|
|
end; {if}
|
|
isGlobal := true; {note that we will use the global table}
|
|
useGlobalPool := true;
|
|
np := pointer(GMalloc(length(name^)+6));
|
|
np^[0] := chr(5+length(name^));
|
|
for i := 1 to 5 do
|
|
np^[i] := table^.staticNum[i];
|
|
for i := 1 to length(name^) do
|
|
np^[i+5] := name^[i];
|
|
name := np;
|
|
end; {if}
|
|
if needSymbol then begin
|
|
p := pointer(Calloc(sizeof(identRecord))); {get space for the record}
|
|
{p^.iPtr := nil;} {no initializers, yet}
|
|
{p^.saved := 0;} {not saved}
|
|
p^.state := state; {set the state}
|
|
{p^.isForwardDeclared := false;} {assume no forward declarations are used}
|
|
p^.name := name; {record the name}
|
|
if space <> fieldListSpace then {insert the symbol in the hash bucket}
|
|
begin
|
|
if itype = nil then
|
|
hashPtr := pointer(ord4(table)+Hash(name))
|
|
else if isGlobal then
|
|
hashPtr := pointer(ord4(globalTable)+Hash(name))
|
|
else
|
|
hashPtr := pointer(ord4(table)+Hash(name));
|
|
if space = tagSpace then
|
|
hashPtr := pointer(ord4(hashPtr) + 4*(hashSize+1));
|
|
p^.next := hashPtr^;
|
|
hashPtr^ := p;
|
|
end {if}
|
|
else
|
|
p^.next := nil;
|
|
end; {if}
|
|
if class in [autosy,registersy] then {check and set the storage class}
|
|
begin
|
|
if doingFunction or doingParameters then begin
|
|
p^.storage := stackFrame;
|
|
class := ident;
|
|
end {if}
|
|
else begin
|
|
p^.storage := global;
|
|
Error(62);
|
|
end; {else}
|
|
end {if}
|
|
else if class = ident then begin
|
|
if doingFunction then begin
|
|
p^.storage := stackFrame;
|
|
class := autosy;
|
|
end {if}
|
|
else
|
|
p^.storage := global;
|
|
end {else if}
|
|
else if class = externsy then
|
|
p^.storage := external
|
|
else if class = staticsy then
|
|
p^.storage := private
|
|
else
|
|
p^.storage := none;
|
|
p^.class := class;
|
|
p^.itype := itype; {set the symbol field values}
|
|
NewSymbol := p; {return a pointer to the new entry}
|
|
useGlobalPool := lUseGlobalPool; {restore the useGlobalPool variable}
|
|
end; {NewSymbol}
|
|
|
|
|
|
procedure PopTable;
|
|
|
|
{ Pop a symbol table (remove definitions local to a block) }
|
|
|
|
var
|
|
tPtr: symbolTablePtr; {work pointer}
|
|
|
|
begin {PopTable}
|
|
tPtr := table;
|
|
{if printSymbols then {debug}
|
|
{ PrintTable(tPtr); {debug}
|
|
if tPtr^.next <> nil then begin
|
|
table := table^.next;
|
|
dispose(tPtr);
|
|
end; {if}
|
|
end; {PopTable}
|
|
|
|
|
|
{ copy 'symbol.print'} {debug}
|
|
|
|
|
|
procedure PushTable;
|
|
|
|
{ Create a new symbol table, pushing the old one }
|
|
|
|
var
|
|
done: boolean; {loop termination}
|
|
i: integer; {loop index}
|
|
tPtr: symbolTablePtr; {work pointer}
|
|
|
|
begin {PushTable}
|
|
i := 5; {increment the static var number}
|
|
repeat
|
|
staticNum[i] := succ(staticNum[i]);
|
|
done := staticNum[i] <> succ('9');
|
|
if not done then begin
|
|
staticNum[i] := '0';
|
|
i := i-1;
|
|
done := i = 1;
|
|
end; {if}
|
|
until done;
|
|
if table = globalTable then {update fistStaticNum}
|
|
firstStaticNum := staticNum;
|
|
new(tPtr); {create a new symbol table}
|
|
ClearTable(tPtr^);
|
|
tPtr^.next := table;
|
|
table := tPtr;
|
|
tPtr^.staticNum := staticNum; {record the static symbol table number}
|
|
end; {PushTable}
|
|
|
|
|
|
procedure ResolveForwardReference {iPtr: identPtr};
|
|
|
|
{ resolve a forward reference }
|
|
{ }
|
|
{ parameters: }
|
|
{ iPtr - ptr to the forward declared identifier }
|
|
|
|
var
|
|
fl: identPtr; {for tracing field lists}
|
|
ltk: tokenType; {for searching for forward refs}
|
|
sym: identPtr; {for finding forward refs}
|
|
lPtr,tPtr: typePtr; {for tracing forward declared types}
|
|
|
|
begin {ResolveForwardReference}
|
|
iPtr^.isForwardDeclared := false; {we will succeeed or flag an error...}
|
|
tPtr := iPtr^.itype; {skip to the struct/union type}
|
|
lPtr := nil;
|
|
while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do begin
|
|
lPtr := tPtr;
|
|
tPtr := tPtr^.pType;
|
|
end;
|
|
if tPtr^.sName <> nil then begin {resolve the forward reference}
|
|
ltk.name := tPtr^.sName;
|
|
ltk.symbolPtr := nil;
|
|
sym := FindSymbol(ltk,tagSpace,false,true);
|
|
if sym <> nil then begin
|
|
if sym^.itype^.kind <> tPtr^.kind then
|
|
Error(107)
|
|
else begin
|
|
if sym^.itype = tPtr then
|
|
tPtr^.sName := nil
|
|
else begin
|
|
tPtr := sym^.itype;
|
|
if lPtr <> nil then
|
|
lPtr^.ptype := tPtr;
|
|
end; {else}
|
|
end; {else}
|
|
end; {if}
|
|
end; {if}
|
|
if lPtr <> nil then
|
|
tPtr := lPtr^.pType; {check the field list for other fwd refs}
|
|
while tPtr^.kind in [pointerType,arrayType,functionType,definedType] do
|
|
tPtr := tPtr^.pType;
|
|
if tPtr^.kind in [structType,unionType] then begin
|
|
fl := tPtr^.fieldList;
|
|
while fl <> nil do begin
|
|
if fl^.isForwardDeclared then
|
|
ResolveForwardReference(fl);
|
|
fl := fl^.next;
|
|
end; {while}
|
|
end; {if}
|
|
end; {ResolveForwardReference}
|
|
|
|
end.
|
|
|
|
{$append 'symbol.asm'}
|