+ initial llvm implementation of the ttai_typedconstbuilder class

o now simple typed constants (integer, floating pointer, pchar)
     and (non-variant) record typed constants containing such
     elements work for llvm

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

.gitattributes

@@ -349,6 +349,7 @@ compiler/llvm/nllvmcon.pas svneol=native#text/plain
 compiler/llvm/nllvmld.pas svneol=native#text/plain
 compiler/llvm/nllvmmat.pas svneol=native#text/plain
 compiler/llvm/nllvmmem.pas svneol=native#text/plain
+compiler/llvm/nllvmtcon.pas svneol=native#text/plain
 compiler/llvm/nllvmutil.pas svneol=native#text/plain
 compiler/llvm/rgllvm.pas svneol=native#text/plain
 compiler/llvm/tgllvm.pas svneol=native#text/plain

compiler/llvm/llvmnode.pas

@@ -38,7 +38,7 @@ implementation
     ncgadd,ncgcal,ncgmat,ncginl,
     tgllvm,hlcgllvm,
     nllvmadd,nllvmcal,nllvmcnv,nllvmcon,nllvmld,nllvmmat,nllvmmem,
-    nllvmutil,
+    nllvmtcon,nllvmutil,
     llvmpara;
 
 end.

compiler/llvm/nllvmtcon.pas

