Rework static initialization to support new-style initializer records.

Static initialization of arrays/structs/unions now essentially "executes" the initializer records to fill in a buffer (and keep track of relocations), then emits pcode to represent that initialized state. This supports overlapping and out-of-order initializer records, as can be produced by designated initialization.
This commit is contained in:
Stephen Heumann 2022-12-02 21:55:57 -06:00
parent 48efd462ef
commit 28e119afb1
4 changed files with 296 additions and 33 deletions

View File

@ -322,7 +322,7 @@ type
initializerRecord = record
next: initializerPtr; {next record in the chain}
disp: longint; {disp within overall object being initialized}
count: integer; {# of duplicate records}
count: integer; {# of duplicate records (>1 for bytes only)}
bitdisp: integer; {disp in byte (field lists only)}
bitsize: integer; {width in bits; 0 for byte sizes}
case isConstant: boolean of {is this a constant initializer?}

View File

@ -2774,6 +2774,12 @@ while iPtr <> nil do begin
jPtr := kPtr;
end; {while}
variable^.iPtr := jPtr;
if isStatic then {if doing static initialization }
if variable^.itype^.kind in [structType,unionType,definedType,arrayType]
then begin
disp := 0; {...ensure unnamed members are 0}
Fill(variable^.itype^.size);
end; {if}
if errorFound then {eliminate bad initializers}
variable^.state := defined;
useGlobalPool := luseGlobalPool; {restore useGlobalPool}

View File

@ -22,3 +22,19 @@ lb1 sta [table],Y
return
end
****************************************************************
*
* SaveBF - save a value to a bit-field
*
* Inputs:
* addr - address to copy to
* bitdisp - displacement past the address
* bitsize - number of bits
* val - value to copy
*
****************************************************************
*
SaveBF private cc
jml ~SaveBF call ~SaveBF in ORCALib
end

View File

@ -295,9 +295,27 @@ function StringType(prefix: charStrPrefixEnum): typePtr;
implementation
type
{From CGC.pas}
realrec = record {used to convert from real to in-SANE}
itsReal: extended;
inSANE: packed array[1..10] of byte;
inCOMP: packed array[1..8] of byte;
end;
var
staticNum: packed array[1..6] of char; {static variable number}
{---------------------------------------------------------------}
{GS memory manager}
{-----------------}
procedure DisposeHandle (theHandle: handle); tool ($02, $10);
function NewHandle (blockSize: longint; userID, memAttributes: integer;
memLocation: ptr): handle; tool($02, $09);
{- Imported from expression.pas --------------------------------}
procedure GenerateCode (tree: tokenPtr); extern;
@ -325,6 +343,17 @@ function UsualUnaryConversions: baseTypeEnum; extern;
{ outputs: }
{ expressionType - set to result type }
{- Imported from CGC.pas ---------------------------------------}
procedure CnvSC (rec: realrec); extern;
{ convert a real number to SANE comp format }
{ }
{ parameters: }
{ rec - record containing the value to convert; also }
{ has space for the result }
{---------------------------------------------------------------}
procedure CnOut (i: integer); extern;
@ -396,6 +425,16 @@ procedure ClearTable (table: symbolTable); extern;
{ clear the symbol table to all zeros }
procedure SaveBF (addr: ptr; bitdisp, bitsize: integer; val: longint); extern;
{ save a value to a bit-field }
{ }
{ parameters: }
{ addr - address to copy to }
{ bitdisp - displacement past the address }
{ bitsize - number of bits }
{ val - value to copy }
{---------------------------------------------------------------}
@ -663,6 +702,239 @@ procedure DoGlobals;
{ declare the ~globals and ~arrays segments }
procedure StaticInit (variable: identPtr);
{ statically initialize a variable }
type
{record of pointer initializers}
relocPtr = ^relocationRecord;
relocationRecord = record
next: relocPtr; {next record}
initializer: initializerPtr; {the initializer}
disp: longint; {disp in overall data structure}
end;
{pointers to each type}
bytePtr = ^byte;
wordPtr = ^integer;
longPtr = ^longint;
quadPtr = ^longlong;
realPtr = ^real;
doublePtr = ^double;
extendedPtr = ^extended;
var
buffPtr: ptr; {pointer to data buffer}
buffHandle: handle; {handle to data buffer}
count: integer; {# of duplicate records}
disp: longint; {disp into buffer (for output)}
endDisp: longint; {ending disp for current chunk}
i: integer; {loop counter}
ip: initializerPtr; {used to trace initializer lists}
lastReloc, nextReloc: relocPtr; {for reversing relocs list}
realVal: realRec; {used for extended-to-comp conversion}
relocs: relocPtr; {list of records needing relocation}
{pointers used to write data}
bp: bytePtr;
wp: wordPtr;
lp: longPtr;
qp: quadPtr;
rp: realPtr;
dp: doublePtr;
ep: extendedPtr;
procedure UpdateRelocs;
{ update relocation records to account for an initializer }
var
disp: longint; {disp of current initializer}
done: boolean; {done with loop?}
endDisp: longint; {disp at end of current initializer}
last: ^relocPtr; {the pointer referring to rp}
rp: relocPtr; {reloc record being processed}
begin {UpdateRelocs}
disp := ip^.disp;
if ip^.bitsize <> 0 then begin
endDisp := disp + (ip^.bitdisp + ip^.bitsize + 7) div 8;
disp := disp + ip^.bitdisp div 8;
end {if}
else if ip^.basetype = cgString then
endDisp := disp + ip^.sVal^.length
else
endDisp := disp + TypeSize(ip^.baseType);
last := @relocs;
rp := relocs;
done := false;
while (rp <> nil) and not done do begin
if rp^.disp + cgPointerSize <= disp then begin
{initializer is entirely after this reloc: no conflicts}
done := true;
end {if}
else if endDisp <= rp^.disp then begin
{initializer is entirely before this reloc}
last := @rp^.next;
rp := rp^.next;
end {else if}
else begin
{conflict: remove the conflicting reloc record}
last^ := rp^.next;
lp := pointer(ord4(buffPtr) + rp^.disp);
lp^ := 0;
dispose(rp);
rp := last^;
end; {else}
end; {while}
if ip^.basetype = ccPointer then begin
new(rp);
rp^.next := last^;
last^ := rp;
rp^.disp := ip^.disp;
rp^.initializer := ip;
end; {if}
end; {UpdateRelocs}
begin {StaticInit}
{allocate buffer}
{(+3 for possible bitfield overhang)}
buffHandle := NewHandle(variable^.itype^.size+3, UserID, $8000, nil);
if ToolError <> 0 then TermError(5);
buffPtr := buffHandle^;
relocs := nil; {evaluate initializers}
ip := variable^.iPtr;
while ip <> nil do begin
count := 0;
while count < ip^.count do begin
UpdateRelocs;
if ip^.bitsize <> 0 then begin
bp := pointer(ord4(buffPtr) + ip^.disp + count);
SaveBF(bp, ip^.bitdisp, ip^.bitsize, ip^.iVal);
end {if}
else
case ip^.basetype of
cgByte,cgUByte: begin
bp := pointer(ord4(buffPtr) + ip^.disp + count);
bp^ := ord(ip^.iVal) & $ff;
end;
cgWord,cgUWord: begin
wp := pointer(ord4(buffPtr) + ip^.disp + count);
wp^ := ord(ip^.iVal);
end;
cgLong,cgULong: begin
lp := pointer(ord4(buffPtr) + ip^.disp + count);
lp^ := ip^.iVal;
end;
cgQuad,cgUQuad: begin
qp := pointer(ord4(buffPtr) + ip^.disp + count);
qp^ := ip^.qVal;
end;
cgReal: begin
rp := pointer(ord4(buffPtr) + ip^.disp + count);
rp^ := ip^.rVal;
end;
cgDouble: begin
dp := pointer(ord4(buffPtr) + ip^.disp + count);
dp^ := ip^.rVal;
end;
cgExtended: begin
ep := pointer(ord4(buffPtr) + ip^.disp + count);
ep^ := ip^.rVal;
end;
cgComp: begin
realVal.itsReal := ip^.rVal;
CnvSC(realVal);
for i := 1 to 8 do begin
bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1);
bp^ := realVal.inCOMP[i];
end; {for}
end;
cgString: begin
for i := 1 to ip^.sVal^.length do begin
bp := pointer(ord4(buffPtr) + ip^.disp + count + i-1);
bp^ := ord(ip^.sVal^.str[i]);
end; {for}
end;
ccPointer: ; {handled by UpdateRelocs}
cgVoid: Error(57);
end; {case}
count := count + 1; {assumes count > 1 only for bytes}
end; {while}
ip := ip^.next;
end; {while}
lastReloc := nil; {reverse the relocs list}
while relocs <> nil do begin
nextReloc := relocs^.next;
relocs^.next := lastReloc;
lastReloc := relocs;
relocs := nextReloc;
end; {while}
relocs := lastReloc;
disp := 0; {generate the initialization data}
while disp < variable^.itype^.size do begin
if relocs = nil then
endDisp := variable^.itype^.size
else
endDisp := relocs^.disp;
while endDisp - disp >= 8 do begin
qp := pointer(ord4(buffPtr) + disp);
GenQ1(dc_cns, qp^, 1);
disp := disp + 8;
end; {while}
if endDisp - disp >= 4 then begin
lp := pointer(ord4(buffPtr) + disp);
GenL1(dc_cns, lp^, 1);
disp := disp + 4;
end; {if}
if endDisp - disp >= 2 then begin
wp := pointer(ord4(buffPtr) + disp);
Gen2t(dc_cns, wp^, 1, cgUWord);
disp := disp + 2;
end; {if}
if endDisp - disp >= 1 then begin
bp := pointer(ord4(buffPtr) + disp);
Gen2t(dc_cns, bp^, 1, cgUByte);
disp := disp + 1;
end; {if}
if relocs <> nil then begin
code^.optype := ccPointer;
code^.r := ord(relocs^.initializer^.pPlus);
code^.q := 1;
code^.pVal := relocs^.initializer^.pVal;
if relocs^.initializer^.isName then begin
code^.lab := relocs^.initializer^.pName;
code^.pstr := nil;
end {if}
else
code^.pstr := relocs^.initializer^.pstr;
Gen0(dc_cns);
lastReloc := relocs;
relocs := relocs^.next;
dispose(lastReloc);
disp := disp + cgPointerSize;
end; {if}
end; {while}
DisposeHandle(buffHandle);
end; {StaticInit}
procedure GenArrays;
{ define global arrays }
@ -697,38 +969,7 @@ procedure DoGlobals;
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^.basetype of
cgByte,cgUByte,cgWord,cgUWord: begin
lval := ip^.ival;
Gen2t(dc_cns, long(lval).lsw, ip^.count, ip^.basetype);
end;
cgLong,cgULong:
GenL1(dc_cns, ip^.ival, ip^.count);
cgQuad,cgUQuad:
GenQ1(dc_cns, ip^.qval, ip^.count);
cgReal,cgDouble,cgComp,cgExtended:
GenR1t(dc_cns, ip^.rval, ip^.count, ip^.basetype);
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}
StaticInit(sp);
end {if}
else begin
size := sp^.itype^.size;