* migrated the handling of ansi/unicodestring constants to the high level

typed constant builder + llvm implementation

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

.gitattributes

@@ -106,7 +106,6 @@ compiler/arm/rarmstd.inc svneol=native#text/plain
 compiler/arm/rarmsup.inc svneol=native#text/plain
 compiler/arm/rgcpu.pas svneol=native#text/plain
 compiler/arm/symcpu.pas svneol=native#text/plain
-compiler/asmutils.pas svneol=native#text/plain
 compiler/assemble.pas svneol=native#text/plain
 compiler/avr/aasmcpu.pas svneol=native#text/plain
 compiler/avr/agavrgas.pas svneol=native#text/plain

compiler/aasmcnst.pas

@@ -95,6 +95,11 @@ type
    end;
 
 
+    tasmlabofs = record
+      lab: tasmlabel;
+      ofs: asizeint;
+    end;
+
    { Warning: never directly create a ttai_typedconstbuilder instance,
      instead create a cai_typedconstbuilder (this class can be overridden) }
    ttai_lowleveltypedconstbuilder = class abstract
@@ -124,6 +129,17 @@ type
        want to use it explicitly as a procdef (i.e., not as a record with a
        code and data pointer in case of a complex procvardef) }
      procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual;
+
+    protected
+     function emit_string_const_common(list: TAsmList; stringtype: tstringtype; len: asizeint; encoding: tstringencoding; out startlab: tasmlabel):tasmlabofs;
+    public
+     class function get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
+     { class functions and an extra list parameter, because emitting the data
+       for the strings has to happen via a separate typed const builder (which
+       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;
+
      { begin a potential aggregate type. Must be called for any type
        that consists of multiple tai constant data entries, or that
        represents an aggregate at the Pascal level (a record, a non-dynamic
@@ -515,6 +531,151 @@ implementation
      end;
 
 
+   function ttai_lowleveltypedconstbuilder.emit_string_const_common(list: TAsmList; stringtype: tstringtype; len: asizeint; encoding: tstringencoding; out startlab: tasmlabel): tasmlabofs;
+     var
+       string_symofs: asizeint;
+       elesize: word;
+     begin
+       current_asmdata.getdatalabel(result.lab);
+       startlab:=result.lab;
+       result.ofs:=0;
+       begin_anonymous_record;
+       string_symofs:=get_string_symofs(stringtype,false);
+       { encoding }
+       emit_tai(tai_const.create_16bit(encoding),u16inttype);
+       inc(result.ofs,2);
+       { element size }
+       case stringtype of
+         st_ansistring:
+           elesize:=1;
+         st_unicodestring:
+           elesize:=2;
+         else
+           internalerror(2014080401);
+       end;
+       emit_tai(tai_const.create_16bit(elesize),u16inttype);
+       inc(result.ofs,2);
+{$ifdef cpu64bitaddr}
+       { dummy for alignment }
+       emit_tai(tai_const.create_32bit(0),u32inttype);
+       inc(result.ofs,4);
+{$endif cpu64bitaddr}
+       emit_tai(tai_const.create_pint(-1),ptrsinttype);
+       inc(result.ofs,sizeof(pint));
+       emit_tai(tai_const.create_pint(len),ptrsinttype);
+       inc(result.ofs,sizeof(pint));
+       if string_symofs=0 then
+         begin
+           { results in slightly more efficient code }
+           list.concat(tai_label.create(result.lab));
+           result.ofs:=0;
+           current_asmdata.getdatalabel(startlab);
+         end;
+       { sanity check }
+       if result.ofs<>string_symofs then
+         internalerror(2012051701);
+     end;
+
+
+   class function ttai_lowleveltypedconstbuilder.get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
+     begin
+       case typ of
+         st_ansistring:
+           result:='ansistrrec';
+         st_unicodestring,
+         st_widestring:
+           if (typ=st_unicodestring) or
+              not winlike then
+             result:='unicodestrrec'
+           else
+             result:='widestrrec';
+         else
+           internalerror(2014080402);
+       end;
+       result:=result+tostr(len);
+     end;
+
+
+   class function ttai_lowleveltypedconstbuilder.emit_ansistring_const(list: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding; newsection: boolean): tasmlabofs;
+     var
+       s: PChar;
+       startlab: tasmlabel;
+       sectype: TAsmSectiontype;
+       ansistrrecdef: trecorddef;
+       datadef: tdef;
+       datatcb: ttai_lowleveltypedconstbuilder;
+     begin
+       datatcb:=self.create;
+       result:=datatcb.emit_string_const_common(list,st_ansistring,len,encoding,startlab);
+
+       getmem(s,len+1);
+       move(data^,s^,len);
+       s[len]:=#0;
+       { terminating zero included }
+       datadef:=getarraydef(cansichartype,len+1);
+       datatcb.maybe_begin_aggregate(datadef);
+       datatcb.emit_tai(tai_string.create_pchar(s,len+1),datadef);
+       datatcb.maybe_end_aggregate(datadef);
+       ansistrrecdef:=datatcb.end_anonymous_record('$'+get_dynstring_rec_name(st_ansistring,false,len),sizeof(pint));
+       if NewSection then
+         sectype:=sec_rodata_norel
+       else
+         sectype:=sec_none;
+       list.concatlist(datatcb.get_final_asmlist(startlab,ansistrrecdef,sectype,startlab.name,const_align(sizeof(pint)),true));
+       datatcb.free;
+     end;
+
+
+   class function ttai_lowleveltypedconstbuilder.emit_unicodestring_const(list: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
+     var
+       i, strlength: longint;
+       string_symofs: asizeint;
+       startlab: tasmlabel;
+       datadef: tdef;
+       uniwidestrrecdef: trecorddef;
+       datatcb: ttai_lowleveltypedconstbuilder;
+     begin
+       datatcb:=self.create;
+       strlength:=getlengthwidestring(pcompilerwidestring(data));
+       if winlike then
+         begin
+           current_asmdata.getdatalabel(result.lab);
+           datatcb.emit_tai(Tai_const.Create_32bit(strlength*cwidechartype.size),s32inttype);
+           { can we optimise by placing the string constant label at the
+             required offset? }
+           string_symofs:=get_string_symofs(st_widestring,true);
+           if string_symofs=0 then
+             begin
+               { yes }
+               datatcb.emit_tai(Tai_label.Create(result.lab),widecharpointertype);
+               { allocate a separate label for the start of the data }
+               current_asmdata.getdatalabel(startlab);
+             end;
+           result.ofs:=string_symofs;
+         end
+       else
+         begin
+           result:=datatcb.emit_string_const_common(list,st_unicodestring,strlength,encoding,startlab);
+         end;
+       if cwidechartype.size = 2 then
+         begin
+           datadef:=getarraydef(cwidechartype,strlength+1);
+           datatcb.maybe_begin_aggregate(datadef);
+           for i:=0 to strlength-1 do
+             datatcb.emit_tai(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]),cwidechartype);
+           { ending #0 }
+           datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
+           datatcb.maybe_end_aggregate(datadef);
+           uniwidestrrecdef:=datatcb.end_anonymous_record('$'+get_dynstring_rec_name(st_widestring,winlike,strlength),sizeof(pint));
+         end
+       else
+         { code generation for other sizes must be written }
+         internalerror(200904271);
+       list.concatlist(datatcb.get_final_asmlist(startlab,uniwidestrrecdef,sec_rodata_norel,startlab.name,const_align(sizeof(pint)),true));
+       datatcb.free;
+     end;
+
+
    procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
      begin
        { do nothing }

compiler/asmutils.pas

@@ -1,157 +0,0 @@
-{
-    Copyright (c) 1998-2006 by Florian Klaempfl
-
-    This unit contains utility functions for assembler output
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit asmutils;
-
-interface
-
-{$i fpcdefs.inc}
-
-uses
-  globtype,
-  aasmbase,
-  aasmdata,
-  symconst;
-
-    type
-      tasmlabofs = record
-        lab: tasmlabel;
-        ofs: pint;
-      end;
-
-    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean=True):tasmlabofs;
-    function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;Winlike:Boolean):tasmlabofs;
-
-
-implementation
-
-uses
-  globals,
-  systems,
-  verbose,
-  aasmtai,aasmcnst,
-  widestr,
-  symdef;
-
-    function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean): tasmlabofs;
-      var
-        s: PChar;
-      begin
-        current_asmdata.getdatalabel(result.lab);
-        result.ofs:=0;
-        if NewSection then
-          begin
-            maybe_new_object_file(list);
-            new_section(list,sec_rodata_norel,result.lab.name,const_align(sizeof(pint)));
-          end;
-        { put label before header on Darwin, because there the linker considers
-          a global symbol to be the start of a new subsection }
-        if target_info.system in systems_darwin then
-          list.concat(tai_label.create(result.lab));
-        list.concat(tai_const.create_16bit(encoding));
-        inc(result.ofs,2);
-        list.concat(tai_const.create_16bit(1));
-        inc(result.ofs,2);
-{$ifdef cpu64bitaddr}
-        { dummy for alignment }
-        list.concat(tai_const.create_32bit(0));
-        inc(result.ofs,4);
-{$endif cpu64bitaddr}
-        list.concat(tai_const.create_pint(-1));
-        inc(result.ofs,sizeof(pint));
-        list.concat(tai_const.create_pint(len));
-        inc(result.ofs,sizeof(pint));
-        if not(target_info.system in systems_darwin) then
-          begin
-            { results in slightly more efficient code }
-            list.concat(tai_label.create(result.lab));
-            result.ofs:=0;
-          end;
-        { sanity check }
-        if result.ofs<>ctai_typedconstbuilder.get_string_symofs(st_ansistring,false) then
-          internalerror(2012051701);
-
-        getmem(s,len+1);
-        move(data^,s^,len);
-        s[len]:=#0;
-        list.concat(tai_string.create_pchar(s,len+1)); { terminating zero included }
-      end;
-
-
-    function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;Winlike:Boolean):tasmlabofs;
-      var
-        i, strlength: SizeInt;
-      begin
-        current_asmdata.getdatalabel(result.lab);
-        result.ofs:=0;
-        maybe_new_object_file(list);
-        new_section(list,sec_rodata_norel,result.lab.name,const_align(sizeof(pint)));
-        strlength := getlengthwidestring(pcompilerwidestring(data));
-        if Winlike then
-          begin
-            list.concat(Tai_const.Create_32bit(strlength*cwidechartype.size));
-            { don't increase result.ofs, this is how Windows widestrings are
-              defined by the OS: a pointer 4 bytes past the length of the
-              string }
-            list.concat(Tai_label.Create(result.lab));
-          end
-        else
-          begin
-            { put label before header on Darwin, because there the linker considers
-              a global symbol to be the start of a new subsection }
-            if target_info.system in systems_darwin then
-              list.concat(Tai_label.Create(result.lab));
-            list.concat(tai_const.create_16bit(encoding));
-            inc(result.ofs,2);
-            list.concat(tai_const.create_16bit(2));
-            inc(result.ofs,2);
-    {$ifdef cpu64bitaddr}
-            { dummy for alignment }
-            list.concat(Tai_const.Create_32bit(0));
-            inc(result.ofs,4);
-    {$endif cpu64bitaddr}
-            list.concat(Tai_const.Create_pint(-1));
-            inc(result.ofs,sizeof(pint));
-            list.concat(Tai_const.Create_pint(strlength));
-            inc(result.ofs,sizeof(pint));
-            if not(target_info.system in systems_darwin) then
-              begin
-                { results in slightly more efficient code }
-                list.concat(tai_label.create(result.lab));
-                result.ofs:=0;
-              end;
-            { sanity check }
-            if result.ofs<>ctai_typedconstbuilder.get_string_symofs(st_unicodestring,false) then
-              internalerror(2012051702);
-          end;
-        if cwidechartype.size = 2 then
-          begin
-            for i:=0 to strlength-1 do
-              list.concat(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]));
-            { ending #0 }
-            list.concat(Tai_const.Create_16bit(0));
-          end
-        else
-          InternalError(200904271); { codegeneration for other sizes must be written }
-      end;
-
-
-end.

compiler/cresstr.pas

@@ -32,16 +32,15 @@ implementation
 
 uses
    SysUtils,
+{$if FPC_FULLVERSION<20700}
+   ccharset,
+{$endif}
    cclasses,widestr,
    cutils,globtype,globals,systems,
    symconst,symtype,symdef,symsym,
    verbose,fmodule,ppu,
-   aasmbase,aasmtai,aasmdata,
+   aasmbase,aasmtai,aasmdata,aasmcnst,
-   aasmcpu,
+   aasmcpu;
-{$if FPC_FULLVERSION<20700}
-   ccharset,
-{$endif}
-   asmutils;
 
     Type
       { These are used to form a singly-linked list, ordered by hash value }
@@ -150,7 +149,7 @@ uses
           make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0));
 
         { Write unitname entry }
