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

@@ -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?}

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}

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

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;
+                  StaticInit(sp);
-                  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}
                   end {if}
                else begin
                   size := sp^.itype^.size;