+ code from the old llvm branch to create a "shadow symtable" for records

    that contains their mapping to LLVM (mainly getting rid of variant parts
    and adding explicit padding when not using {$packrecords c})

git-svn-id: branches/hlcgllvm@26988 -

compiler/symsym.pas

@@ -172,6 +172,15 @@ interface
           { offset in record/object, for bitpacked fields the offset is
             given in bit, else in bytes }
           fieldoffset   : asizeint;
+{$ifdef llvm}
+          { the llvm version of the record does not support variants,   }
+          { so the llvm equivalent field may not be at the exact same   }
+          { offset -> store the difference (bits for bitpacked records, }
+          { bytes otherwise)                                            }
+          offsetfromllvmfield : aint;
+          { number of the closest field in the llvm definition }
+          llvmfieldnr         : longint;
+{$endif llvm}
           externalname  : pshortstring;
 {$ifdef symansistr}
           cachedmangledname: TSymStr; { mangled name for ObjC or Java }

compiler/symtable.pas

@@ -70,13 +70,33 @@ interface
           procedure testfordefaultproperty(sym:TObject;arg:pointer);
        end;
 
+{$ifdef llvm}
+      tllvmshadowsymtableentry = class
+        constructor create(def: tdef; fieldoffset: aint);
+       private
+         ffieldoffset: aint;
+         fdef: tdef;
+       public
+         property fieldoffset: aint read ffieldoffset;
+         property def: tdef read fdef;
+       end;
+
+       tllvmshadowsymtable = class;
+{$endif llvm}
+
        tabstractrecordsymtable = class(tstoredsymtable)
+{$ifdef llvm}
+       private
+         fllvmst: tllvmshadowsymtable;
+         function getllvmshadowsymtabll: tllvmshadowsymtable;
+{$endif llvm}
        public
           usefieldalignment,     { alignment to use for fields (PACKRECORDS value), C_alignment is C style }
           recordalignment,       { alignment desired when inserting this record }
           fieldalignment,        { alignment current alignment used when fields are inserted }
           padalignment : shortint;   { size to a multiple of which the symtable has to be rounded up }
           constructor create(const n:string;usealign:shortint);
+          destructor destroy;override;
           procedure ppuload(ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure alignrecord(fieldoffset:asizeint;varalign:shortint);
@@ -101,6 +121,9 @@ interface
           function iscurrentunit: boolean; override;
           property datasize : asizeint read _datasize write setdatasize;
           property paddingsize: word read _paddingsize write _paddingsize;
+{$ifdef llvm}
+          property llvmst: tllvmshadowsymtable read getllvmshadowsymtabll;
+{$endif llvm}
        end;
 
        trecordsymtable = class(tabstractrecordsymtable)
@@ -115,6 +138,33 @@ interface
           function  checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override;
        end;
 
+{$ifdef llvm}
+       { llvm record definitions cannot contain variant/union parts, }
+       { you have to flatten them first. the tllvmshadowsymtable     }
+       { contains a flattened version of a record/object symtable    }
+       tllvmshadowsymtable = class
+        private
+         equivst: tabstractrecordsymtable;
+         curroffset: aint;
+         function get(index: longint): tllvmshadowsymtableentry;
+        public
+         symdeflist: TFPObjectList;
+
+         constructor create(st: tabstractrecordsymtable);
+         destructor destroy; override;
+        private
+         // generate the table
+         procedure generate;
+         // helpers
+         procedure appenddefoffset(vardef:tdef; fieldoffset: aint; derefclass: boolean);
+         procedure findvariantstarts(variantstarts: tfplist);
+         procedure addalignmentpadding(finalsize: aint);
+         procedure buildmapping(variantstarts: tfplist);
+         procedure buildtable(variantstarts: tfplist);
+         property items[index: longint]: tllvmshadowsymtableentry read get; default;
+       end;
+{$endif llvm}
+
        { tabstractlocalsymtable }
 
        tabstractlocalsymtable = class(tstoredsymtable)
@@ -860,6 +910,15 @@ implementation
                           TAbstractRecordSymtable
 ****************************************************************************}
 