-        namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False);
+        namelab:=ctai_typedconstbuilder.emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.Create_sym_offset(namelab.lab,namelab.ofs));
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
         current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_nil_dataptr);
@@ -166,7 +165,7 @@ uses
             new_section(current_asmdata.asmlists[al_const],sec_rodata_norel,make_mangledname('RESSTR',current_module.localsymtable,'d_'+r.name),sizeof(pint));
             { Write default value }
             if assigned(R.value) and (R.len<>0) then
-              valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage,False)
+              valuelab:=ctai_typedconstbuilder.emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage,False)
             else
               begin
                 valuelab.lab:=nil;
@@ -174,7 +173,7 @@ uses
               end;
             { Append the name as a ansistring. }
             current_asmdata.asmlists[al_const].concat(cai_align.Create(const_align(sizeof(pint))));
-            namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage,False);
+            namelab:=ctai_typedconstbuilder.emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage,False);
 
             {
               Resourcestring index:

compiler/llvm/nllvmcon.pas

@@ -27,7 +27,8 @@ unit nllvmcon;
 interface
 
     uses
-       node,ncgcon;
+      symtype,
+      node,ncgcon;
 
     type
        tllvmrealconstnode = class(tcgrealconstnode)
@@ -37,14 +38,16 @@ interface
 
        tllvmstringconstnode = class(tcgstringconstnode)
           procedure pass_generate_code; override;
+       protected
+          procedure load_dynstring(const strpointerdef: tdef; const elementdef: tdef; const winlikewidestring: boolean); override;
        end;
 
 implementation
 
     uses
-      globtype,verbose,cutils,
+      globtype,globals,verbose,cutils,
-      symtype,symdef,defutil,
+      symbase,symtable,symconst,symdef,symsym,defutil,
-      aasmdata,
+      aasmdata,aasmcnst,
       ncon,
       llvmbase,aasmllvm,hlcgobj,
       cgbase,cgutils;
@@ -87,6 +90,49 @@ implementation
           end;
       end;
 
+
+    procedure tllvmstringconstnode.load_dynstring(const strpointerdef: tdef; const elementdef: tdef; const winlikewidestring: boolean);
+      var
+        stringtype: tstringtype;
+        strrecdef: trecorddef;
+        srsym: tsym;
+        srsymtable: tsymtable;
+        offset: pint;
+        field: tfieldvarsym;
+        dataptrdef: tdef;
+        reg: tregister;
+        href: treference;
+      begin
+        case cst_type of
+          cst_ansistring:
+            stringtype:=st_ansistring;
+          cst_unicodestring:
+            stringtype:=st_unicodestring;
+          cst_widestring:
+            stringtype:=st_widestring;
+          else
+            internalerror(2014040804);
+        end;
+        { get the recorddef for this string constant }
+        if not searchsym_type(ctai_typedconstbuilder.get_dynstring_rec_name(stringtype,winlikewidestring,len),srsym,srsymtable) then
+          internalerror(2014080405);
+        strrecdef:=trecorddef(ttypesym(srsym).typedef);
+        { offset in the record of the the string data }
+        offset:=ctai_typedconstbuilder.get_string_symofs(stringtype,winlikewidestring);
+        { field corresponding to this offset }
+        field:=trecordsymtable(strrecdef.symtable).findfieldbyoffset(offset);
+        { pointerdef to the string data array }
+        dataptrdef:=getpointerdef(field.vardef);
+        { load the address of the string data }
+        reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,dataptrdef);
+        reference_reset_symbol(href, lab_str, 0, const_align(strpointerdef.size));
+        current_asmdata.CurrAsmList.concat(
+          taillvm.getelementptr_reg_size_ref_size_const(reg,dataptrdef,href,
+          s32inttype,field.llvmfieldnr,true));
+        { convert into a pointer to the individual elements }
+        hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,dataptrdef,strpointerdef,reg,location.register);
+      end;
+
 {*****************************************************************************
                            tllvmrealconstnode
 *****************************************************************************}

