From 28e119afb1514e74415ff68dffe2fa0aa5936143 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Fri, 2 Dec 2022 21:55:57 -0600 Subject: [PATCH] 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. --- CCommon.pas | 2 +- Parser.pas | 6 ++ Symbol.asm | 16 +++ Symbol.pas | 305 ++++++++++++++++++++++++++++++++++++++++++++++------ 4 files changed, 296 insertions(+), 33 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index af35a38..102d4a0 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -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?} diff --git a/Parser.pas b/Parser.pas index 38163f0..31f9b87 100644 --- a/Parser.pas +++ b/Parser.pas @@ -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} diff --git a/Symbol.asm b/Symbol.asm index d01c3cf..03c5317 100644 --- a/Symbol.asm +++ b/Symbol.asm @@ -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 diff --git a/Symbol.pas b/Symbol.pas index 5a65dd7..a338e4c 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -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;