+{$ifdef llvm}
+    function tabstractrecordsymtable.getllvmshadowsymtabll: tllvmshadowsymtable;
+      begin
+        if not assigned(fllvmst) then
+          fllvmst:=tllvmshadowsymtable.create(self);
+        result:=fllvmst;
+      end;
+{$endif llvm}
+
     constructor tabstractrecordsymtable.create(const n:string;usealign:shortint);
       begin
         inherited create(n);
@@ -883,6 +942,15 @@ implementation
       end;
 
 
+    destructor tabstractrecordsymtable.destroy;
+      begin
+{$ifdef llvm}
+        fllvmst.free;
+{$endif llvm}
+        inherited destroy;
+      end;
+
+
     procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile);
       begin
         if ppufile.readentry<>ibrecsymtableoptions then
@@ -1501,6 +1569,327 @@ implementation
       end;
 
 
+{$ifdef llvm}
+
+{****************************************************************************
+                              tLlvmShadowSymtableEntry
+****************************************************************************}
+
+    constructor tllvmshadowsymtableentry.create(def: tdef; fieldoffset: aint);
+      begin
+        fdef:=def;
+        ffieldoffset:=fieldoffset;
+      end;
+
+
+{****************************************************************************
+                              TLlvmShadowSymtable
+****************************************************************************}
+
+   function tllvmshadowsymtable.get(index: longint): tllvmshadowsymtableentry;
+      begin
+        result:=tllvmshadowsymtableentry(symdeflist[index])
+      end;
+
+
+    constructor tllvmshadowsymtable.create(st: tabstractrecordsymtable);
+      begin
+        equivst:=st;
+        curroffset:=0;
+        symdeflist:=tfpobjectlist.create(true);
+        generate;
+      end;
+
+
+    destructor tllvmshadowsymtable.destroy;
+      begin
+        symdeflist.free;
+      end;
+
+
+    procedure tllvmshadowsymtable.appenddefoffset(vardef:tdef; fieldoffset: aint; derefclass: boolean);
+      var
+        sizectr,
+        tmpsize: aint;
+      begin
+        case equivst.usefieldalignment of
+          C_alignment:
+            { default for llvm, don't add explicit padding }
+            symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
+          bit_alignment:
+            begin
+              { curoffset: bit address after the previous field.      }
+              { llvm has no special support for bitfields in records, }
+              { so we replace them with plain bytes.                  }
+              { as soon as a single bit of a byte is allocated, we    }
+              { allocate the byte in the llvm shadow record           }
+              if (fieldoffset>curroffset) then
+                curroffset:=align(curroffset,8);
+              { fields in bitpacked records always start either right }
+              { after the previous one, or at the next byte boundary. }
+              if (curroffset<>fieldoffset) then
+                internalerror(2008051002);
+              if is_ordinal(vardef) and
+                 (vardef.packedbitsize mod 8 <> 0) then
+                begin
+                  tmpsize:=vardef.packedbitsize;
+                  sizectr:=tmpsize+7;
+                  repeat
+                    symdeflist.add(tllvmshadowsymtableentry.create(u8inttype,fieldoffset+(tmpsize+7)-sizectr));
+                    dec(sizectr,8);
+                  until (sizectr<=0);
+                  inc(curroffset,tmpsize);
+                end
+              else
+                begin
+                  symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
+                  if not(derefclass) then
+                    inc(curroffset,vardef.size*8)
+                  else
+                    inc(curroffset,tobjectsymtable(tobjectdef(vardef).symtable).datasize*8);
+               end;
+            end
+          else
+            begin
+              { curoffset: address right after the previous field }
+              while (fieldoffset>curroffset) do
+                begin
+                  symdeflist.add(tllvmshadowsymtableentry.create(s8inttype,curroffset));
+                  inc(curroffset);
+                end;
+              symdeflist.add(tllvmshadowsymtableentry.create(vardef,fieldoffset));
+              if not(derefclass) then
+                inc(curroffset,vardef.size)
+              else
+                inc(curroffset,tobjectsymtable(tobjectdef(vardef).symtable).datasize);
+            end
+        end
+      end;
+
+
+    procedure tllvmshadowsymtable.addalignmentpadding(finalsize: aint);
+      begin
+        case equivst.usefieldalignment of
+          { already correct in this case }
+          bit_alignment,
+          { handled by llvm }
+          C_alignment:
+            ;
+          else
+            begin
+              { add padding fields }
+              while (finalsize>curroffset) do
+                begin
+                  symdeflist.add(tllvmshadowsymtableentry.create(s8inttype,curroffset));
+                  inc(curroffset);
+                end;
+            end;
+        end;
+      end;
+
+
+    procedure tllvmshadowsymtable.findvariantstarts(variantstarts: tfplist);
+      var
+        sym: tfieldvarsym;
+        lastoffset: aint;
+        newalignment: aint;
+        i, j: longint;
+      begin
+        i:=0;
+        while (i<equivst.symlist.count) do
+          begin
+            if (tsym(equivst.symlist[i]).typ<>fieldvarsym) then
+              begin
+                inc(i);
+                continue;
+              end;
+            sym:=tfieldvarsym(equivst.symlist[i]);
+            { a "better" algorithm might be to use the largest }
+            { variant in case of (bit)packing, since then      }
+            { alignment doesn't matter                         }
+            if (vo_is_first_field in sym.varoptions) then
+              begin
+                { we assume that all fields are processed in order. }
+                if (variantstarts.count<>0) then
+                  lastoffset:=tfieldvarsym(variantstarts[variantstarts.count-1]).fieldoffset
+                else
+                  lastoffset:=-1;
+
+                { new variant at same level as last one: use if higher alignment }
+                if (lastoffset=sym.fieldoffset) then
+                  begin
+                    if (equivst.fieldalignment<>bit_alignment) then
+                      newalignment:=used_align(sym.vardef.alignment,current_settings.alignment.recordalignmin,equivst.fieldalignment)
+                    else
+                      newalignment:=1;
+                    if (newalignment>tfieldvarsym(variantstarts[variantstarts.count-1]).vardef.alignment) then
+                      variantstarts[variantstarts.count-1]:=sym;
+                  end
+                { variant at deeper level than last one -> add }
+                else if (lastoffset<sym.fieldoffset) then
+                  variantstarts.add(sym)
+                else
+                  begin
+                    { a variant at a less deep level, so backtrack }
+                    j:=variantstarts.count-2;
+                    while (j>=0) do
+                      begin
+                        if (tfieldvarsym(variantstarts[j]).fieldoffset=sym.fieldoffset) then
+                          break;
+                        dec(j);
+                      end;
+                    if (j<0) then
+                      internalerror(2008051003);
+                    { new variant has higher alignment? }
+                    if (equivst.fieldalignment<>bit_alignment) then
+                      newalignment:=used_align(sym.vardef.alignment,current_settings.alignment.recordalignmin,equivst.fieldalignment)
+                    else
+                      newalignment:=1;
+                    { yes, replace and remove previous nested variants }
+                    if (newalignment>tfieldvarsym(variantstarts[j]).vardef.alignment) then
+                      begin
+                        variantstarts[j]:=sym;
+                        variantstarts.count:=j+1;
+                      end
+                   { no, skip this variant }
+                    else
+                      begin
+                        inc(i);
+                        while (i<equivst.symlist.count) and
+                              ((tsym(equivst.symlist[i]).typ<>fieldvarsym) or
+                               (tfieldvarsym(equivst.symlist[i]).fieldoffset>sym.fieldoffset)) do
+                          inc(i);
+                        continue;
+                      end;
+                  end;
+              end;
+            inc(i);
+          end;
+      end;
+
+
+    procedure tllvmshadowsymtable.buildtable(variantstarts: tfplist);
+      var
+        lastvaroffsetprocessed: aint;
+        i, equivcount, varcount: longint;
+      begin
+        { if it's an object/class, the first entry is the parent (if there is one) }
+        if (equivst.symtabletype=objectsymtable) and
+           assigned(tobjectdef(equivst.defowner).childof) then
+          appenddefoffset(tobjectdef(equivst.defowner).childof,0,is_class_or_interface_or_dispinterface(tobjectdef(equivst.defowner).childof));
+        equivcount:=equivst.symlist.count;
+        varcount:=0;
+        i:=0;
+        lastvaroffsetprocessed:=-1;
+        while (i<equivcount) do
+          begin
+            if (tsym(equivst.symlist[i]).typ<>fieldvarsym) then
+              begin
+                inc(i);
+                continue;
+              end;
+            { start of a new variant? }
+            if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
+              begin
+                { if we want to process the same variant offset twice, it means that we  }
+                { got to the end and are trying to process the next variant part -> stop }
+                if (tfieldvarsym(equivst.symlist[i]).fieldoffset<=lastvaroffsetprocessed) then
+                  break;
+
+                if (varcount>=variantstarts.count) then
+                  internalerror(2008051005);
+                { new variant part -> use the one with the biggest alignment }
+                i:=equivst.symlist.indexof(tobject(variantstarts[varcount]));
+                lastvaroffsetprocessed:=tfieldvarsym(equivst.symlist[i]).fieldoffset;
+                inc(varcount);
+                if (i<0) then
+                  internalerror(2008051004);
+              end;
+            appenddefoffset(tfieldvarsym(equivst.symlist[i]).vardef,tfieldvarsym(equivst.symlist[i]).fieldoffset,false);
+            inc(i);
+          end;
+        addalignmentpadding(equivst.datasize);
+      end;
+
+
+    procedure tllvmshadowsymtable.buildmapping(variantstarts: tfplist);
+      var
+        i, varcount: longint;
+        shadowindex: longint;
+        equivcount : longint;
+      begin
+        varcount:=0;
+        shadowindex:=0;
+        equivcount:=equivst.symlist.count;
+        i:=0;
+        while (i < equivcount) do
+          begin
+            if (tsym(equivst.symlist[i]).typ<>fieldvarsym) then
+              begin
+                inc(i);
+                continue;
+              end;
+            { start of a new variant? }
+            if (vo_is_first_field in tfieldvarsym(equivst.symlist[i]).varoptions) then
+              begin
+                { back up to a less deeply nested variant level? }
+                while (tfieldvarsym(equivst.symlist[i]).fieldoffset<tfieldvarsym(variantstarts[varcount]).fieldoffset) do
+                  dec(varcount);
+                { it's possible that some variants are more deeply nested than the
+                  one we recorded in the shadowsymtable (since we recorded the one
+                  with the biggest alignment, not necessarily the biggest one in size
+                }
+                if (tfieldvarsym(equivst.symlist[i]).fieldoffset>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
+                  varcount:=variantstarts.count-1
+                else if (tfieldvarsym(equivst.symlist[i]).fieldoffset<>tfieldvarsym(variantstarts[varcount]).fieldoffset) then
+                  internalerror(2008051006);
+                { reset the shadowindex to the start of this variant. }
+                { in case the llvmfieldnr is not (yet) set for this   }
+                { field, shadowindex will simply be reset to zero and }
+                { we'll start searching from the start of the record  }
+                shadowindex:=tfieldvarsym(variantstarts[varcount]).llvmfieldnr;
+                if (varcount<pred(variantstarts.count)) then
+                  inc(varcount);
+              end;
+
+            { find the last shadowfield whose offset <= the current field's offset }
+            while (tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset<tfieldvarsym(equivst.symlist[i]).fieldoffset) and
+                  (shadowindex<symdeflist.count-1) and
+                  (tllvmshadowsymtableentry(symdeflist[shadowindex+1]).fieldoffset>=tfieldvarsym(equivst.symlist[i]).fieldoffset) do
+              inc(shadowindex);
+            { set the field number and potential offset from that field (in case }
+            { of overlapping variants)                                           }
+            tfieldvarsym(equivst.symlist[i]).llvmfieldnr:=shadowindex;
+            tfieldvarsym(equivst.symlist[i]).offsetfromllvmfield:=
+              tfieldvarsym(equivst.symlist[i]).fieldoffset-tllvmshadowsymtableentry(symdeflist[shadowindex]).fieldoffset;
+            inc(i);
+          end;
+      end;
+
+
+    procedure tllvmshadowsymtable.generate;
+      var
+        variantstarts: tfplist;
+      begin
+        variantstarts:=tfplist.create;
+
+        { first go through the entire record and }
+        { store the fieldvarsyms of the variants }
+        { with the highest alignment             }
+        findvariantstarts(variantstarts);
+
+        { now go through the regular fields and the selected variants, }
+        { and add them to the  llvm shadow record symtable             }
+        buildtable(variantstarts);
+
+        { finally map all original fields to the llvm definition }
+        buildmapping(variantstarts);
+
+        variantstarts.free;
+      end;
+
+{$endif llvm}
+
 {****************************************************************************
                           TAbstractLocalSymtable
 ****************************************************************************}