* moved tasmlisttypedconstbuilder.tc_emit_string_offset() to

ttai_typedconstbuilder.emit_string_offset() so it can also be used outside
    the context of parsing a Pascal-level typed constant

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

compiler/aasmcnst.pas

@@ -226,6 +226,9 @@ type
        will be created/destroyed internally by these methods) }
      class function emit_ansistring_const(list: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding; newsection: boolean): tasmlabofs;
      class function emit_unicodestring_const(list: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
+     { emits a tasmlabofs as returned by emit_*string_const }
+     procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
+
      { emit a shortstring constant, and return its def }
      function emit_shortstring_const(const str: shortstring): tdef;
      { emit a guid constant }
@@ -1017,6 +1020,11 @@ implementation
        datatcb.free;
      end;
 
+   procedure ttai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
+     begin
+       emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
+     end;
+
 
    function ttai_typedconstbuilder.emit_shortstring_const(const str: shortstring): tdef;
      begin

compiler/llvm/nllvmtcon.pas

@@ -72,6 +72,7 @@ interface
       constructor create; override;
       destructor destroy; override;
       procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
+      procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
       procedure queue_init(todef: tdef); override;
       procedure queue_vecn(def: tdef; const index: tconstexprint); override;
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@@ -83,11 +84,6 @@ interface
     end;
 
 
-    tllvmasmlisttypedconstbuilder = class(tasmlisttypedconstbuilder)
-     protected
-      procedure tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
-    end;
-
 implementation
 
   uses
@@ -248,6 +244,42 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
+    var
+      srsym     : tsym;
+      srsymtable: tsymtable;
+      strrecdef : trecorddef;
+      offset: pint;
+      field: tfieldvarsym;
+      dataptrdef: tdef;
+    begin
+      { if the returned offset is <> 0, then the string data
+        starts at that offset -> translate to a field for the
+        high level code generator }
+      if ll.ofs<>0 then
+        begin
+          { get the recorddef for this string constant }
+          if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
+            internalerror(2014080406);
+          strrecdef:=trecorddef(ttypesym(srsym).typedef);
+          { offset in the record of the the string data }
+          offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
+          { field corresponding to this offset }
+          field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
+          { pointerdef to the string data array }
+          dataptrdef:=getpointerdef(field.vardef);
+          queue_init(charptrdef);
+          queue_addrn(dataptrdef,charptrdef);
+          queue_subscriptn(strrecdef,field);
+          queue_emit_asmsym(ll.lab,strrecdef);
+        end
+      else
+       { since llvm doesn't support labels in the middle of structs, this
+         offset should never be 0  }
+       internalerror(2014080506);
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
     var
       agg: tai_aggregatetypedconst;
@@ -454,46 +486,7 @@ implementation
     end;
 
 
-  { tllvmasmlisttypedconstbuilder }
-
-  procedure tllvmasmlisttypedconstbuilder.tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
-    var
-      srsym     : tsym;
-      srsymtable: tsymtable;
-      strrecdef : trecorddef;
-      offset: pint;
-      field: tfieldvarsym;
-      dataptrdef: tdef;
-    begin
-      { if the returned offset is <> 0, then the string data
-        starts at that offset -> translate to a field for the
-        high level code generator }
-      if ll.ofs<>0 then
-        begin
-          { get the recorddef for this string constant }
-          if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(st,winlikewidestring,strlength),srsym,srsymtable) then
-            internalerror(2014080406);
-          strrecdef:=trecorddef(ttypesym(srsym).typedef);
-          { offset in the record of the the string data }
-          offset:=ctai_typedconstbuilder.get_string_symofs(st,winlikewidestring);
-          { field corresponding to this offset }
-          field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
-          { pointerdef to the string data array }
-          dataptrdef:=getpointerdef(field.vardef);
-          ftcb.queue_init(charptrdef);
-          ftcb.queue_addrn(dataptrdef,charptrdef);
-          ftcb.queue_subscriptn(strrecdef,field);
-          ftcb.queue_emit_asmsym(ll.lab,strrecdef);
-        end
-      else
-       { since llvm doesn't support labels in the middle of structs, this
-         offset should never be 0  }
-       internalerror(2014080506);
-    end;
-
-
 begin
   ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
-  ctypedconstbuilder:=tllvmasmlisttypedconstbuilder;
 end.
 

compiler/ngtcon.pas

@@ -98,8 +98,6 @@ interface
         procedure tc_emit_setdef(def: tsetdef; var node: tnode);override;
         procedure tc_emit_enumdef(def: tenumdef; var node: tnode);override;
         procedure tc_emit_stringdef(def: tstringdef; var node: tnode);override;
-
-        procedure tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
        public
         constructor create(sym: tstaticvarsym);virtual;
         procedure parse_into_asmlist;
@@ -449,12 +447,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       end;
 
 
-    procedure tasmlisttypedconstbuilder.tc_emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);
-      begin
-        ftcb.emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),charptrdef);
-      end;
-
-
     procedure tasmlisttypedconstbuilder.tc_emit_stringdef(def: tstringdef; var node: tnode);
       var
         strlength : aint;
@@ -563,7 +555,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                      end
                    else
                      ll:=ctai_typedconstbuilder.emit_ansistring_const(fdatalist,strval,strlength,def.encoding,true);
-                   tc_emit_string_offset(ll,strlength,def.stringtype,false,charpointertype);
+                   ftcb.emit_string_offset(ll,strlength,def.stringtype,false,charpointertype);
                 end;
               st_unicodestring,
               st_widestring:
@@ -599,7 +591,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                            Include(tcsym.varoptions,vo_force_finalize);
                          end;
                      end;
-                  tc_emit_string_offset(ll,strlength,def.stringtype,winlike,widecharpointertype);
+                  ftcb.emit_string_offset(ll,strlength,def.stringtype,winlike,widecharpointertype);
                 end;
               else
                 internalerror(200107081);