@@ -0,0 +1,341 @@
+{
+    Copyright (c) 2014 by Jonas Maebe
+
+    Generates code for typed constant declarations for the LLVM target
+
+    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 nllvmtcon;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cclasses,constexp,globtype,
+    aasmbase,aasmtai,aasmcnst,aasmllvm,
+    symtype,symdef,symsym,
+    ngtcon;
+
+  type
+    tllvmtai_typedconstbuilder = class(ttai_lowleveltypedconstbuilder)
+     protected
+      { aggregates (from outer to inner nested) that have been encountered,
+        if any }
+      faggregates: tfplist;
+
+      fqueued_def: tdef;
+      fqueued_tai,
+      flast_added_tai: tai;
+      fqueued_tai_opidx: longint;
+
+      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean); override;
+      { outerai: the ai that should become fqueued_tai in case it's still nil,
+          or that should be filled in the fqueued_tai_opidx of the current
+          fqueued_tai if it's not nil
+        innerai: the innermost ai (possibly an operand of outerai) in which
+          newindex indicates which operand is empty and can be filled with the
+          next queued tai }
+      procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
+      procedure emit_tai_intern(p: tai; def: tdef; procvar2procdef: boolean);
+     public
+      constructor create; override;
+      destructor destroy; override;
+      procedure emit_tai(p: tai; def: tdef); override;
+      procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
+      procedure maybe_begin_aggregate(def: tdef); override;
+      procedure maybe_end_aggregate(def: 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;
+      procedure queue_typeconvn(fromdef, todef: tdef); override;
+    end;
+
+implementation
+
+  uses
+    verbose,
+    aasmdata,
+    cpubase,llvmbase,
+    symconst,symtable,llvmdef,defutil;
+
+
+  procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; lab: boolean);
+    var
+      newasmlist: tasmlist;
+    begin
+      { todo }
+      if section = sec_user then
+        internalerror(2014052904);
+      newasmlist:=tasmlist.create_without_marker;
+      { llvm declaration with as initialisation data all the elements from the
+        original asmlist }
+      { TODO: propagate data/rodata different ("constant") }
+      newasmlist.concat(taillvmdecl.create(sym,def,fasmlist));
+      fasmlist:=newasmlist;
+    end;
+
+  procedure tllvmtai_typedconstbuilder.update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
+    begin
+      if assigned(fqueued_tai) then
+        begin
+          taillvm(flast_added_tai).loadtai(fqueued_tai_opidx,outerai);
+          { already flushed? }
+          if fqueued_tai_opidx=-1 then
+            internalerror(2014062201);
+        end
+      else
+        begin
+          fqueued_tai:=outerai;
+          fqueued_def:=resdef;
+        end;
+      fqueued_tai_opidx:=newindex;
+      flast_added_tai:=innerai;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.emit_tai_intern(p: tai; def: tdef; procvar2procdef: boolean);
+    var
+      ai: tai;
+      stc: tai_simpletypedconst;
+      kind: ttypedconstkind;
+    begin
+      if assigned(fqueued_tai) then
+        begin
+          if not procvar2procdef then
+            kind:=tck_simple
+          else
+            kind:=tck_simple_procvar2proc;
+          { finalise the queued expression }
+          ai:=tai_simpletypedconst.create(kind,def,p);
+          { set the new index to -1, so we internalerror should we try to
+            add anything further }
+          update_queued_tai(def,ai,ai,-1);
+          { and emit it }
+          p:=fqueued_tai;
+          def:=fqueued_def;
+          { ensure we don't try to emit this one again }
+          fqueued_tai:=nil;
+        end;
+      { these elements can be aggregates themselves, e.g. a shortstring can
+        be emitted as a series of bytes and string data arrays }
+      if not procvar2procdef then
+        kind:=aggregate_kind(def)
+      else
+        kind:=tck_simple_procvar2proc;
+      if not(kind in [tck_simple,tck_simple_procvar2proc]) and
+         (not assigned(faggregates) or
+          (faggregates.count=0) or
+          (tai_aggregatetypedconst(faggregates[faggregates.count-1]).adetyp<>kind)) then
+        internalerror(2014052906);
+      stc:=tai_simpletypedconst.create(tck_simple,def,p);
+      if assigned(faggregates) and
+         (faggregates.count>0) then
+        tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(stc)
+      else
+        inherited emit_tai(stc,def);
+    end;
+
+
+  constructor tllvmtai_typedconstbuilder.create;
+    begin
+      inherited create;
+      { constructed as needed }
+      faggregates:=nil;
+    end;
+
+
+  destructor tllvmtai_typedconstbuilder.destroy;
+    begin
+      faggregates.free;
+      inherited destroy;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.emit_tai(p: tai; def: tdef);
+    begin
+      emit_tai_intern(p,def,false);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
+    begin
+      emit_tai_intern(p,pvdef,true);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
+    var
+      agg: tai_aggregatetypedconst;
+      tck: ttypedconstkind;
+    begin
+      tck:=aggregate_kind(def);
+      if tck<>tck_simple then
+        begin
+          if not assigned(faggregates) then
+            faggregates:=tfplist.create;
+          agg:=tai_aggregatetypedconst.create(tck,def);
+          { nested aggregate -> add to parent }
+          if faggregates.count>0 then
+            tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(agg)
+          { otherwise add to asmlist }
+          else
+            fasmlist.concat(agg);
+          { new top level aggregate, future data will be added to it }
+          faggregates.add(agg);
+        end;
+      inherited;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.maybe_end_aggregate(def: tdef);
+    begin
+      if aggregate_kind(def)<>tck_simple then
+        begin
+          if not assigned(faggregates) or
+             (faggregates.count=0) then
+            internalerror(2014060101);
+          { already added to the asmlist if necessary }
+          faggregates.count:=faggregates.count-1;
+        end;
+      inherited;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
+    begin
+      inherited;
+      fqueued_tai:=nil;
+      flast_added_tai:=nil;
+      fqueued_tai_opidx:=-1;
+      fqueued_def:=todef;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint);
+    var
+      ai: taillvm;
+      eledef: tdef;
+    begin
+      { update range checking info }
+      inherited;
+      ai:=taillvm.getelementptr_reg_tai_size_const(NR_NO,nil,ptrsinttype,index.svalue,true);
+      case def.typ of
+        arraydef:
+          eledef:=tarraydef(def).elementdef;
+        stringdef:
+          case tstringdef(def).stringtype of
+            st_shortstring,
+            st_longstring,
+            st_ansistring:
+              eledef:=cansichartype;
+            st_widestring,
+            st_unicodestring:
+              eledef:=cwidechartype;
+            else
+              internalerror(2014062202);
+          end;
+        else
+          internalerror(2014062203);
+      end;
+      update_queued_tai(getpointerdef(eledef),ai,ai,1);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
+    var
+      getllvmfieldaddr,
+      getpascalfieldaddr: taillvm;
+      llvmfielddef: tdef;
+    begin
+      { update range checking info }
+      inherited;
+      llvmfielddef:=tabstractrecordsymtable(def.symtable).llvmst[vs.llvmfieldnr].def;
+      { get the address of the llvm-struct field that corresponds to this
+        Pascal field }
+      getllvmfieldaddr:=taillvm.getelementptr_reg_tai_size_const(NR_NO,nil,s32inttype,vs.llvmfieldnr,true);
+      { if it doesn't match the requested field exactly (variant record),
+        fixup the result }
+      getpascalfieldaddr:=getllvmfieldaddr;
+      if (vs.offsetfromllvmfield<>0) or
+         (llvmfielddef<>vs.vardef) then
+        begin
+          { offset of real field relative to llvm-struct field <> 0? }
+          if vs.offsetfromllvmfield<>0 then
+            begin
+              { convert to a pointer to a 1-sized element }
+              if llvmfielddef.size<>1 then
+                begin
+                  getpascalfieldaddr:=taillvm.op_reg_size_tai_size(la_bitcast,NR_NO,getpointerdef(llvmfielddef),getpascalfieldaddr,u8inttype);
+                  { update the current fielddef of the expression }
+                  llvmfielddef:=u8inttype;
+                end;
+              { add the offset }
+              getpascalfieldaddr:=taillvm.getelementptr_reg_tai_size_const(NR_NO,getpascalfieldaddr,ptrsinttype,vs.offsetfromllvmfield,true);
+            end;
+          { bitcast the data at the final offset to the right type }
+          if llvmfielddef<>vs.vardef then
+            getpascalfieldaddr:=taillvm.op_reg_size_tai_size(la_bitcast,NR_NO,getpointerdef(llvmfielddef),getpascalfieldaddr,getpointerdef(vs.vardef));
+        end;
+      update_queued_tai(getpointerdef(vs.vardef),getpascalfieldaddr,getllvmfieldaddr,1);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
+    var
+      ai: taillvm;
+      tmpintdef: tdef;
+      op,
+      firstop,
+      secondop: tllvmop;
+    begin
+      inherited;
+      op:=llvmconvop(fromdef,todef);
+      case op of
+        la_ptrtoint_to_x,
+        la_x_to_inttoptr:
+          begin
+            { convert via an integer with the same size as "x" }
+            if op=la_ptrtoint_to_x then
+              begin
+                tmpintdef:=cgsize_orddef(def_cgsize(todef));
+                firstop:=la_ptrtoint;
+                secondop:=la_bitcast
+              end
+            else
+              begin
+                tmpintdef:=cgsize_orddef(def_cgsize(fromdef));
+                firstop:=la_bitcast;
+                secondop:=la_inttoptr;
+              end;
+            { since we have to queue operations from outer to inner, first queue
+              the conversion from the tempintdef to the todef }
+            ai:=taillvm.op_reg_size_tai_size(secondop,NR_NO,tmpintdef,nil,todef);
+            update_queued_tai(todef,ai,ai,2);
+            todef:=tmpintdef;
+            op:=firstop
+          end;
+      end;
+      ai:=taillvm.op_reg_size_tai_size(op,NR_NO,fromdef,nil,todef);
+      update_queued_tai(todef,ai,ai,2);
+    end;
+
+
+begin
+  ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
+end.
+