compiler/llvm/nllvmtcon.pas

@@ -73,6 +73,12 @@ interface
       class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
     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
@@ -435,7 +441,46 @@ 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/ncgcon.pas

@@ -28,6 +28,7 @@ interface
 
     uses
        aasmbase,
+       symtype,
        node,ncon;
 
     type
@@ -49,6 +50,8 @@ interface
 
        tcgstringconstnode = class(tstringconstnode)
           procedure pass_generate_code;override;
+       protected
+         procedure load_dynstring(const strpointerdef: tdef; const elementdef: tdef; const winlikewidestring: boolean); virtual;
        end;
 
        tcgsetconstnode = class(tsetconstnode)
@@ -77,7 +80,7 @@ implementation
       symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
       cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
-      ncgutil,hlcgobj,symtype,cclasses,asmutils,tgobj
+      ncgutil,hlcgobj,cclasses,tgobj
       ;
 
 
@@ -261,7 +264,6 @@ implementation
          lastlabel: tasmlabofs;
          pc: pchar;
          l: longint;
-         href: treference;
          pool: THashSet;
          entry: PHashSetItem;
          winlikewidestring: boolean;
@@ -330,7 +332,7 @@ implementation
                              InternalError(2008032301)   { empty string should be handled above }
                            else
                              begin
-                               lastlabel:=emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding);
+                               lastlabel:=ctai_typedconstbuilder.emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding,true);
                                { because we hardcode the offset below due to it
                                  not being stored in the hashset, check here }
                                if lastlabel.ofs<>ctai_typedconstbuilder.get_string_symofs(st_ansistring,false) then
@@ -344,7 +346,7 @@ implementation
                              InternalError(2008032302)   { empty string should be handled above }
                            else
                              begin
-                               lastlabel := emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
+                               lastlabel:=ctai_typedconstbuilder.emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
                                                value_str,
                                                tstringdef(resultdef).encoding,
                                                winlikewidestring);
@@ -410,11 +412,8 @@ implementation
          if cst_type in [cst_ansistring, cst_widestring, cst_unicodestring] then
            begin
              location_reset(location, LOC_REGISTER, def_cgsize(strpointerdef));
-             reference_reset_symbol(href, lab_str,
-               ctai_typedconstbuilder.get_string_symofs(tstringdef(resultdef).stringtype,winlikewidestring),
-               const_align(strpointerdef.size));
              location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,strpointerdef);
-             hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,elementdef,strpointerdef,href,location.register)
+             load_dynstring(strpointerdef, elementdef, winlikewidestring);
            end
          else
            begin
@@ -424,6 +423,17 @@ implementation
       end;
 
 
+    procedure tcgstringconstnode.load_dynstring(const strpointerdef: tdef; const elementdef: tdef; const winlikewidestring: boolean);
+      var
+        href: treference;
+      begin
+        reference_reset_symbol(href, lab_str,
+          ctai_typedconstbuilder.get_string_symofs(tstringdef(resultdef).stringtype, winlikewidestring),
+          const_align(strpointerdef.size));
+        hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList, elementdef, strpointerdef, href, location.register)
+      end;
+
+
 {*****************************************************************************
                            TCGSETCONSTNODE
 *****************************************************************************}

compiler/ngtcon.pas

@@ -29,7 +29,7 @@ interface
       globtype,cclasses,constexp,
       aasmbase,aasmdata,aasmtai,aasmcnst,
       node,nbas,
-      symtype, symbase, symdef,symsym;
+      symconst, symtype, symbase, symdef,symsym;
 
 
     type
@@ -99,6 +99,8 @@ 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;
@@ -143,7 +145,7 @@ uses
    SysUtils,
    systems,tokens,verbose,
    cutils,globals,widestr,scanner,
-   symconst,symtable,
+   symtable,
    aasmcpu,defutil,defcmp,
    { pass 1 }
    htypechk,procinfo,
@@ -152,7 +154,7 @@ uses
    pbase,pexpr,pdecvar,
    { codegen }
    cpuinfo,cgbase,dbgbase,
-   wpobase,asmutils
+   wpobase
    ;
 
 {$maxfpuregisters 0}
@@ -444,6 +446,12 @@ 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;
@@ -551,8 +559,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                        ll.ofs:=0;
                      end
                    else
-                     ll:=emit_ansistring_const(current_asmdata.asmlists[al_const],strval,strlength,def.encoding);
+                     ll:=ctai_typedconstbuilder.emit_ansistring_const(current_asmdata.asmlists[al_const],strval,strlength,def.encoding,true);
-                   ftcb.emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),getpointerdef(cansichartype));
+                   tc_emit_string_offset(ll,strlength,def.stringtype,false,charpointertype);
                 end;
               st_unicodestring,
               st_widestring:
@@ -566,7 +574,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                    else
                      begin
                        winlike:=(def.stringtype=st_widestring) and (tf_winlikewidestring in target_info.flags);
-                       ll:=emit_unicodestring_const(current_asmdata.asmlists[al_const],
+                       ll:=ctai_typedconstbuilder.emit_unicodestring_const(current_asmdata.asmlists[al_const],
                               strval,
                               def.encoding,
                               winlike);
@@ -588,7 +596,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                            Include(tcsym.varoptions,vo_force_finalize);
                          end;
                      end;
-                   ftcb.emit_tai(Tai_const.Create_sym_offset(ll.lab,ll.ofs),getpointerdef(cwidechartype));
+                  tc_emit_string_offset(ll,strlength,def.stringtype,winlike,widecharpointertype);
                 end;
               else
                 internalerror(200107081);