* reintegrated hlcgllvm branch. Note that llvm support is NOT complete yet

    and won't be for quite some time. This merge is mainly to get the
    high level typed constant builder into trunk, and to avoid conflicts
    when code is modified that was moved/refactored in the hlcgllvm branch

git-svn-id: trunk@30351 -

.gitattributes

@@ -47,6 +47,7 @@ compiler/aarch64/racpugas.pas svneol=native#text/plain
 compiler/aarch64/rgcpu.pas svneol=native#text/plain
 compiler/aarch64/symcpu.pas svneol=native#text/plain
 compiler/aasmbase.pas svneol=native#text/plain
+compiler/aasmcnst.pas svneol=native#text/plain
 compiler/aasmdata.pas svneol=native#text/plain
 compiler/aasmsym.pas svneol=native#text/plain
 compiler/aasmtai.pas svneol=native#text/plain
@@ -120,7 +121,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
@@ -346,6 +346,30 @@ compiler/jvm/symcpu.pas svneol=native#text/plain
 compiler/jvm/tgcpu.pas svneol=native#text/plain
 compiler/ldscript.pas svneol=native#text/plain
 compiler/link.pas svneol=native#text/plain
+compiler/llvm/aasmllvm.pas svneol=native#text/plain
+compiler/llvm/agllvm.pas svneol=native#text/plain
+compiler/llvm/cgllvm.pas svneol=native#text/plain
+compiler/llvm/hlcgllvm.pas svneol=native#text/plain
+compiler/llvm/itllvm.pas svneol=native#text/plain
+compiler/llvm/llvmbase.pas svneol=native#text/plain
+compiler/llvm/llvmdef.pas svneol=native#text/plain
+compiler/llvm/llvminfo.pas svneol=native#text/plain
+compiler/llvm/llvmnode.pas svneol=native#text/plain
+compiler/llvm/llvmpara.pas svneol=native#text/plain
+compiler/llvm/llvmsym.pas svneol=native#text/plain
+compiler/llvm/llvmtarg.pas svneol=native#text/plain
+compiler/llvm/nllvmadd.pas svneol=native#text/plain
+compiler/llvm/nllvmcal.pas svneol=native#text/plain
+compiler/llvm/nllvmcnv.pas svneol=native#text/plain
+compiler/llvm/nllvmcon.pas svneol=native#text/plain
+compiler/llvm/nllvminl.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/m68k/aasmcpu.pas svneol=native#text/plain
 compiler/m68k/ag68kgas.pas svneol=native#text/plain
 compiler/m68k/aoptcpu.pas svneol=native#text/plain
@@ -454,6 +478,7 @@ compiler/ncgcal.pas svneol=native#text/plain
 compiler/ncgcnv.pas svneol=native#text/plain
 compiler/ncgcon.pas svneol=native#text/plain
 compiler/ncgflw.pas svneol=native#text/plain
+compiler/ncghlmat.pas svneol=native#text/plain
 compiler/ncginl.pas svneol=native#text/plain
 compiler/ncgld.pas svneol=native#text/plain
 compiler/ncgmat.pas svneol=native#text/plain
@@ -8395,6 +8420,7 @@ rtl/inc/dynlib.inc svneol=native#text/plain
 rtl/inc/dynlibh.inc svneol=native#text/plain
 rtl/inc/dynlibs.pas svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
+rtl/inc/excepth.inc svneol=native#text/plain
 rtl/inc/exeinfo.pp svneol=native#text/plain
 rtl/inc/extres.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain
@@ -13894,7 +13920,7 @@ tests/webtbs/tw19548.pp svneol=native#text/pascal
 tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw19581.pp svneol=native#text/plain
 tests/webtbs/tw19610.pp svneol=native#text/plain
-tests/webtbs/tw19622.pp -text svneol=native#text/plain
+tests/webtbs/tw19622.pp svneol=native#text/plain
 tests/webtbs/tw1964.pp svneol=native#text/plain
 tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19697.pp svneol=native#text/pascal

compiler/aarch64/aasmcpu.pas

@@ -1063,14 +1063,9 @@ implementation
                                         if (tai_const(hp).consttype=aitconst_64bit) then
                                           inc(extradataoffset);
                                       end;
-                                    ait_comp_64bit,
-                                    ait_real_64bit:
+                                    ait_realconst:
                                       begin
-                                        inc(extradataoffset);
-                                      end;
-                                    ait_real_80bit:
-                                      begin
-                                        inc(extradataoffset,2);
+                                        inc(extradataoffset,((tai_realconst(hp).savesize-4+3) div 4));
                                       end;
                                   end;
                                   if (hp.typ=ait_const) then
@@ -1124,18 +1119,9 @@ implementation
                   if (tai_const(curtai).consttype=aitconst_64bit) then
                     inc(curinspos);
                 end;
-              ait_real_32bit:
-                begin
-                  inc(curinspos);
-                end;
-              ait_comp_64bit,
-              ait_real_64bit:
-                begin
-                  inc(curinspos,2);
-                end;
-              ait_real_80bit:
+              ait_realconst:
                 begin
-                  inc(curinspos,3);
+                  inc(curinspos,(tai_realconst(hp).savesize+3) div 4);
                 end;
             end;
             { special case for case jump tables }

compiler/aarch64/cgcpu.pas

@@ -36,13 +36,13 @@ interface
     type
       tcgaarch64=class(tcg)
        protected
+        { changes register size without adding register allocation info }
+        function makeregsize(reg: tregister; size: tcgsize): tregister; overload;
+       public
         { simplifies "ref" so it can be used with "op". If "ref" can be used
           with a different load/Store operation that has the same meaning as the
           original one, "op" will be replaced with the alternative }
         procedure make_simple_ref(list:TAsmList; var op: tasmop; size: tcgsize; oppostfix: toppostfix; var ref: treference; preferred_newbasereg: tregister);
-        { changes register size without adding register allocation info }
-        function makeregsize(reg: tregister; size: tcgsize): tregister; overload;
-       public
         function getfpuregister(list: TAsmList; size: Tcgsize): Tregister; override;
         procedure handle_reg_imm12_reg(list: TAsmList; op: Tasmop; size: tcgsize; src: tregister; a: tcgint; dst: tregister; tmpreg: tregister; setflags, usedest: boolean);
         procedure init_register_allocators;override;
@@ -100,7 +100,6 @@ interface
         procedure g_concatcopy_move(list: TAsmList; const source, dest: treference; len: tcgint);
         procedure g_concatcopy(list: TAsmList; const source, dest: treference; len: tcgint);override;
         procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: tcgint);override;
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
        private
         function save_regs(list: TAsmList; rt: tregistertype; lowsr, highsr: tsuperregister; sub: tsubregister): longint;
         procedure load_regs(list: TAsmList; rt: tregistertype; lowsr, highsr: tsuperregister; sub: tsubregister);
@@ -2208,72 +2207,6 @@ implementation
       end;
 
 
-    procedure tcgaarch64.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      var
-        make_global: boolean;
-        href: treference;
-        hsym: tsym;
-        paraloc: pcgparalocation;
-        op: tasmop;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef.struct) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>ObjectSymtable then
-          Internalerror(200109191);
-
-        make_global:=false;
-        if (not current_module.is_unit) or create_smartlink_library or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { set param1 interface to self  }
-        procdef.init_paraloc_info(callerside);
-        hsym:=tsym(procdef.parast.Find('self'));
-        if not(assigned(hsym) and
-          (hsym.typ=paravarsym)) then
-          internalerror(2010103101);
-        paraloc:=tparavarsym(hsym).paraloc[callerside].location;
-        if assigned(paraloc^.next) then
-          InternalError(2013020101);
-
-        case paraloc^.loc of
-          LOC_REGISTER:
-            handle_reg_imm12_reg(list,A_SUB,paraloc^.size,paraloc^.register,ioffset,paraloc^.register,NR_IP0,false,true);
-          else
-            internalerror(2010103102);
-        end;
-
-        if (po_virtualmethod in procdef.procoptions) and
-            not is_objectpascal_helper(procdef.struct) then
-          begin
-            if (procdef.extnumber=$ffff) then
-              Internalerror(200006139);
-            { mov  0(%rdi),%rax ; load vmt}
-            reference_reset_base(href,paraloc^.register,0,sizeof(pint));
-            getcpuregister(list,NR_IP0);
-            a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_IP0);
-            { jmp *vmtoffs(%eax) ; method offs }
-            reference_reset_base(href,NR_IP0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-            op:=A_LDR;
-            make_simple_ref(list,op,OS_ADDR,PF_None,href,NR_IP0);
-            list.concat(taicpu.op_reg_ref(op,NR_IP0,href));
-            ungetcpuregister(list,NR_IP0);
-            list.concat(taicpu.op_reg(A_BR,NR_IP0));
-          end
-        else
-          a_jmp_name(list,procdef.mangledname);
-        list.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
 
     procedure create_codegen;
       begin

compiler/aarch64/cpupara.pas

@@ -33,7 +33,7 @@ unit cpupara;
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
-       taarch64paramanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function get_volatile_registers_int(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_fpu(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset; override;
@@ -69,19 +69,19 @@ unit cpupara;
       RS_LAST_MM_PARAM_SUPREG = RS_D7;
 
 
-    function taarch64paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=VOLATILE_INTREGISTERS
       end;
 
 
-    function taarch64paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[];
       end;
 
 
-    function taarch64paramanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
       begin
         result:=VOLATILE_MMREGISTERS;
       end;
@@ -223,7 +223,7 @@ unit cpupara;
       end;
 
 
-    function taarch64paramanager.push_addr_param(varspez: tvarspez; def :tdef; calloption: tproccalloption): boolean;
+    function tcpuparamanager.push_addr_param(varspez: tvarspez; def :tdef; calloption: tproccalloption): boolean;
       var
         hfabasedef: tdef;
       begin
@@ -273,7 +273,7 @@ unit cpupara;
       end;
 
 
-    function taarch64paramanager.ret_in_param(def: tdef; pd: tabstractprocdef): boolean;
+    function tcpuparamanager.ret_in_param(def: tdef; pd: tabstractprocdef): boolean;
       begin
         if handle_common_ret_in_param(def,pd,result) then
           exit;
@@ -283,7 +283,7 @@ unit cpupara;
       end;
 
 
-    procedure taarch64paramanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; isvariadic: boolean);
+    procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; isvariadic: boolean);
       var
         hp: tparavarsym;
         i: longint;
@@ -335,7 +335,7 @@ unit cpupara;
       end;
 
 
-    function  taarch64paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         retcgsize: tcgsize;
       begin
@@ -352,7 +352,8 @@ unit cpupara;
            internalerror(2014113001);
       end;
 
-    function taarch64paramanager.param_use_paraloc(const cgpara: tcgpara): boolean;
+
+    function tcpuparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
       begin
         { we always set up a stack frame -> we can always access the parameters
           this way }
@@ -362,7 +363,7 @@ unit cpupara;
       end;
 
 
-    procedure taarch64paramanager.init_para_alloc_values;
+    procedure tcpuparamanager.init_para_alloc_values;
       begin
         curintreg:=RS_FIRST_INT_PARAM_SUPREG;
         curmmreg:=RS_FIRST_MM_PARAM_SUPREG;
@@ -370,7 +371,7 @@ unit cpupara;
       end;
 
 
-    procedure taarch64paramanager.alloc_para(out result: tcgpara; p: tabstractprocdef; varspez: tvarspez; side: tcallercallee; paradef: tdef; isvariadic, isdelphinestedcc: boolean);
+    procedure tcpuparamanager.alloc_para(out result: tcgpara; p: tabstractprocdef; varspez: tvarspez; side: tcallercallee; paradef: tdef; isvariadic, isdelphinestedcc: boolean);
       var
         hfabasedef, locdef: tdef;
         paraloc: pcgparalocation;
@@ -608,7 +609,7 @@ unit cpupara;
       end;
 
 
-    function taarch64paramanager.create_paraloc_info(p: tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p: tabstractprocdef; side: tcallercallee):longint;
       begin
         init_para_alloc_values;
 
@@ -619,7 +620,7 @@ unit cpupara;
      end;
 
 
-    function taarch64paramanager.create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;
       begin
         init_para_alloc_values;
 
@@ -642,5 +643,5 @@ unit cpupara;
       end;
 
 begin
-   paramanager:=taarch64paramanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/aarch64/hlcgcpu.pas

@@ -31,6 +31,7 @@ interface
   uses
     symtype,
     aasmdata,
+    symdef,
     cgbase,cgutils,
     hlcgobj, hlcg2ll;
 
@@ -38,6 +39,8 @@ interface
     thlcgaarch64 = class(thlcg2ll)
       procedure a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister); override;
       procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize: tdef; const fromsreg, tosreg: tsubsetregister); override;
+
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
      protected
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
     end;
@@ -47,8 +50,10 @@ interface
 implementation
 
   uses
-    defutil,
-    cpubase,aasmcpu,
+    verbose,globtype,fmodule,
+    aasmbase,aasmtai,
+    symconst,symsym,defutil,
+    cpubase,aasmcpu,parabase,
     cgobj,cgcpu;
 
   procedure thlcgaarch64.a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);
@@ -130,6 +135,73 @@ implementation
     end;
 
 
+  procedure thlcgaarch64.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    var
+      make_global: boolean;
+      href: treference;
+      hsym: tsym;
+      paraloc: pcgparalocation;
+      op: tasmop;
+    begin
+      if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+        Internalerror(200006137);
+      if not assigned(procdef.struct) or
+         (procdef.procoptions*[po_classmethod, po_staticmethod,
+           po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+        Internalerror(200006138);
+      if procdef.owner.symtabletype<>ObjectSymtable then
+        Internalerror(200109191);
+
+      make_global:=false;
+      if (not current_module.is_unit) or create_smartlink_library or
+         (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+        make_global:=true;
+
+      if make_global then
+        list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+      else
+        list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+      { set param1 interface to self  }
+      procdef.init_paraloc_info(callerside);
+      hsym:=tsym(procdef.parast.Find('self'));
+      if not(assigned(hsym) and
+        (hsym.typ=paravarsym)) then
+        internalerror(2010103101);
+      paraloc:=tparavarsym(hsym).paraloc[callerside].location;
+      if assigned(paraloc^.next) then
+        InternalError(2013020101);
+
+      case paraloc^.loc of
+        LOC_REGISTER:
+          tcgaarch64(cg).handle_reg_imm12_reg(list,A_SUB,paraloc^.size,paraloc^.register,ioffset,paraloc^.register,NR_IP0,false,true);
+        else
+          internalerror(2010103102);
+      end;
+
+      if (po_virtualmethod in procdef.procoptions) and
+          not is_objectpascal_helper(procdef.struct) then
+        begin
+          if (procdef.extnumber=$ffff) then
+            Internalerror(200006139);
+          { mov  0(%rdi),%rax ; load vmt}
+          reference_reset_base(href,voidpointertype,paraloc^.register,0,sizeof(pint));
+          getcpuregister(list,NR_IP0);
+          a_load_ref_reg(list,voidpointertype,voidpointertype,href,NR_IP0);
+          { jmp *vmtoffs(%eax) ; method offs }
+          reference_reset_base(href,voidpointertype,NR_IP0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+          op:=A_LDR;
+          tcgaarch64(cg).make_simple_ref(list,op,OS_ADDR,PF_None,href,NR_IP0);
+          list.concat(taicpu.op_reg_ref(op,NR_IP0,href));
+          ungetcpuregister(list,NR_IP0);
+          list.concat(taicpu.op_reg(A_BR,NR_IP0));
+        end
+      else
+        cg.a_jmp_name(list,procdef.mangledname);
+      list.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
   procedure thlcgaarch64.a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt);
     var
       toreg: tregister;

compiler/aarch64/rgcpu.pas

@@ -34,10 +34,10 @@ unit rgcpu;
 
     type
       trgcpu=class(trgobj)
-        procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-        procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+        procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
        protected
-        procedure do_spill_op(list: tasmlist; op: tasmop; pos: tai; const spilltemp: treference; tempreg: tregister);
+        procedure do_spill_op(list: tasmlist; op: tasmop; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       end;
 
       trgintcpu=class(trgcpu)
@@ -51,19 +51,19 @@ implementation
       verbose,cutils,
       cgobj;
 
-    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       begin
-        do_spill_op(list,A_LDR,pos,spilltemp,tempreg);
+        do_spill_op(list,A_LDR,pos,spilltemp,tempreg,orgsupreg);
       end;
 
 
-    procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       begin
-        do_spill_op(list,A_STR,pos,spilltemp,tempreg);
+        do_spill_op(list,A_STR,pos,spilltemp,tempreg,orgsupreg);
       end;
 
 
-    procedure trgcpu.do_spill_op(list: tasmlist; op: tasmop; pos: tai; const spilltemp: treference; tempreg: tregister);
+    procedure trgcpu.do_spill_op(list: tasmlist; op: tasmop; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         helpins  : tai;
         tmpref   : treference;
@@ -95,9 +95,9 @@ implementation
             helplist.free;
           end
         else if isload then
-          inherited do_spill_read(list,pos,spilltemp,tempreg)
+          inherited do_spill_read(list,pos,spilltemp,tempreg,orgsupreg)
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg)
+          inherited do_spill_written(list,pos,spilltemp,tempreg,orgsupreg)
       end;
 
 

compiler/aasmbase.pas

@@ -40,7 +40,9 @@ interface
        TAsmsymbind=(
          AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL,
          { global in the current program/library, but not visible outside it }
-         AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT);
+         AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT,
+         { a symbol that's internal to the compiler and used as a temp }
+         AB_TEMP);
 
        TAsmsymtype=(
          AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
@@ -62,8 +64,8 @@ interface
 
     const
        asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c');
-       asmsymbindname : array[TAsmsymbind] of string = ('none', 'external','common',
-       'local','global','weak external','private external','lazy','import');
+       asmsymbindname : array[TAsmsymbind] of string[23] = ('none', 'external','common',
+       'local','global','weak external','private external','lazy','import','internal temp');
 
     type
        TAsmSectiontype=(sec_none,
@@ -164,6 +166,10 @@ interface
 {$endif AVR}
          bind       : TAsmsymbind;
          typ        : TAsmsymtype;
+{$ifdef llvm}
+         { have we generated a declaration for this symbol? }
+         declared   : boolean;
+{$endif llvm}
          { Alternate symbol which can be used for 'renaming' needed for
            asm inlining. Also used for external and common solving during linking }
          altsymbol  : TAsmSymbol;
@@ -181,12 +187,21 @@ interface
        TAsmLabel = class(TAsmSymbol)
        protected
          function getname:TSymStr;override;
+         {$push}{$warnings off}
+         { new visibility section to let "warnings off" take effect }
+       protected
+         { this constructor is only supposed to be used internally by
+           createstatoc/createlocal -> disable warning that constructors should
+           be public }
+         constructor create_non_global(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType; const prefix: TSymStr);
        public
+         {$pop}
          labelnr   : longint;
          labeltype : TAsmLabelType;
          is_set    : boolean;
-         constructor Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
-         constructor Createglobal(AList:TFPHashObjectList;const modulename:TSymStr;nr:longint;ltyp:TAsmLabelType);
+         constructor Createlocal(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType);
+         constructor Createstatic(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType);
+         constructor Createglobal(AList: TFPHashObjectList; const modulename: TSymStr; nr: longint; ltyp: TAsmLabelType);
          function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; override;
        end;
 
@@ -413,22 +428,15 @@ implementation
                                  TAsmLabel
 *****************************************************************************}
 
-    constructor TAsmLabel.Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
-      var
-        asmtyp: TAsmsymtype;
+    constructor TAsmLabel.Createlocal(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType);
       begin
-        case ltyp of
-          alt_addr:
-            asmtyp:=AT_ADDR;
-          alt_data:
-            asmtyp:=AT_DATA;
-          else
-            asmtyp:=AT_LABEL;
-        end;
-        inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,asmtyp);
-        labelnr:=nr;
-        labeltype:=ltyp;
-        is_set:=false;
+        create_non_global(AList,nr,ltyp,target_asm.labelprefix);
+      end;
+
+
+    constructor TAsmLabel.Createstatic(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType);
+      begin
+        create_non_global(AList,nr,ltyp,'_$$fpclocal$_l');
       end;
 
 
@@ -468,8 +476,28 @@ implementation
         increfs;
       end;
 
-	procedure default_global_used;
-	  begin
-	  end;
+
+    constructor TAsmLabel.create_non_global(AList: TFPHashObjectList; nr: longint; ltyp: TAsmLabelType; const prefix: TSymStr);
+      var
+        asmtyp: TAsmsymtype;
+      begin
+        case ltyp of
+          alt_addr:
+            asmtyp:=AT_ADDR;
+          alt_data:
+            asmtyp:=AT_DATA;
+          else
+            asmtyp:=AT_LABEL;
+        end;
+        inherited Create(AList,prefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,asmtyp);
+        labelnr:=nr;
+        labeltype:=ltyp;
+        is_set:=false;
+      end;
+
+
+    procedure default_global_used;
+      begin
+      end;
 
 end.

compiler/aasmcnst.pas

@@ -0,0 +1,1516 @@
+{
+    Copyright (c) 2014 by Jonas Maebe, member of the Free Pascal development
+    team
+
+    This unit implements typed constant data elements at the assembler level
+
+    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 aasmcnst;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  cclasses,globtype,constexp,
+  aasmbase,aasmdata,aasmtai,
+  symconst,symtype,symdef,symsym;
+
+type
+   { typed const: integer/floating point/string/pointer/... const along with
+     tdef info }
+   ttypedconstkind = (tck_simple, tck_array, tck_record);
+
+   { the type of the element and its def }
+   tai_abstracttypedconst = class abstract (tai)
+    private
+     procedure setdef(def: tdef);
+    protected
+     fadetyp: ttypedconstkind;
+     { the def of this element }
+     fdef: tdef;
+    public
+     constructor create(_adetyp: ttypedconstkind; _def: tdef);
+     property adetyp: ttypedconstkind read fadetyp;
+     property def: tdef read fdef write setdef;
+   end;
+
+   { a simple data element; the value is stored as a tai }
+   tai_simpletypedconst = class(tai_abstracttypedconst)
+    protected
+     fval: tai;
+    public
+     constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
+     property val: tai read fval;
+   end;
+
+
+   { an aggregate data element (record or array). Values are stored as an
+     array of tsimpledataelement. }
+   tai_aggregatetypedconst = class(tai_abstracttypedconst)
+    public type
+     { iterator to walk over all individual items in the aggregate }
+     tadeenumerator = class(tobject)
+      private
+       fvalues: tfplist;
+       fvaluespos: longint;
+       function getcurrent: tai_abstracttypedconst;
+      public
+       constructor create(data: tai_aggregatetypedconst);
+       function movenext: boolean;
+       procedure reset;
+       property current: tai_abstracttypedconst read getcurrent;
+     end;
+
+    protected
+     fvalues: tfplist;
+     fisstring: boolean;
+
+     { converts the existing data to a single tai_string }
+     procedure convert_to_string;
+     procedure add_to_string(strtai: tai_string; othertai: tai);
+    public
+     constructor create(_adetyp: ttypedconstkind; _fdef: tdef);
+     function getenumerator: tadeenumerator;
+     procedure addvalue(val: tai_abstracttypedconst);
+     function valuecount: longint;
+     procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
+     procedure finish;
+     destructor destroy; override;
+   end;
+
+
+    tasmlabofs = record
+      lab: tasmlabel;
+      ofs: asizeint;
+    end;
+
+   { flags for the finalisation of the typed const builder asmlist }
+   ttcasmlistoption = (
+     { the tasmsymbol is a tasmlabel }
+     tcalo_is_lab,
+     { start a new section (e.g., because we don't know the current section
+       type) }
+     tcalo_new_section,
+     { this symbol is the start of a block of data that should be
+       dead-stripable/smartlinkable; may imply starting a new section, but
+       not necessarily (depends on what the platform requirements are) }
+     tcalo_make_dead_strippable
+   );
+   ttcasmlistoptions = set of ttcasmlistoption;
+
+
+   { information about aggregates we are parsing }
+   taggregateinformation = class
+    private
+     function getcuroffset: asizeint;
+     function getfieldoffset(l: longint): asizeint;
+    protected
+     { type of the aggregate }
+     fdef: tdef;
+     { type of the aggregate }
+     ftyp: ttypedconstkind;
+     { symtable entry of the previously emitted field in case of a
+       record/object (nil if none emitted yet), used to insert alignment bytes
+       if necessary for variant records and objects }
+     fcurfield,
+     { field corresponding to the data that will be emitted next in case of a
+       record/object (nil if not set), used to handle variant records and
+       objects }
+     fnextfield: tfieldvarsym;
+     { similar as the fcurfield/fnextfield above, but instead of fieldvarsyms
+       these are indices in the symlist of a recorddef that correspond to
+       fieldvarsyms. These are used only for non-variant records, simply
+       traversing the fields in order. We could use the above method here as
+       well, but to find the next field we'd always have to use
+       symlist.indexof(fcurfield), which would be quite slow. These have -1 as
+       value if they're not set }
+     fcurindex,
+     fnextindex: longint;
+     { anonymous record that is being built as we add constant data }
+     fanonrecord: boolean;
+
+     property curindex: longint read fcurindex write fcurindex;
+     property nextindex: longint read fnextindex write fnextindex;
+    public
+     constructor create(_def: tdef; _typ: ttypedconstkind); virtual;
+     { calculated padding bytes for alignment if needed, and add the def of the
+       next field in case we are constructing an anonymous record }
+     function prepare_next_field(nextfielddef: tdef): asizeint;
+
+     property def: tdef read fdef;
+     property typ: ttypedconstkind read ftyp;
+     property curfield: tfieldvarsym read fcurfield write fcurfield;
+     property nextfield: tfieldvarsym read fnextfield write fnextfield;
+     property fieldoffset[l: longint]: asizeint read getfieldoffset;
+     property curoffset: asizeint read getcuroffset;
+     property anonrecord: boolean read fanonrecord write fanonrecord;
+   end;
+   taggregateinformationclass = class of taggregateinformation;
+
+   { Warning: never directly create a ttai_typedconstbuilder instance,
+     instead create a cai_typedconstbuilder (this class can be overridden) }
+   ttai_typedconstbuilder = class abstract
+    { class type to use when creating new aggregate information instances }
+    protected class var
+     caggregateinformation: taggregateinformationclass;
+    private
+     function getcurragginfo: taggregateinformation;
+     procedure set_next_field(AValue: tfieldvarsym);
+    protected
+     { temporary list in which all data is collected }
+     fasmlist: tasmlist;
+     { options for the final asmlist }
+     foptions: ttcasmlistoptions;
+
+     { while queueing elements of a compound expression, this is the current
+       offset in the top-level array/record }
+     fqueue_offset: asizeint;
+
+     { array of caggregateinformation instances }
+     faggregateinformation: tfpobjectlist;
+
+    { Support for generating data that is only referenced from the typed
+      constant data that we are currently generated. Such data can all be put
+      in the same dead-strippable unit, as it's either all included or none of
+      it is included. This data can be spread over multiple kinds of sections
+      though (e.g. rodata and rodata_no_rel), so per section keep track whether
+      we already started a dead-strippable unit and if so, what the section
+      name was (so that on platforms that perform the dead stripping based on
+      sections, we put all data for one typed constant into a single section
+      with the same name) }
+    protected type
+     tinternal_data_section_info = record
+       secname: TSymStr;
+       sectype: TAsmSectiontype;
+     end;
+    protected var
+     { all internally generated data must be stored in the same list, as it must
+       be consecutive (if it's spread over multiple lists, we don't know in
+       which order they'll be concatenated) -> keep track of this list }
+     finternal_data_asmlist: tasmlist;
+     { kind of the last section we started in the finternal_data_asmlist, to
+       avoid creating unnecessary section statements }
+     finternal_data_current_section: TAsmSectiontype;
+     { info about in which kinds of sections we have already emitted internal
+       data, and what their names were }
+     finternal_data_section_info: array of tinternal_data_section_info;
+
+     { ensure that finalize_asmlist is called only once }
+     fasmlist_finalized: boolean;
+
+     { returns whether def must be handled as an aggregate on the current
+       platform }
+     function aggregate_kind(def: tdef): ttypedconstkind; virtual;
+     { finalize the asmlist: add the necessary symbols etc }
+     procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
+
+     { called by the public emit_tai() routines to actually add the typed
+       constant data; the public ones also take care of adding extra padding
+       bytes etc (by calling this one) }
+     procedure do_emit_tai(p: tai; def: tdef); virtual;
+
+     { calls prepare_next_field() and adds the padding bytes in the current
+       location }
+     procedure pad_next_field(nextfielddef: tdef);
+
+     { returns the index in finternal_data_section_info of the info for the
+       section of type typ. Returns -1 if there is no such info yet }
+     function get_internal_data_section_index(typ: TAsmSectiontype): longint;
+
+     { get a start label for an internal data section (at the start of a
+       potentially dead-strippable part) }
+     function get_internal_data_section_start_label: tasmlabel; virtual;
+     { get a label in the middle of an internal data section (no dead
+       stripping) }
+     function get_internal_data_section_internal_label: tasmlabel; virtual;
+
+     { easy access to the top level aggregate information instance }
+     property curagginfo: taggregateinformation read getcurragginfo;
+    public
+     constructor create(const options: ttcasmlistoptions); virtual;
+     destructor destroy; override;
+
+    public
+     { returns a builder for generating data that is only referrenced by the
+       typed constant date we are currently generating (e.g. string data for a
+       pchar constant). Also returns the label that will be placed at the start
+       of that data. list is the tasmlist to which the data will be added.
+       secname can be empty to use a default }
+     procedure start_internal_data_builder(list: tasmlist; sectype: TAsmSectiontype; const secname: TSymStr; out tcb: ttai_typedconstbuilder; out l: tasmlabel);
+     { finish a previously started internal data builder, including
+       concatenating all generated data to the provided list and freeing the
+       builder }
+     procedure finish_internal_data_builder(var tcb: ttai_typedconstbuilder; l: tasmlabel; def: tdef; alignment: longint);
+
+     { add a simple constant data element (p) to the typed constant.
+       def is the type of the added value }
+     procedure emit_tai(p: tai; def: tdef); virtual;
+     { same as above, for a special case: when the def is a procvardef and we
+       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(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel):tasmlabofs;
+     procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
+     procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
+     { when building an anonymous record, we cannot immediately insert the
+       alignment before it in case it's nested, since we only know the required
+       alignment once all fields have been inserted -> mark the location before
+       the anonymous record, and insert the alignment once it's finished }
+     procedure mark_anon_aggregate_alignment; virtual; abstract;
+     procedure insert_marked_aggregate_alignment(def: tdef); virtual; abstract;
+    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) }
+     function emit_ansistring_const(datalist: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding): tasmlabofs;
+     function emit_unicodestring_const(datalist: 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 }
+     procedure emit_guid_const(const guid: tguid);
+     { emit a procdef constant }
+     procedure emit_procdef_const(pd: tprocdef);
+     { emit an ordinal constant }
+     procedure emit_ord_const(value: int64; def: tdef);
+
+     { 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
+       array, ... }
+     procedure maybe_begin_aggregate(def: tdef);
+     { end a potential aggregate type. Must be paired with every
+       maybe_begin_aggregate }
+     procedure maybe_end_aggregate(def: tdef);
+     { similar as above, but in case
+        a) it's definitely a record
+        b) the def of the record should be automatically constructed based on
+           the types of the emitted fields
+     }
+     function begin_anonymous_record(const optionalname: string; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
+     function end_anonymous_record: trecorddef; virtual;
+
+     { The next group of routines are for constructing complex expressions.
+       While parsing a typed constant these operators are encountered from
+       outer to inner, so that is also the order in which they should be
+       added to the queue. Only one queue can be active at a time. }
+     { Init the queue. Gives an internalerror if a queue was already active }
+     procedure queue_init(todef: tdef); virtual;
+     { queue an array/string indexing operation (performs all range checking,
+       so it doesn't have to be duplicated in all descendents). }
+     procedure queue_vecn(def: tdef; const index: tconstexprint); virtual;
+     { queue a subscripting operation }
+     procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual;
+     { queue a type conversion operation }
+     procedure queue_typeconvn(fromdef, todef: tdef); virtual;
+     { queue an address taking operation }
+     procedure queue_addrn(fromdef, todef: tdef); virtual;
+     { finalise the queue (so a new one can be created) and flush the
+        previously queued operations, applying them in reverse order on a...}
+     { ... procdef }
+     procedure queue_emit_proc(pd: tprocdef); virtual;
+     { ... staticvarsym }
+     procedure queue_emit_staticvar(vs: tstaticvarsym); virtual;
+     { ... labelsym }
+     procedure queue_emit_label(l: tlabelsym); virtual;
+     { ... constsym }
+     procedure queue_emit_const(cs: tconstsym); virtual;
+     { ... asmsym/asmlabel }
+     procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); virtual;
+     { ... an ordinal constant }
+     procedure queue_emit_ordconst(value: int64; def: tdef); virtual;
+
+     { finalize the internal asmlist (if necessary) and return it.
+       This asmlist will be freed when the builder is destroyed, so add its
+       contents to another list first. This property should only be accessed
+       once all data has been added. }
+     function get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint): tasmlist;
+
+     { returns the offset of the string data relative to ansi/unicode/widestring
+       constant labels. On most platforms, this is 0 (with the header at a
+       negative offset), but on some platforms such negative offsets are not
+       supported this is equal to the header size }
+     class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; virtual;
+
+     { set the fieldvarsym whose data we will emit next; needed
+       in case of variant records, so we know which part of the variant gets
+       initialised. Also in case of objects, because the fieldvarsyms are spread
+       over the symtables of the entire inheritance tree }
+     property next_field: tfieldvarsym write set_next_field;
+    protected
+     { this one always return the actual offset, called by the above (and
+       overridden versions) }
+     class function get_string_header_size(typ: tstringtype; winlikewidestring: boolean): pint;
+   end;
+   ttai_typedconstbuilderclass = class of ttai_typedconstbuilder;
+
+   tlowlevelaggregateinformation = class(taggregateinformation)
+    protected
+     fanonrecmarker: tai;
+    public
+     property anonrecmarker: tai read fanonrecmarker write fanonrecmarker;
+   end;
+
+   ttai_lowleveltypedconstbuilder = class(ttai_typedconstbuilder)
+    protected
+     procedure mark_anon_aggregate_alignment; override;
+     procedure insert_marked_aggregate_alignment(def: tdef); override;
+    public
+     { set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
+     class constructor classcreate;
+   end;
+
+   var
+     ctai_typedconstbuilder: ttai_typedconstbuilderclass;
+
+implementation
+
+   uses
+     verbose,globals,systems,widestr,
+     symbase,symtable,defutil;
+
+{****************************************************************************
+                       taggregateinformation
+ ****************************************************************************}
+
+    function taggregateinformation.getcuroffset: asizeint;
+      var
+        field: tfieldvarsym;
+      begin
+        if assigned(curfield) then
+          result:=curfield.fieldoffset+curfield.vardef.size
+        else if curindex<>-1 then
+          begin
+            field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[curindex]);
+            result:=field.fieldoffset+field.vardef.size
+          end
+        else
+          result:=0
+      end;
+
+
+    function taggregateinformation.getfieldoffset(l: longint): asizeint;
+      var
+        field: tfieldvarsym;
+      begin
+        field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[l]);
+        result:=field.fieldoffset;
+      end;
+
+
+    constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
+      begin
+        fdef:=_def;
+        ftyp:=_typ;
+        fcurindex:=-1;
+        fnextindex:=-1;
+      end;
+
+
+    function taggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
+      var
+        currentoffset,nextoffset: asizeint;
+        i: longint;
+      begin
+        { get the next field and its offset, and make that next field the current
+          one }
+        if assigned(nextfield) then
+          begin
+            nextoffset:=nextfield.fieldoffset;
+            currentoffset:=curoffset;
+            curfield:=nextfield;
+          end
+        else
+          begin
+            { must set nextfield for unions and objects, as we cannot
+              automatically detect the "next" field in that case }
+            if ((def.typ=recorddef) and
+                trecorddef(def).isunion) or
+               is_object(def) then
+              internalerror(2014091202);
+            { if we are constructing this record as data gets emitted, add a field
+              for this data }
+            if anonrecord then
+              trecorddef(def).add_field_by_def(nextfielddef);
+            { find next field }
+            i:=curindex;
+            repeat
+              inc(i);
+            until tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym;
+            nextoffset:=fieldoffset[i];
+            currentoffset:=curoffset;
+            curindex:=i;
+          end;
+        { need padding? }
+        result:=nextoffset-currentoffset;
+      end;
+
+
+{****************************************************************************
+                            tai_abstracttypedconst
+ ****************************************************************************}
+
+   procedure tai_abstracttypedconst.setdef(def: tdef);
+     begin
+       { should not be changed, rewrite the calling code if this happens }
+       if assigned(fdef) then
+         Internalerror(2014080203);
+       fdef:=def;
+     end;
+
+   constructor tai_abstracttypedconst.create(_adetyp: ttypedconstkind; _def: tdef);
+     begin
+       inherited create;
+       typ:=ait_typedconst;
+       fadetyp:=_adetyp;
+       fdef:=_def;
+     end;
+
+
+{****************************************************************************
+                                tai_simpletypedconst
+ ****************************************************************************}
+
+   constructor tai_simpletypedconst.create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
+     begin
+       inherited create(_adetyp,_def);
+       fval:=_val;
+     end;
+
+
+{****************************************************************************
+              tai_aggregatetypedconst.tadeenumerator
+ ****************************************************************************}
+
+   constructor tai_aggregatetypedconst.tadeenumerator.create(data: tai_aggregatetypedconst);
+     begin
+       fvalues:=data.fvalues;
+       fvaluespos:=-1;
+     end;
+
+
+   function tai_aggregatetypedconst.tadeenumerator.getcurrent: tai_abstracttypedconst;
+     begin
+       result:=tai_abstracttypedconst(fvalues[fvaluespos]);
+     end;
+
+
+   function tai_aggregatetypedconst.tadeenumerator.movenext: boolean;
+     begin
+       if fvaluespos<pred(fvalues.count) then
+         begin
+           inc(fvaluespos);
+           result:=true
+         end
+       else
+         result:=false;
+     end;
+
+
+   procedure tai_aggregatetypedconst.tadeenumerator.reset;
+     begin
+       fvaluespos:=0
+     end;
+
+
+{****************************************************************************
+                            tai_aggregatetypedconst
+ ****************************************************************************}
+
+   procedure tai_aggregatetypedconst.convert_to_string;
+     var
+       ai: tai_abstracttypedconst;
+       newstr: tai_string;
+     begin
+       newstr:=tai_string.Create('');
+       for ai in self do
+          begin
+            if ai.adetyp<>tck_simple then
+              internalerror(2014070103);
+            add_to_string(newstr,tai_simpletypedconst(ai).val);
+            ai.free;
+          end;
+       fvalues.count:=0;
+       { the "nil" def will be replaced with an array def of the appropriate
+         size once we're finished adding data, so we don't create intermediate
+         arraydefs all the time }
+       fvalues.add(tai_simpletypedconst.create(tck_simple,nil,newstr));
+     end;
+
+   procedure tai_aggregatetypedconst.add_to_string(strtai: tai_string; othertai: tai);
+     begin
+       case othertai.typ of
+         ait_string:
+           begin
+             strtai.str:=reallocmem(strtai.str,strtai.len+tai_string(othertai).len+1);
+             { also copy null terminator }
+             move(tai_string(othertai).str[0],strtai.str[strtai.len],tai_string(othertai).len+1);
+             { the null terminator is not part of the string data }
+             strtai.len:=strtai.len+tai_string(othertai).len;
+           end;
+         ait_const:
+           begin
+             if tai_const(othertai).size<>1 then
+               internalerror(2014070101);
+             strtai.str:=reallocmem(strtai.str,strtai.len+1);
+             strtai.str[strtai.len]:=ansichar(tai_const(othertai).value);
+             strtai.str[strtai.len+1]:=#0;
+             inc(strtai.len);
+           end;
+         else
+           internalerror(2014070102);
+       end;
+     end;
+
+
+   constructor tai_aggregatetypedconst.create(_adetyp: ttypedconstkind; _fdef: tdef);
+     begin
+       inherited;
+       fisstring:=false;
+       fvalues:=tfplist.create;
+     end;
+
+
+   function tai_aggregatetypedconst.getenumerator: tadeenumerator;
+     begin
+       result:=tadeenumerator.create(self);
+     end;
+
+
+   procedure tai_aggregatetypedconst.addvalue(val: tai_abstracttypedconst);
+     begin
+       { merge string constants and ordinal constants added in an array of
+         char, to unify the length and the string data }
+       if fisstring or
+          ((val.adetyp=tck_simple) and
+           (tai_simpletypedconst(val).val.typ=ait_string)) then
+         begin
+           if not fisstring and
+              (fvalues.count>0) then
+             convert_to_string;
+           fisstring:=true;
+           case fvalues.count of
+             0: fvalues.add(val);
+             1:
+               begin
+                 add_to_string(tai_string(tai_simpletypedconst(fvalues[0]).val),tai_simpletypedconst(val).val);
+                 val.free
+               end
+             else
+               internalerror(2014070104);
+           end;
+         end
+       else
+         fvalues.add(val);
+     end;
+
+
+   function tai_aggregatetypedconst.valuecount: longint;
+     begin
+       result:=fvalues.count;
+     end;
+
+
+   procedure tai_aggregatetypedconst.insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
+     begin
+       fvalues.insert(pos,val);
+     end;
+
+
+   procedure tai_aggregatetypedconst.finish;
+     begin
+       if fisstring then
+         begin
+           { set the def: an array of char with the same length as the string
+             data }
+           if fvalues.count<>1 then
+             internalerror(2014070105);
+           tai_simpletypedconst(fvalues[0]).fdef:=
+             getarraydef(cansichartype,
+               tai_string(tai_simpletypedconst(fvalues[0]).val).len);
+         end;
+     end;
+
+
+   destructor tai_aggregatetypedconst.destroy;
+     begin
+       fvalues.free;
+       inherited destroy;
+     end;
+
+
+ {*****************************************************************************
+                              ttai_typedconstbuilder
+ *****************************************************************************}
+
+   function ttai_typedconstbuilder.getcurragginfo: taggregateinformation;
+     begin
+       if assigned(faggregateinformation) and
+          (faggregateinformation.count>0) then
+         result:=taggregateinformation(faggregateinformation[faggregateinformation.count-1])
+       else
+         result:=nil;
+     end;
+
+
+   procedure ttai_typedconstbuilder.set_next_field(AValue: tfieldvarsym);
+     var
+       info: taggregateinformation;
+     begin
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091206);
+       info.nextfield:=AValue;
+     end;
+
+
+   procedure ttai_typedconstbuilder.pad_next_field(nextfielddef: tdef);
+     var
+       fillbytes: asizeint;
+     begin
+       fillbytes:=curagginfo.prepare_next_field(nextfielddef);
+       while fillbytes>0 do
+         begin
+           do_emit_tai(tai_const.create_8bit(0),u8inttype);
+           dec(fillbytes);
+         end;
+     end;
+
+
+   function ttai_typedconstbuilder.get_internal_data_section_index(typ: TAsmSectiontype): longint;
+     begin
+       { avoid wrong warning by -Oodfa }
+       result:=-1;
+       for result:=low(finternal_data_section_info) to high(finternal_data_section_info) do
+         if finternal_data_section_info[result].sectype=typ then
+           exit;
+       result:=-1;
+     end;
+
+
+   function ttai_typedconstbuilder.get_internal_data_section_start_label: tasmlabel;
+     begin
+       { on Darwin, dead code/data stripping happens based on non-temporary
+         labels (any label that doesn't start with "L" -- it doesn't have
+         to be global) }
+       if target_info.system in systems_darwin then
+         current_asmdata.getstaticdatalabel(result)
+       else if create_smartlink_library then
+         current_asmdata.getglobaldatalabel(result)
+       else
+         current_asmdata.getlocaldatalabel(result);
+     end;
+
+
+   function ttai_typedconstbuilder.get_internal_data_section_internal_label: tasmlabel;
+     begin
+       if create_smartlink_library then
+         { all labels need to be global in case they're in another object }
+         current_asmdata.getglobaldatalabel(result)
+       else
+         { no special requirement for the label -> just get a local one }
+         current_asmdata.getlocaldatalabel(result);
+     end;
+
+
+   function ttai_typedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
+     begin
+       if (def.typ in [recorddef,filedef,variantdef]) or
+          is_object(def) or
+          ((def.typ=procvardef) and
+           not tprocvardef(def).is_addressonly) then
+         result:=tck_record
+       else if ((def.typ=arraydef) and
+           not is_dynamic_array(def)) or
+          ((def.typ=setdef) and
+           not is_smallset(def)) or
+          is_shortstring(def) then
+         result:=tck_array
+       else
+         result:=tck_simple;
+     end;
+
+
+   procedure ttai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
+     var
+       prelist: tasmlist;
+     begin
+       prelist:=tasmlist.create;
+       { only now add items based on the symbolname, because it may be
+         modified by the "section" specifier in case of a typed constant }
+       if tcalo_make_dead_strippable in options then
+         begin
+           maybe_new_object_file(prelist);
+           { we always need a new section here, since if we started a new
+             object file then we have to say what the section is, and otherwise
+             we need a new section because that's how the dead stripping works
+             (except on Darwin, but that will be addressed in a future commit) }
+           new_section(prelist,section,secname,const_align(alignment));
+         end
+       else if tcalo_new_section in options then
+         new_section(prelist,section,secname,const_align(alignment))
+       else
+         prelist.concat(cai_align.Create(const_align(alignment)));
+       if not(tcalo_is_lab in options) then
+         if sym.bind=AB_GLOBAL then
+           prelist.concat(tai_symbol.Create_Global(sym,0))
+         else
+           prelist.concat(tai_symbol.Create(sym,0))
+       else
+         prelist.concat(tai_label.Create(tasmlabel(sym)));
+       { insert the symbol information before the data }
+       fasmlist.insertlist(prelist);
+       { end of the symbol }
+       fasmlist.concat(tai_symbol_end.Createname(sym.name));
+       { free the temporary list }
+       prelist.free;
+     end;
+
+
+   procedure ttai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
+     begin
+       { by default we don't care about the type }
+       fasmlist.concat(p);
+     end;
+
+
+   function ttai_typedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint): tasmlist;
+     begin
+       if not fasmlist_finalized then
+         begin
+           finalize_asmlist(sym,def,section,secname,alignment,foptions);
+           fasmlist_finalized:=true;
+         end;
+       result:=fasmlist;
+     end;
+
+
+   class function ttai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
+     begin
+       { darwin's linker does not support negative offsets }
+       if not(target_info.system in systems_darwin) then
+         result:=0
+       else
+         result:=get_string_header_size(typ,winlikewidestring);
+     end;
+
+
+   class function ttai_typedconstbuilder.get_string_header_size(typ: tstringtype; winlikewidestring: boolean): pint;
+     const
+       ansistring_header_size =
+         { encoding }
+         2 +
+         { elesize }
+         2 +
+{$ifdef cpu64bitaddr}
+         { alignment }
+         4 +
+{$endif cpu64bitaddr}
+         { reference count }
+         sizeof(pint) +
+         { length }
+         sizeof(pint);
+       unicodestring_header_size = ansistring_header_size;
+     begin
+       case typ of
+         st_ansistring:
+           result:=ansistring_header_size;
+         st_unicodestring:
+           result:=unicodestring_header_size;
+         st_widestring:
+           if winlikewidestring then
+             result:=0
+           else
+             result:=unicodestring_header_size;
+         else
+           result:=0;
+       end;
+     end;
+
+
+   constructor ttai_typedconstbuilder.create(const options: ttcasmlistoptions);
+     begin
+       inherited create;
+       fasmlist:=tasmlist.create;
+       foptions:=options;
+       { queue is empty }
+       fqueue_offset:=low(fqueue_offset);
+       finternal_data_current_section:=sec_none;
+     end;
+
+
+   destructor ttai_typedconstbuilder.destroy;
+     begin
+       { the queue should have been flushed if it was used }
+       if fqueue_offset<>low(fqueue_offset) then
+         internalerror(2014062901);
+       faggregateinformation.free;
+       fasmlist.free;
+       inherited destroy;
+     end;
+
+
+   procedure ttai_typedconstbuilder.start_internal_data_builder(list: tasmlist; sectype: TAsmSectiontype; const secname: TSymStr; out tcb: ttai_typedconstbuilder; out l: tasmlabel);
+     var
+       options: ttcasmlistoptions;
+       foundsec: longint;
+     begin
+       options:=[tcalo_is_lab];
+       { Add a section header if the previous one was different. We'll use the
+         same section name in case multiple items are added to the same kind of
+         section (rodata, rodata_no_rel, ...), so that everything will still
+         end up in the same section even if there are multiple section headers }
+       if finternal_data_current_section<>sectype then
+         include(options,tcalo_new_section);
+       finternal_data_current_section:=sectype;
+       l:=nil;
+       { did we already create a section of this type for the internal data of
+         this builder? }
+       foundsec:=get_internal_data_section_index(sectype);
+       if foundsec=-1 then
+         begin
+           { we only need to start a dead-strippable section of data at the
+             start of the first subsection of this kind for this block.
+
+             exception: if dead stripping happens based on objects/libraries,
+             then we only have to create a new object file for the first
+             internal data section of any kind (all the rest will simply be put
+             in the same object file) }
+           if create_smartlink then
+             begin
+               if not create_smartlink_library or
+                  (length(finternal_data_section_info)=0) then
+                 include(options,tcalo_make_dead_strippable);
+               { on Darwin, dead code/data stripping happens based on non-
+                 temporary labels (any label that doesn't start with "L" -- it
+                 doesn't have to be global) -> add a non-temporary lobel at the
+                 start of every kind of subsection created in this builder }
+               if target_info.system in systems_darwin then
+                 l:=get_internal_data_section_start_label;
+             end;
+           foundsec:=length(finternal_data_section_info);
+           setlength(finternal_data_section_info,foundsec+1);
+           finternal_data_section_info[foundsec].sectype:=sectype;
+         end;
+       if not assigned(finternal_data_asmlist) and
+          (cs_create_smart in current_settings.moduleswitches) then
+         begin
+           l:=get_internal_data_section_start_label;
+           { the internal data list should only be assigned by this routine,
+             the first time that an internal data block is started }
+           if not assigned(list) or
+              assigned(finternal_data_asmlist) then
+             internalerror(2015032101);
+           finternal_data_asmlist:=list;
+         end
+       { all internal data for this tcb must go to the same list (otherwise all
+         data we want to add to the dead-strippable block is not guaranteed to
+         be sequential and e.g. in the same object file in case of library-based
+         dead stripping) }
+       else if (assigned(finternal_data_asmlist) and
+           (list<>finternal_data_asmlist)) or
+           not assigned(list) then
+         internalerror(2015032101);
+       finternal_data_asmlist:=list;
+       if not assigned(l) then
+         l:=get_internal_data_section_internal_label;
+       { first section of this kind -> set name }
+       if finternal_data_section_info[foundsec].secname='' then
+         if secname='' then
+           finternal_data_section_info[foundsec].secname:=l.Name
+         else
+           finternal_data_section_info[foundsec].secname:=secname
+       { if the name is specified multiple times, it must match }
+       else if (secname<>'') and
+               (finternal_data_section_info[foundsec].secname<>secname) then
+         internalerror(2015032401);
+       tcb:=ttai_typedconstbuilderclass(classtype).create(options);
+     end;
+
+
+   procedure ttai_typedconstbuilder.finish_internal_data_builder(var tcb: ttai_typedconstbuilder; l: tasmlabel; def: tdef; alignment: longint);
+     begin
+       finternal_data_asmlist.concatList(tcb.get_final_asmlist(l,def,
+         finternal_data_current_section,
+         finternal_data_section_info[get_internal_data_section_index(finternal_data_current_section)].secname,
+         alignment));
+       tcb.free;
+       tcb:=nil;
+     end;
+
+
+   procedure ttai_typedconstbuilder.emit_tai(p: tai; def: tdef);
+     var
+       kind: ttypedconstkind;
+       info: taggregateinformation;
+     begin
+       { these elements can be aggregates themselves, e.g. a shortstring can
+         be emitted as a series of bytes and char arrays }
+       kind:=aggregate_kind(def);
+       info:=curagginfo;
+       if (kind<>tck_simple) and
+          (not assigned(info) or
+           (info.typ<>kind)) then
+         internalerror(2014091001);
+       { if we're emitting a record, handle the padding bytes, and in case of
+         an anonymous record also add the next field }
+       if assigned(info) then
+         begin
+           if ((info.def.typ=recorddef) or
+               is_object(info.def)) and
+              { may add support for these later }
+              not is_packed_record_or_object(info.def) then
+             pad_next_field(def);
+         end;
+       { emit the data }
+       do_emit_tai(p,def);
+     end;
+
+
+   procedure ttai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
+     begin
+       { nothing special by default, since we don't care about the type }
+       emit_tai(p,pvdef);
+     end;
+
+
+   function ttai_typedconstbuilder.emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel): tasmlabofs;
+     var
+       string_symofs: asizeint;
+       charptrdef: tdef;
+       elesize: word;
+     begin
+       result.lab:=startlab;
+       result.ofs:=0;
+       { pack the data, so that we don't add unnecessary null bytes after the
+         constant string }
+       begin_anonymous_record('$'+get_dynstring_rec_name(stringtype,false,len),1,1,1);
+       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:
+           begin
+             elesize:=1;
+             charptrdef:=charpointertype;
+           end;
+         st_unicodestring:
+           begin
+             elesize:=2;
+             charptrdef:=widecharpointertype;
+           end
+         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 }
+           emit_tai(tai_label.create(result.lab),charptrdef);
+           result.ofs:=0;
+           { create new label of the same kind (including whether or not the
+             name starts with target_asm.labelprefix in case it's AB_LOCAL,
+             so we keep the difference depending on whether the original was
+             allocated via getstatic/getlocal/getglobal datalabel) }
+           startlab:=tasmlabel.create(current_asmdata.AsmSymbolDict,startlab.name+'$strlab',startlab.bind,startlab.typ);
+         end;
+       { sanity check }
+       if result.ofs<>string_symofs then
+         internalerror(2012051701);
+     end;
+
+
+   procedure ttai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
+     var
+       info: taggregateinformation;
+       tck: ttypedconstkind;
+     begin
+       tck:=aggregate_kind(def);
+       if tck=tck_simple then
+         exit;
+       if not assigned(faggregateinformation) then
+         faggregateinformation:=tfpobjectlist.create
+       { if we're starting an anonymous record, we can't align it yet because
+         the alignment depends on the fields that will be added -> we'll do
+         it at the end }
+       else if not anonymous then
+         begin
+           { add padding if necessary, and update the current field/offset }
+           info:=curagginfo;
+           if is_record(curagginfo.def) or
+              is_object(curagginfo.def) then
+             pad_next_field(def);
+         end
+       { if this is the outer record, no padding is required; the alignment
+         has to be specified explicitly in that case via get_final_asmlist() }
+       else if assigned(curagginfo) and
+               (curagginfo.def.typ=recorddef) then
+         { mark where we'll have to insert the padding bytes at the end }
+         mark_anon_aggregate_alignment;
+       info:=caggregateinformation.create(def,aggregate_kind(def));
+       faggregateinformation.add(info);
+     end;
+
+
+   procedure ttai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
+     var
+       info: taggregateinformation;
+       fillbytes: asizeint;
+       tck: ttypedconstkind;
+     begin
+       tck:=aggregate_kind(def);
+       if tck=tck_simple then
+         exit;
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091002);
+       if def<>info.def then
+         internalerror(2014091205);
+       { add tail padding if necessary }
+       if (is_record(def) or
+           is_object(def)) and
+          not is_packed_record_or_object(def) then
+         begin
+           fillbytes:=def.size-info.curoffset;
+           while fillbytes>0 do
+             begin
+               do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
+               dec(fillbytes)
+             end;
+         end;
+       { pop and free the information }
+       faggregateinformation.count:=faggregateinformation.count-1;
+       info.free;
+     end;
+
+
+   class function ttai_typedconstbuilder.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;
+
+
+   function ttai_typedconstbuilder.emit_ansistring_const(datalist: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding): tasmlabofs;
+     var
+       s: PChar;
+       startlab: tasmlabel;
+       ansistrrecdef: trecorddef;
+       datadef: tdef;
+       datatcb: ttai_typedconstbuilder;
+     begin
+       start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
+       result:=datatcb.emit_string_const_common(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;
+       finish_internal_data_builder(datatcb,startlab,ansistrrecdef,const_align(sizeof(pointer)));
+     end;
+
+
+   function ttai_typedconstbuilder.emit_unicodestring_const(datalist: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
+     var
+       i, strlength: longint;
+       string_symofs: asizeint;
+       startlab: tasmlabel;
+       datadef: tdef;
+       uniwidestrrecdef: trecorddef;
+       datatcb: ttai_typedconstbuilder;
+     begin
+       start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
+       strlength:=getlengthwidestring(pcompilerwidestring(data));
+       if winlike then
+         begin
+           result.lab:=startlab;
+           datatcb.begin_anonymous_record('$'+get_dynstring_rec_name(st_widestring,true,strlength),
+             0,
+             targetinfos[target_info.system]^.alignment.recordalignmin,
+             targetinfos[target_info.system]^.alignment.maxCrecordalign);
+           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 (see
+                 emit_string_const_common() for explanation) }
+               startlab:=tasmlabel.create(current_asmdata.AsmSymbolDict,startlab.name+'$strlab',startlab.bind,startlab.typ);
+             end
+           else
+             internalerror(2015031502);
+           result.ofs:=string_symofs;
+         end
+       else
+         begin
+           result:=datatcb.emit_string_const_common(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;
+         end
+       else
+         { code generation for other sizes must be written }
+         internalerror(200904271);
+       finish_internal_data_builder(datatcb,startlab,datadef,const_align(sizeof(pint)));
+     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
+       { we use an arraydef instead of a shortstringdef, because we don't have
+         functionality in place yet to reuse shortstringdefs of the same length
+         and neither the lowlevel nor the llvm typedconst builder cares about
+         this difference }
+       result:=getarraydef(cansichartype,length(str)+1);
+       maybe_begin_aggregate(result);
+       emit_tai(Tai_const.Create_8bit(length(str)),u8inttype);
+       if str<>'' then
+         emit_tai(Tai_string.Create(str),getarraydef(cansichartype,length(str)));
+       maybe_end_aggregate(result);
+     end;
+
+
+   procedure ttai_typedconstbuilder.emit_guid_const(const guid: tguid);
+     var
+       i: longint;
+     begin
+       maybe_begin_aggregate(rec_tguid);
+       { variant record -> must specify which fields get initialised }
+       next_field:=tfieldvarsym(rec_tguid.symtable.symlist[0]);
+       emit_tai(Tai_const.Create_32bit(longint(guid.D1)),u32inttype);
+       next_field:=tfieldvarsym(rec_tguid.symtable.symlist[1]);
+       emit_tai(Tai_const.Create_16bit(guid.D2),u16inttype);
+       next_field:=tfieldvarsym(rec_tguid.symtable.symlist[2]);
+       emit_tai(Tai_const.Create_16bit(guid.D3),u16inttype);
+       next_field:=tfieldvarsym(rec_tguid.symtable.symlist[3]);
+       { the array }
+       maybe_begin_aggregate(tfieldvarsym(rec_tguid.symtable.symlist[3]).vardef);
+       for i:=Low(guid.D4) to High(guid.D4) do
+         emit_tai(Tai_const.Create_8bit(guid.D4[i]),u8inttype);
+       maybe_end_aggregate(tfieldvarsym(rec_tguid.symtable.symlist[3]).vardef);
+       maybe_end_aggregate(rec_tguid);
+     end;
+
+   procedure ttai_typedconstbuilder.emit_procdef_const(pd: tprocdef);
+     begin
+       emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),pd.getcopyas(procvardef,pc_address_only));
+     end;
+
+
+   procedure ttai_typedconstbuilder.emit_ord_const(value: int64; def: tdef);
+     begin
+       case def.size of
+         1:
+           emit_tai(Tai_const.Create_8bit(byte(value)),def);
+         2:
+           emit_tai(Tai_const.Create_16bit(word(value)),def);
+         4:
+           emit_tai(Tai_const.Create_32bit(longint(value)),def);
+         8:
+           emit_tai(Tai_const.Create_64bit(value),def);
+         else
+           internalerror(2014100501);
+       end;
+     end;
+
+
+   procedure ttai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
+     begin
+       begin_aggregate_internal(def,false);
+     end;
+
+
+   procedure ttai_typedconstbuilder.maybe_end_aggregate(def: tdef);
+     begin
+       end_aggregate_internal(def,false);
+     end;
+
+
+   function ttai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+     var
+       anonrecorddef: trecorddef;
+       srsym: tsym;
+       srsymtable: tsymtable;
+       found: boolean;
+     begin
+       { if the name is specified, we create a typesym with that name in order
+         to ensure we can find it again later with that name -> reuse here as
+         well if possible (and that also avoids duplicate type name issues) }
+       if optionalname<>'' then
+         begin
+           if optionalname[1]='$' then
+             found:=searchsym_type(copy(optionalname,2,length(optionalname)),srsym,srsymtable)
+           else
+             found:=searchsym_type(optionalname,srsym,srsymtable);
+           if found then
+             begin
+               if ttypesym(srsym).typedef.typ<>recorddef then
+                 internalerror(2014091207);
+               result:=trecorddef(ttypesym(srsym).typedef);
+               maybe_begin_aggregate(result);
+               exit;
+             end;
+         end;
+       { create skeleton def }
+       anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords,recordalignmin,maxcrecordalign);
+       { generic aggregate housekeeping }
+       begin_aggregate_internal(anonrecorddef,true);
+       { mark as anonymous record }
+       curagginfo.anonrecord:=true;
+       { in case a descendent wants to do something with the anonrecorddef too }
+       result:=anonrecorddef;
+     end;
+
+
+   function ttai_typedconstbuilder.end_anonymous_record: trecorddef;
+     var
+       info: taggregateinformation;
+       anonrecord: boolean;
+     begin
+       info:=curagginfo;
+       if not assigned(info) or
+          (info.def.typ<>recorddef) then
+         internalerror(2014080201);
+       result:=trecorddef(info.def);
+       { make a copy, as we need it after info has been freed by
+         maybe_end_aggregate(result) }
+       anonrecord:=info.anonrecord;
+       { finalise the record skeleton (all fields have been added already by
+         emit_tai()) -- anonrecord may not be set in case we reused an earlier
+         constructed def }
+       if anonrecord then
+         trecordsymtable(result.symtable).addalignmentpadding;
+       end_aggregate_internal(result,true);
+       if anonrecord and
+          assigned(curagginfo) and
+          (curagginfo.def.typ=recorddef) then
+         insert_marked_aggregate_alignment(result);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_init(todef: tdef);
+     begin
+       { nested call to init? }
+       if fqueue_offset<>low(fqueue_offset) then
+         internalerror(2014062101);
+       fqueue_offset:=0;
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_vecn(def: tdef; const index: tconstexprint);
+     var
+       elelen,
+       vecbase: asizeint;
+       v: tconstexprint;
+     begin
+       elelen:=1;
+       vecbase:=0;
+       case def.typ of
+         stringdef :
+           ;
+         arraydef :
+           begin
+             if not is_packed_array(def) then
+               begin
+                 elelen:=tarraydef(def).elesize;
+                 vecbase:=tarraydef(def).lowrange;
+               end
+             else
+               Message(parser_e_packed_dynamic_open_array);
+           end;
+         else
+           Message(parser_e_illegal_expression);
+       end;
+       { Prevent overflow }
+       v:=index-vecbase;
+       if (v<int64(low(fqueue_offset))) or (v>int64(high(fqueue_offset))) then
+         message3(type_e_range_check_error_bounds,tostr(v),tostr(low(fqueue_offset)),tostr(high(fqueue_offset)));
+       if high(fqueue_offset)-fqueue_offset div elelen>v then
+         inc(fqueue_offset,elelen*v.svalue)
+       else
+         message3(type_e_range_check_error_bounds,tostr(index),tostr(vecbase),tostr(high(fqueue_offset)-fqueue_offset div elelen+vecbase))
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
+     begin
+       inc(fqueue_offset,vs.fieldoffset);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
+     begin
+       { do nothing }
+     end;
+
+   procedure ttai_typedconstbuilder.queue_addrn(fromdef, todef: tdef);
+     begin
+       { do nothing }
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_emit_proc(pd: tprocdef);
+     begin
+       if fqueue_offset<>0 then
+         internalerror(2014092101);
+       emit_procdef_const(pd);
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
+     begin
+       { getpointerdef because we are emitting a pointer to the staticvarsym
+         data, not the data itself }
+       emit_tai(Tai_const.Createname(vs.mangledname,fqueue_offset),getpointerdef(vs.vardef));
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_emit_label(l: tlabelsym);
+     begin
+       emit_tai(Tai_const.Createname(l.mangledname,fqueue_offset),voidcodepointertype);
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_emit_const(cs: tconstsym);
+     begin
+       if cs.consttyp<>constresourcestring then
+         internalerror(2014062102);
+       if fqueue_offset<>0 then
+         internalerror(2014062103);
+       { warning: update if/when the type of resource strings changes }
+       emit_tai(Tai_const.Createname(make_mangledname('RESSTR',cs.owner,cs.name),AT_DATA,sizeof(pint)),cansistringtype);
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+
+   procedure ttai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
+     begin
+       { getpointerdef, because "sym" represents the address of whatever the
+         data is }
+       def:=getpointerdef(def);
+       emit_tai(Tai_const.Create_sym_offset(sym,fqueue_offset),def);
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+   procedure ttai_typedconstbuilder.queue_emit_ordconst(value: int64; def: tdef);
+     begin
+       emit_ord_const(value,def);
+       fqueue_offset:=low(fqueue_offset);
+     end;
+
+
+{****************************************************************************
+                           tai_abstracttypedconst
+ ****************************************************************************}
+
+   class constructor ttai_lowleveltypedconstbuilder.classcreate;
+     begin
+       caggregateinformation:=tlowlevelaggregateinformation;
+     end;
+
+
+   procedure ttai_lowleveltypedconstbuilder.mark_anon_aggregate_alignment;
+     var
+       marker: tai_marker;
+     begin
+       marker:=tai_marker.Create(mark_position);
+       fasmlist.concat(marker);
+       tlowlevelaggregateinformation(curagginfo).anonrecmarker:=marker;
+     end;
+
+
+   procedure ttai_lowleveltypedconstbuilder.insert_marked_aggregate_alignment(def: tdef);
+     var
+       info: tlowlevelaggregateinformation;
+       fillbytes: asizeint;
+     begin
+       info:=tlowlevelaggregateinformation(curagginfo);
+       if not assigned(info.anonrecmarker) then
+         internalerror(2014091401);
+       fillbytes:=info.prepare_next_field(def);
+       while fillbytes>0 do
+         begin
+           fasmlist.insertafter(tai_const.create_8bit(0),info.anonrecmarker);
+           dec(fillbytes);
+         end;
+       fasmlist.remove(info.anonrecmarker);
+       info.anonrecmarker.free;
+       info.anonrecmarker:=nil;
+     end;
+
+
+
+begin
+  ctai_typedconstbuilder:=ttai_lowleveltypedconstbuilder;
+end.
+

compiler/aasmdata.pas

@@ -173,7 +173,17 @@ interface
         procedure getjumplabel(out l : TAsmLabel);
         procedure getglobaljumplabel(out l : TAsmLabel);
         procedure getaddrlabel(out l : TAsmLabel);
-        procedure getdatalabel(out l : TAsmLabel);
+        { visible from outside current object }
+        procedure getglobaldatalabel(out l : TAsmLabel);
+        { visible only inside current object, but doesn't start with
+          target_asm.label_prefix (treated the Darwin linker as the start of a
+          dead-strippable data block) }
+        procedure getstaticdatalabel(out l : TAsmLabel);
+        { visible only inside the current object and does start with
+          target_asm.label_prefix (not treated by the Darwin linker as the start
+          of a dead-strippable data block, and references to such labels are
+          also ignored to determine whether a data block should be live) }
+        procedure getlocaldatalabel(out l : TAsmLabel);
         { generate an alternative (duplicate) symbol }
         procedure GenerateAltSymbol(p:TAsmSymbol);
         procedure ResetAltSymbols;
@@ -510,13 +520,28 @@ implementation
         inc(FNextLabelNr[alt_jump]);
       end;
 
-    procedure TAsmData.getdatalabel(out l : TAsmLabel);
+
+    procedure TAsmData.getglobaldatalabel(out l : TAsmLabel);
       begin
         l:=TAsmLabel.createglobal(AsmSymbolDict,name^,FNextLabelNr[alt_data],alt_data);
         inc(FNextLabelNr[alt_data]);
       end;
 
 
+    procedure TAsmData.getstaticdatalabel(out l : TAsmLabel);
+      begin
+        l:=TAsmLabel.createstatic(AsmSymbolDict,FNextLabelNr[alt_data],alt_data);
+        inc(FNextLabelNr[alt_data]);
+      end;
+
+
+    procedure TAsmData.getlocaldatalabel(out l: TAsmLabel);
+      begin
+        l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_data],alt_data);
+        inc(FNextLabelNr[alt_data]);
+      end;
+
+
     procedure TAsmData.getaddrlabel(out l : TAsmLabel);
       begin
         l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_addr],alt_addr);

compiler/aasmtai.pas

@@ -35,6 +35,10 @@ interface
        cutils,cclasses,
        globtype,systems,
        cpuinfo,cpubase,
+{$ifdef llvm}
+       { overrides max_operands }
+       llvmbase,
+{$endif llvm}
        cgbase,cgutils,
        symtype,
        aasmbase,aasmdata,ogbase
@@ -60,11 +64,8 @@ interface
           ait_directive,
           ait_label,
           ait_const,
-          ait_real_32bit,
-          ait_real_64bit,
-          ait_real_80bit,
-          ait_comp_64bit,
-          ait_real_128bit,
+          ait_realconst,
+          ait_typedconst,
           ait_stab,
           ait_force_line,
           ait_function_name,
@@ -94,6 +95,11 @@ interface
           ait_jvar,    { debug information for a local variable }
           ait_jcatch,  { exception catch clause }
 {$endif JVM}
+{$ifdef llvm}
+          ait_llvmins, { llvm instruction }
+          ait_llvmalias, { alias for a symbol }
+          ait_llvmdecl, { llvm symbol declaration (global/external variable, external procdef) }
+{$endif}
           { SEH directives used in ARM,MIPS and x86_64 COFF targets }
           ait_seh_directive
           );
@@ -139,6 +145,14 @@ interface
           aitconst_gotoff_symbol
         );
 
+        tairealconsttype = (
+          aitrealconst_s32bit,
+          aitrealconst_s64bit,
+          aitrealconst_s80bit,
+          aitrealconst_s128bit,
+          aitrealconst_s64comp
+        );
+
     const
 {$if defined(cpu64bitaddr)}
        aitconst_ptr = aitconst_64bit;
@@ -174,11 +188,8 @@ interface
           'symbol_directive',
           'label',
           'const',
-          'real_32bit',
-          'real_64bit',
-          'real_80bit',
-          'comp_64bit',
-          'real_128bit',
+          'realconst',
+          'typedconst',
           'stab',
           'force_line',
           'function_name',
@@ -204,6 +215,11 @@ interface
           'jvar',
           'jcatch',
 {$endif JVM}
+{$ifdef llvm}
+          'llvmins',
+          'llvmalias',
+          'llvmdecl',
+{$endif}
           'seh_directive'
           );
 
@@ -231,6 +247,19 @@ interface
        ,top_string
        ,top_wstring
 {$endif jvm}
+{$ifdef llvm}
+       { llvm only }
+       ,top_single
+       ,top_double
+{$ifdef cpuextended}
+       ,top_extended80
+{$endif cpuextended}
+       ,top_tai
+       ,top_def
+       ,top_fpcond
+       ,top_cond
+       ,top_para
+{$endif llvm}
        );
 
       { kinds of operations that an instruction can perform on an operand }
@@ -247,38 +276,6 @@ interface
       end;
       plocaloper = ^tlocaloper;
 
-      { please keep the size of this record <=12 bytes and keep it properly aligned }
-      toper = record
-        ot : longint;
-        case typ : toptype of
-          top_none   : ();
-          top_reg    : (reg:tregister);
-          top_ref    : (ref:preference);
-          top_const  : (val:tcgint);
-          top_bool   : (b:boolean);
-          { local varsym that will be inserted in pass_generate_code }
-          top_local  : (localoper:plocaloper);
-      {$ifdef arm}
-          top_regset : (regset:^tcpuregisterset; regtyp: tregistertype; subreg: tsubregister; usermode: boolean);
-          top_modeflags : (modeflags : tcpumodeflags);
-          top_specialreg : (specialreg:tregister; specialflags:tspecialregflags);
-      {$endif arm}
-      {$if defined(arm) or defined(aarch64)}
-          top_shifterop : (shifterop : pshifterop);
-          top_conditioncode : (cc : TAsmCond);
-      {$endif defined(arm) or defined(aarch64)}
-      {$ifdef m68k}
-          top_regset : (dataregset,addrregset,fpuregset:^tcpuregisterset);
-      {$endif m68k}
-      {$ifdef jvm}
-          top_single : (sval:single);
-          top_double : (dval:double);
-          top_string : (pcvallen: aint; pcval: pchar);
-          top_wstring : (pwstrval: pcompilerwidestring);
-      {$endif jvm}
-      end;
-      poper=^toper;
-
     const
       { ait_* types which don't result in executable code or which don't influence
         the way the program runs/behaves, but which may be encountered by the
@@ -302,11 +299,14 @@ interface
                      ait_cutobject,ait_marker,ait_varloc,ait_align,ait_section,ait_comment,
                      ait_const,ait_directive,
                      ait_symbolpair,ait_weak,
-                     ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
+                     ait_realconst,
                      ait_symbol,
 {$ifdef JVM}
                      ait_jvar, ait_jcatch,
 {$endif JVM}
+{$ifdef llvm}
+                     ait_llvmdecl,
+{$endif llvm}
                      ait_seh_directive
                     ];
 
@@ -397,6 +397,52 @@ interface
       );
 
     type
+        tai = class;
+
+        { please keep the size of this record <=12 bytes and keep it properly aligned }
+        toper = record
+          ot : longint;
+          case typ : toptype of
+            top_none   : ();
+            top_reg    : (reg:tregister);
+            top_ref    : (ref:preference);
+            top_const  : (val:tcgint);
+            top_bool   : (b:boolean);
+            { local varsym that will be inserted in pass_generate_code }
+            top_local  : (localoper:plocaloper);
+        {$ifdef arm}
+            top_regset : (regset:^tcpuregisterset; regtyp: tregistertype; subreg: tsubregister; usermode: boolean);
+            top_modeflags : (modeflags : tcpumodeflags);
+            top_specialreg : (specialreg:tregister; specialflags:tspecialregflags);
+        {$endif arm}
+        {$if defined(arm) or defined(aarch64)}
+            top_shifterop : (shifterop : pshifterop);
+            top_conditioncode : (cc : TAsmCond);
+        {$endif defined(arm) or defined(aarch64)}
+        {$ifdef m68k}
+            top_regset : (dataregset,addrregset,fpuregset:^tcpuregisterset);
+        {$endif m68k}
+        {$ifdef jvm}
+            top_single : (sval:single);
+            top_double : (dval:double);
+            top_string : (pcvallen: aint; pcval: pchar);
+            top_wstring : (pwstrval: pcompilerwidestring);
+        {$endif jvm}
+        {$ifdef llvm}
+            top_single : (sval:single);
+            top_double : (dval:double);
+          {$ifdef cpuextended}
+            top_extended80 : (eval:extended);
+          {$endif cpuextended}
+            top_tai    : (ai: tai);
+            top_def    : (def: tdef);
+            top_cond   : (cond: topcmp);
+            top_fpcond : (fpcond: tllvmfpcmp);
+            top_para   : (paras: tfplist);
+        {$endif llvm}
+        end;
+        poper=^toper;
+
        { abstract assembler item }
        tai = class(TLinkedListItem)
 {$ifndef NOOPT}
@@ -589,57 +635,34 @@ interface
           function size:longint;
        end;
 
-       { Generates a single float (32 bit real) }
-       tai_real_32bit = class(tai)
-          value : ts32real;
-          constructor Create(_value : ts32real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
+       { floating point const }
        tformatoptions = (fo_none,fo_hiloswapped);
-
-       { Generates a double float (64 bit real) }
-       tai_real_64bit = class(tai)
-          value : ts64real;
+       tai_realconst = class(tai)
+          realtyp: tairealconsttype;
+          savesize: byte;
+          value: record
+            case tairealconsttype of
+              aitrealconst_s32bit: (s32val: ts32real);
+              aitrealconst_s64bit: (s64val: ts64real);
+              aitrealconst_s80bit: (s80val: ts80real);
+              aitrealconst_s128bit: (s128val: ts128real);
+              aitrealconst_s64comp: (s64compval: ts64comp);
+          end;
 {$ifdef ARM}
           formatoptions : tformatoptions;
-          constructor Create_hiloswapped(_value : ts64real);
 {$endif ARM}
-          constructor Create(_value : ts64real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       { Generates an extended float (80 bit real) }
-       tai_real_80bit = class(tai)
-          value : ts80real;
-          savesize : byte;
-          constructor Create(_value : ts80real; _savesize: byte);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       { Generates an float128 (128 bit real) }
-       tai_real_128bit = class(tai)
-          value : ts128real;
-          constructor Create(_value : ts128real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       { Generates a comp int (integer over 64 bits)
-
-          This is Intel 80x86 specific, and is not
-          really supported on other processors.
-       }
-       tai_comp_64bit = class(tai)
-          value : ts64comp;
-          constructor Create(_value : ts64comp);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          constructor create_s32real(val: ts32real);
+          constructor create_s64real(val: ts64real);
+{$ifdef ARM}
+          constructor create_s64real_hiloswapped(val : ts64real);
+{$endif ARM}
+          constructor create_s80real(val: ts80real; _savesize: byte);
+          constructor create_s128real(val: ts128real);
+          constructor create_s64compreal(val: ts64comp);
+          constructor ppuload(t: taitype;ppufile: tcompilerppufile); override;
+          procedure ppuwrite(ppufile: tcompilerppufile); override;
+          function getcopy:tlinkedlistitem;override;
+          function datasize: word;
        end;
 
        { tai_stab }
@@ -1858,156 +1881,151 @@ implementation
 
 
 {****************************************************************************
-                               TAI_real_32bit
+                               TAI_realconst
  ****************************************************************************}
 
-    constructor tai_real_32bit.Create(_value : ts32real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_32bit;
-         value:=_value;
-      end;
-
-    constructor tai_real_32bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-      end;
-
-
-    procedure tai_real_32bit.ppuwrite(ppufile:tcompilerppufile);
+    constructor tai_realconst.create_s32real(val: ts32real);
       begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s32bit;
+        savesize:=4;
+        value.s32val:=val;
       end;
 
 
-{****************************************************************************
-                               TAI_real_64bit
- ****************************************************************************}
-
-    constructor tai_real_64bit.Create(_value : ts64real);
-
+    constructor tai_realconst.create_s64real(val: ts64real);
       begin
-         inherited Create;
-         typ:=ait_real_64bit;
-         value:=_value;
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s64bit;
+        savesize:=8;
+        value.s64val:=val;
       end;
 
-
 {$ifdef ARM}
-    constructor tai_real_64bit.Create_hiloswapped(_value : ts64real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_64bit;
-         value:=_value;
-         formatoptions:=fo_hiloswapped;
-      end;
-{$endif ARM}
-
-    constructor tai_real_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
+    constructor tai_realconst.create_s64real_hiloswapped(val : ts64real);
       begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-{$ifdef ARM}
-        formatoptions:=tformatoptions(ppufile.getbyte);
-{$endif ARM}
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s64bit;
+        value.s64val:=val;
+        savesize:=8;
+        formatoptions:=fo_hiloswapped;
       end;
 
-
-    procedure tai_real_64bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-{$ifdef ARM}
-        ppufile.putbyte(byte(formatoptions));
 {$endif ARM}
-      end;
-
-
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_80bit.Create(_value : ts80real; _savesize: byte);
-
-      begin
-         inherited Create;
-         typ:=ait_real_80bit;
-         value:=_value;
-         savesize:=_savesize;
-      end;
 
-
-    constructor tai_real_80bit.ppuload(t:taitype;ppufile:tcompilerppufile);
+    constructor tai_realconst.create_s80real(val: ts80real; _savesize: byte);
       begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-        savesize:=ppufile.getbyte;
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s80bit;
+        savesize:=_savesize;
+        value.s80val:=val;
       end;
 
 
-    procedure tai_real_80bit.ppuwrite(ppufile:tcompilerppufile);
+    constructor tai_realconst.create_s128real(val: ts128real);
       begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-        ppufile.putbyte(savesize);
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s128bit;
+        savesize:=16;
+        value.s128val:=val;
       end;
 
 
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_128bit.Create(_value : ts128real);
-
+    constructor tai_realconst.create_s64compreal(val: ts64comp);
       begin
-         inherited Create;
-         typ:=ait_real_128bit;
-         value:=_value;
+        inherited create;
+        typ:=ait_realconst;
+        realtyp:=aitrealconst_s64comp;
+        savesize:=8;
+        value.s64compval:=val;
       end;
 
 
-    constructor tai_real_128bit.ppuload(t:taitype;ppufile:tcompilerppufile);
+        constructor tai_realconst.ppuload(t: taitype; ppufile: tcompilerppufile);
       begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
+        inherited;
+        realtyp:=tairealconsttype(ppufile.getbyte);
+{$ifdef ARM}
+        formatoptions:=tformatoptions(ppufile.getbyte);
+{$endif ARM}
+        case realtyp of
+          aitrealconst_s32bit:
+            value.s32val:=ppufile.getreal;
+          aitrealconst_s64bit:
+            value.s64val:=ppufile.getreal;
+          aitrealconst_s80bit:
+            value.s80val:=ppufile.getreal;
+          aitrealconst_s128bit:
+            value.s128val:=ppufile.getreal;
+          aitrealconst_s64comp:
+            value.s64compval:=comp(ppufile.getint64);
+          else
+            internalerror(2014050602);
+        end;
       end;
 
 
-    procedure tai_real_128bit.ppuwrite(ppufile:tcompilerppufile);
+    procedure tai_realconst.ppuwrite(ppufile: tcompilerppufile);
+      var
+        c: comp;
       begin
         inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-      end;
-
-
-{****************************************************************************
-                               Tai_comp_64bit
- ****************************************************************************}
-
-    constructor tai_comp_64bit.Create(_value : ts64comp);
-
-      begin
-         inherited Create;
-         typ:=ait_comp_64bit;
-         value:=_value;
+        ppufile.putbyte(byte(realtyp));
+{$ifdef ARM}
+        ppufile.putbyte(byte(formatoptions));
+{$endif ARM}
+        case realtyp of
+          aitrealconst_s32bit:
+            ppufile.putreal(value.s32val);
+          aitrealconst_s64bit:
+            ppufile.putreal(value.s64val);
+          aitrealconst_s80bit:
+            ppufile.putreal(value.s80val);
+          aitrealconst_s128bit:
+            ppufile.putreal(value.s128val);
+          aitrealconst_s64comp:
+            begin
+              c:=comp(value.s64compval);
+              ppufile.putint64(int64(c));
+            end
+          else
+            internalerror(2014050601);
+        end;
       end;
 
 
-    constructor tai_comp_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
+    function tai_realconst.getcopy: tlinkedlistitem;
       begin
-        inherited ppuload(t,ppufile);
-        ppufile.putdata(value,sizeof(value));
+        result:=inherited getcopy;
+        tai_realconst(result).value:=value;
+        tai_realconst(result).realtyp:=realtyp;
+        tai_realconst(result).savesize:=savesize;
+{$ifdef ARM}
+        tai_realconst(result).formatoptions:=formatoptions;
+{$endif ARM}
       end;
 
 
-    procedure tai_comp_64bit.ppuwrite(ppufile:tcompilerppufile);
+    function tai_realconst.datasize: word;
       begin
-        inherited ppuwrite(ppufile);
-        ppufile.getdata(value,sizeof(value));
+        case realtyp of
+          aitrealconst_s32bit:
+            result:=4;
+          aitrealconst_s64bit,
+          aitrealconst_s64comp:
+            result:=8;
+          aitrealconst_s80bit:
+            result:=10;
+          aitrealconst_s128bit:
+            result:=16;
+          else
+            internalerror(2014050603);
+        end;
       end;
 
 
@@ -2047,8 +2065,9 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         len:=ppufile.getlongint;
-        getmem(str,len);
+        getmem(str,len+1);
         ppufile.getdata(str^,len);
+        str[len]:=#0
       end;
 
 
@@ -2548,6 +2567,7 @@ implementation
             if (ref^.segment<>NR_NO) and (ref^.segment<>NR_DS) then
               segprefix:=ref^.segment;
 {$endif}
+{$ifndef llvm}
             if (cs_create_pic in current_settings.moduleswitches) and
               assigned(r.symbol) and
               not assigned(r.relsymbol) and
@@ -2560,6 +2580,7 @@ implementation
 {$endif aarch64}
               then
               internalerror(200502052);
+{$endif not llvm}
             typ:=top_ref;
             if assigned(add_reg_instruction_hook) then
               begin
@@ -2668,6 +2689,12 @@ implementation
               top_wstring:
                 donewidestring(pwstrval);
 {$endif jvm}
+{$ifdef llvm}
+              top_para:
+                paras.free;
+              top_tai:
+                ai.free;
+{$endif llvm}
             end;
             typ:=top_none;
           end;

compiler/aggas.pas

@@ -119,89 +119,10 @@ implementation
     var
       symendcount  : longint;
 
-    type
-{$ifdef cpuextended}
-      t80bitarray = array[0..9] of byte;
-{$endif cpuextended}
-      t64bitarray = array[0..7] of byte;
-      t32bitarray = array[0..3] of byte;
-
 {****************************************************************************}
 {                          Support routines                                  }
 {****************************************************************************}
 
-    function single2str(d : single) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         single2str:='0d'+hs
-      end;
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         double2str:='0d'+hs
-      end;
-
-    function extended2str(e : extended) : string;
-      var
-         hs : string;
-      begin
-         str(e,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         extended2str:='0d'+hs
-      end;
-
-
-  { convert floating point values }
-  { to correct endian             }
-  procedure swap64bitarray(var t: t64bitarray);
-    var
-     b: byte;
-    begin
-      b:= t[7];
-      t[7] := t[0];
-      t[0] := b;
-
-      b := t[6];
-      t[6] := t[1];
-      t[1] := b;
-
-      b:= t[5];
-      t[5] := t[2];
-      t[2] := b;
-
-      b:= t[4];
-      t[4] := t[3];
-      t[3] := b;
-   end;
-
-
-   procedure swap32bitarray(var t: t32bitarray);
-    var
-     b: byte;
-    begin
-      b:= t[1];
-      t[1]:= t[2];
-      t[2]:= b;
-
-      b:= t[0];
-      t[0]:= t[3];
-      t[3]:= b;
-    end;
-
-
     const
       ait_const2str : array[aitconst_128bit..aitconst_64bit_unaligned] of string[20]=(
         #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
@@ -638,8 +559,7 @@ implementation
           needsObject :=
               (
                 assigned(hp.next) and
-                 (tai(hp.next).typ in [ait_const,ait_datablock,
-                  ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit])
+                 (tai(hp.next).typ in [ait_const,ait_datablock,ait_realconst])
               ) or
               (hp.sym.typ=AT_DATA);
 
@@ -1104,101 +1024,9 @@ implementation
                end;
              end;
 
-           { the "and defined(FPC_HAS_TYPE_EXTENDED)" isn't optimal but currently the only solution
-             it prevents proper cross compilation to i386 though
-           }
-{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
-           ait_real_80bit :
+           ait_realconst :
              begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
-             { Make sure e is a extended type, bestreal could be
-               a different type (bestreal) !! (PFV) }
-               e:=tai_real_80bit(hp).value;
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 9 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t80bitarray(e)[i]));
-                end;
-               for i:=11 to tai_real_80bit(hp).savesize do
-                 AsmWrite(',0');
-               AsmLn;
-             end;
-{$endif cpuextended}
-
-           ait_real_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
-               d:=tai_real_64bit(hp).value;
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap64bitarray(t64bitarray(d));
-               AsmWrite(#9'.byte'#9);
-{$ifdef arm}
-               if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
-                 begin
-                   for i:=4 to 7 do
-                     begin
-                       if i<>4 then
-                         AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                   for i:=0 to 3 do
-                     begin
-                       AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                 end
-               else
-{$endif arm}
-                 begin
-                   for i:=0 to 7 do
-                     begin
-                       if i<>0 then
-                         AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                 end;
-               AsmLn;
-             end;
-
-           ait_real_32bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
-               sin:=tai_real_32bit(hp).value;
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap32bitarray(t32bitarray(sin));
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 3 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t32bitarray(sin)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_comp_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
-               AsmWrite(#9'.byte'#9);
-               co:=comp(tai_comp_64bit(hp).value);
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap64bitarray(t64bitarray(co));
-               for i:=0 to 7 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t64bitarray(co)[i]));
-                end;
-               AsmLn;
+               WriteRealConstAsBytes(tai_realconst(hp),#9'.byte'#9,do_line);
              end;
 
            ait_string :

compiler/agjasmin.pas

@@ -391,21 +391,11 @@ implementation
 //                 internalerror(2010122702);
                end;
 
-             ait_real_64bit :
+             ait_realconst :
                begin
                  internalerror(2010122703);
                end;
 
-             ait_real_32bit :
-               begin
-                 internalerror(2010122703);
-               end;
-
-             ait_comp_64bit :
-               begin
-                 internalerror(2010122704);
-               end;
-
              ait_string :
                begin
                  pos:=0;

compiler/alpha/cpupara.pas

@@ -31,7 +31,7 @@ unit cpupara;
        symconst,symbase,symtype,symdef,paramgr;
 
     type
-       talphaparamanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function getintparaloc(nr : longint) : tparalocation;override;
           procedure create_param_loc_info(p : tabstractprocdef);override;
           function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
@@ -45,7 +45,7 @@ unit cpupara;
        cpuinfo,cginfo,cgbase,
        defbase;
 
-    function talphaparamanager.getintparaloc(nr : longint) : tparalocation;
+    function tcpuparamanager.getintparaloc(nr : longint) : tparalocation;
 
       begin
          fillchar(result,sizeof(tparalocation),0);
@@ -119,7 +119,7 @@ unit cpupara;
          end;
       end;
 
-    procedure talphaparamanager.create_param_loc_info(p : tabstractprocdef);
+    procedure tcpuparamanager.create_param_loc_info(p : tabstractprocdef);
 
       var
          nextintreg,nextfloatreg,nextmmreg : tregister;
@@ -246,7 +246,7 @@ unit cpupara;
            end;
       end;
 
-    function talphaparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
+    function tcpuparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
       begin
          case p.returndef.typ of
             orddef,
@@ -286,5 +286,5 @@ unit cpupara;
 
 
 begin
-   paramanager:=talphaparamanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/arm/aasmcpu.pas

@@ -1021,14 +1021,9 @@ implementation
                                             if (tai_const(hp).consttype=aitconst_64bit) then
                                               inc(extradataoffset,multiplier);
                                           end;
-                                        ait_comp_64bit,
-                                        ait_real_64bit:
+                                        ait_realconst:
                                           begin
-                                            inc(extradataoffset,multiplier);
-                                          end;
-                                        ait_real_80bit:
-                                          begin
-                                            inc(extradataoffset,2*multiplier);
+                                            inc(extradataoffset,multiplier*(((tai_realconst(hp).savesize-4)+3) div 4));
                                           end;
                                       end;
                                       { check if the same constant has been already inserted into the currently handled list,
@@ -1084,18 +1079,9 @@ implementation
                   if (tai_const(curtai).consttype=aitconst_64bit) then
                     inc(curinspos,multiplier);
                 end;
-              ait_real_32bit:
-                begin
-                  inc(curinspos,multiplier);
-                end;
-              ait_comp_64bit,
-              ait_real_64bit:
-                begin
-                  inc(curinspos,2*multiplier);
-                end;
-              ait_real_80bit:
+              ait_realconst:
                 begin
-                  inc(curinspos,3*multiplier);
+                  inc(curinspos,multiplier*((tai_realconst(hp).savesize+3) div 4));
                 end;
             end;
             { special case for case jump tables }

compiler/arm/cgcpu.pas

@@ -94,8 +94,6 @@ unit cgcpu;
         procedure fixref(list : TAsmList;var ref : treference);
         function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; virtual;
 
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
-
         procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
         procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
@@ -184,8 +182,6 @@ unit cgcpu;
         procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); override;
 
         function handle_load_store(list: TAsmList; op: tasmop; oppostfix: toppostfix; reg: tregister; ref: treference): treference; override;
-
-        procedure g_external_wrapper(list : TAsmList; procdef : tprocdef; const externalname : string); override;
       end;
 
       tthumbcg64farm = class(tbasecg64farm)
@@ -2271,7 +2267,7 @@ unit cgcpu;
            (tf_pic_uses_got in target_info.flags) then
           begin
             reference_reset(ref,4);
-            current_asmdata.getdatalabel(l);
+            current_asmdata.getglobaldatalabel(l);
             cg.a_label(current_procinfo.aktlocaldata,l);
             ref.symbol:=l;
             ref.base:=NR_PC;
@@ -3138,177 +3134,6 @@ unit cgcpu;
         end;
 
 
-    procedure tbasecgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-
-      procedure loadvmttor12;
-        var
-          tmpref,
-          href : treference;
-          extrareg : boolean;
-          l : TAsmLabel;
-        begin
-          reference_reset_base(href,NR_R0,0,sizeof(pint));
-          if GenerateThumbCode then
-            begin
-              if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
-                begin
-                  list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-                  list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-                end
-              else
-                begin
-                  list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
-                  { create consts entry }
-                  reference_reset(tmpref,4);
-                  current_asmdata.getjumplabel(l);
-                  current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
-                  cg.a_label(current_procinfo.aktlocaldata,l);
-                  tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-                  current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
-                  tmpref.symbol:=l;
-                  tmpref.base:=NR_PC;
-                  list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
-                  href.offset:=0;
-                  href.index:=NR_R1;
-                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-                  list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
-                end;
-            end
-          else
-            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
-        end;
-
-
-      procedure op_onr12methodaddr;
-        var
-          tmpref,
-          href : treference;
-          l : TAsmLabel;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          if GenerateThumbCode then
-            begin
-              reference_reset_base(href,NR_R0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-              if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
-                begin
-                  list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R0,NR_R12));
-                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-                  list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-                end
-              else
-                begin
-                  list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
-                  { create consts entry }
-                  reference_reset(tmpref,4);
-                  current_asmdata.getjumplabel(l);
-                  current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
-                  cg.a_label(current_procinfo.aktlocaldata,l);
-                  tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-                  current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
-                  tmpref.symbol:=l;
-                  tmpref.base:=NR_PC;
-                  list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R0,NR_R12));
-                  href.offset:=0;
-                  href.base:=NR_R0;
-                  href.index:=NR_R1;
-                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
-                  list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-                  list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
-                end;
-            end
-          else
-            begin
-              reference_reset_base(href,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-              cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
-            end;
-          if not(CPUARM_HAS_BX in cpu_capabilities[current_settings.cputype]) then
-            list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12))
-          else
-            list.concat(taicpu.op_reg(A_BX,NR_R12));
-        end;
-
-      var
-        make_global : boolean;
-        tmpref : treference;
-        l : TAsmLabel;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef.struct) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>ObjectSymtable then
-          Internalerror(200109191);
-
-          if GenerateThumbCode or GenerateThumb2Code then
-            list.concat(tai_directive.Create(asd_thumb_func,''));
-
-        make_global:=false;
-        if (not current_module.is_unit) or
-           create_smartlink or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { the wrapper might need aktlocaldata for the additional data to
-          load the constant }
-        current_procinfo:=cprocinfo.create(nil);
-
-        { set param1 interface to self  }
-        g_adjust_self_value(list,procdef,ioffset);
-
-        { case 4 }
-        if (po_virtualmethod in procdef.procoptions) and
-            not is_objectpascal_helper(procdef.struct) then
-          begin
-            loadvmttor12;
-            op_onr12methodaddr;
-          end
-        { case 0 }
-        else if GenerateThumbCode then
-          begin
-            { bl cannot be used here because it destroys lr }
-
-            list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-
-            { create consts entry }
-            reference_reset(tmpref,4);
-            current_asmdata.getjumplabel(l);
-            current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
-            cg.a_label(current_procinfo.aktlocaldata,l);
-            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-            current_procinfo.aktlocaldata.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(procdef.mangledname)));
-
-            tmpref.symbol:=l;
-            tmpref.base:=NR_PC;
-            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
-            list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-            list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-            list.concat(taicpu.op_reg(A_BX,NR_R12));
-          end
-        else
-          list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
-        list.concatlist(current_procinfo.aktlocaldata);
-
-        current_procinfo.Free;
-        current_procinfo:=nil;
-
-        list.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
     procedure tbasecgarm.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
       const
         overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NEG];
@@ -4295,32 +4120,6 @@ unit cgcpu;
       end;
 
 
-    procedure tthumbcgarm.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
-      var
-        tmpref : treference;
-        l : tasmlabel;
-      begin
-        { there is no branch instruction on thumb which allows big distances and which leaves LR as it is
-          and which allows to switch the instruction set }
-
-        { create const entry }
-        reference_reset(tmpref,4);
-        current_asmdata.getjumplabel(l);
-        tmpref.symbol:=l;
-        tmpref.base:=NR_PC;
-        list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-        list.concat(taicpu.op_reg_ref(A_LDR,NR_R0,tmpref));
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
-        list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
-        list.concat(taicpu.op_reg(A_BX,NR_R12));
-
-        { append const entry }
-        list.Concat(tai_align.Create(4));
-        list.Concat(tai_label.create(l));
-        list.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(externalname)));
-      end;
-
-
     procedure tthumb2cgarm.init_register_allocators;
       begin
         inherited init_register_allocators;

compiler/arm/cpupara.pas

@@ -32,7 +32,7 @@ unit cpupara;
        symconst,symtype,symdef,parabase,paramgr;
 
     type
-       tarmparamanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
@@ -59,7 +59,7 @@ unit cpupara;
        procinfo;
 
 
-    function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
         if (target_info.system<>system_arm_darwin) then
           result:=VOLATILE_INTREGISTERS
@@ -68,19 +68,19 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=VOLATILE_FPUREGISTERS;
       end;
 
 
-    function tarmparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
       begin
         result:=VOLATILE_MMREGISTERS;
       end;
 
 
-    procedure tarmparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
+    procedure tcpuparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
       var
         paraloc : pcgparalocation;
         psym : tparavarsym;
@@ -179,7 +179,7 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         if varspez in [vs_var,vs_out,vs_constref] then
@@ -210,7 +210,7 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       var
         i: longint;
         sym: tsym;
@@ -293,7 +293,7 @@ unit cpupara;
       end;
 
 
-    procedure tarmparamanager.init_values(p : tabstractprocdef; side: tcallercallee;
+    procedure tcpuparamanager.init_values(p : tabstractprocdef; side: tcallercallee;
       var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister);
       begin
         curintreg:=RS_R0;
@@ -308,7 +308,7 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+    function tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
         var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
 
       var
@@ -611,7 +611,7 @@ unit cpupara;
       end;
 
 
-    function  tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
@@ -736,7 +736,7 @@ unit cpupara;
       end;
 
 
-    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
@@ -750,7 +750,7 @@ unit cpupara;
      end;
 
 
-    function tarmparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
@@ -767,5 +767,5 @@ unit cpupara;
       end;
 
 begin
-   paramanager:=tarmparamanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/arm/hlcgcpu.pas

@@ -28,18 +28,244 @@ unit hlcgcpu;
 
 interface
 
+  uses
+    aasmdata,
+    symdef,
+    hlcg2ll;
+
+  type
+    tbasehlcgarm = class(thlcg2ll)
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+    end;
+
+    tarmhlcgcpu = class(tbasehlcgarm)
+    end;
+
+    tthumbhlcgcpu = class(tbasehlcgarm)
+      procedure g_external_wrapper(list : TAsmList; procdef : tprocdef; const externalname : string); override;
+    end;
+
   procedure create_hlcodegen;
 
 implementation
 
   uses
-    hlcgobj, hlcg2ll,
-    cgcpu;
+    globals,globtype,verbose,
+    procinfo,fmodule,
+    symconst,
+    aasmbase,aasmtai,aasmcpu, cpuinfo,
+    hlcgobj,
+    cgbase, cgutils, cpubase, cgobj, cgcpu;
+
+  procedure tbasehlcgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+
+    procedure loadvmttor12;
+      var
+        tmpref,
+        href : treference;
+        extrareg : boolean;
+        l : TAsmLabel;
+      begin
+        reference_reset_base(href,voidpointertype,NR_R0,0,sizeof(pint));
+        if GenerateThumbCode then
+          begin
+            if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
+              begin
+                list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+                cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+                list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+              end
+            else
+              begin
+                list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
+                { create consts entry }
+                reference_reset(tmpref,4);
+                current_asmdata.getjumplabel(l);
+                current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
+                cg.a_label(current_procinfo.aktlocaldata,l);
+                tmpref.symboldata:=current_procinfo.aktlocaldata.last;
+                current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
+                tmpref.symbol:=l;
+                tmpref.base:=NR_PC;
+                list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
+                href.offset:=0;
+                href.index:=NR_R1;
+                cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+                list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
+              end;
+          end
+        else
+          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
+      end;
+
+
+    procedure op_onr12methodaddr;
+      var
+        tmpref,
+        href : treference;
+        l : TAsmLabel;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(200006139);
+        if GenerateThumbCode then
+          begin
+            reference_reset_base(href,voidpointertype,NR_R0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+            if (href.offset in [0..124]) and ((href.offset mod 4)=0) then
+              begin
+                list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R0,NR_R12));
+                cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+                list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+              end
+            else
+              begin
+                list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
+                { create consts entry }
+                reference_reset(tmpref,4);
+                current_asmdata.getjumplabel(l);
+                current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
+                cg.a_label(current_procinfo.aktlocaldata,l);
+                tmpref.symboldata:=current_procinfo.aktlocaldata.last;
+                current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(href.offset));
+                tmpref.symbol:=l;
+                tmpref.base:=NR_PC;
+                list.concat(taicpu.op_reg_ref(A_LDR,NR_R1,tmpref));
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R0,NR_R12));
+                href.offset:=0;
+                href.base:=NR_R0;
+                href.index:=NR_R1;
+                cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
+                list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+                list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0,RS_R1]));
+              end;
+          end
+        else
+          begin
+            reference_reset_base(href,voidpointertype,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
+          end;
+        if not(CPUARM_HAS_BX in cpu_capabilities[current_settings.cputype]) then
+          list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12))
+        else
+          list.concat(taicpu.op_reg(A_BX,NR_R12));
+      end;
+
+    var
+      make_global : boolean;
+      tmpref : treference;
+      l : TAsmLabel;
+    begin
+      if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+        Internalerror(200006137);
+      if not assigned(procdef.struct) or
+         (procdef.procoptions*[po_classmethod, po_staticmethod,
+           po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+        Internalerror(200006138);
+      if procdef.owner.symtabletype<>ObjectSymtable then
+        Internalerror(200109191);
+
+        if GenerateThumbCode or GenerateThumb2Code then
+          list.concat(tai_directive.Create(asd_thumb_func,''));
+
+      make_global:=false;
+      if (not current_module.is_unit) or
+         create_smartlink or
+         (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+        make_global:=true;
+
+      if make_global then
+        list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+      else
+        list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+      { the wrapper might need aktlocaldata for the additional data to
+        load the constant }
+      current_procinfo:=cprocinfo.create(nil);
+
+      { set param1 interface to self  }
+      g_adjust_self_value(list,procdef,ioffset);
+
+      { case 4 }
+      if (po_virtualmethod in procdef.procoptions) and
+          not is_objectpascal_helper(procdef.struct) then
+        begin
+          loadvmttor12;
+          op_onr12methodaddr;
+        end
+      { case 0 }
+      else if GenerateThumbCode then
+        begin
+          { bl cannot be used here because it destroys lr }
+
+          list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+
+          { create consts entry }
+          reference_reset(tmpref,4);
+          current_asmdata.getjumplabel(l);
+          current_procinfo.aktlocaldata.Concat(tai_align.Create(4));
+          cg.a_label(current_procinfo.aktlocaldata,l);
+          tmpref.symboldata:=current_procinfo.aktlocaldata.last;
+          current_procinfo.aktlocaldata.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(procdef.mangledname)));
+
+          tmpref.symbol:=l;
+          tmpref.base:=NR_PC;
+          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0);
+          list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+          list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+          list.concat(taicpu.op_reg(A_BX,NR_R12));
+        end
+      else
+        list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
+      list.concatlist(current_procinfo.aktlocaldata);
+
+      current_procinfo.Free;
+      current_procinfo:=nil;
+
+      list.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
+  { tthumbhlcgcpu }
+
+  procedure tthumbhlcgcpu.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+    var
+      tmpref : treference;
+      l : tasmlabel;
+    begin
+      { there is no branch instruction on thumb which allows big distances and which leaves LR as it is
+        and which allows to switch the instruction set }
+
+      { create const entry }
+      reference_reset(tmpref,4);
+      current_asmdata.getjumplabel(l);
+      tmpref.symbol:=l;
+      tmpref.base:=NR_PC;
+      list.concat(taicpu.op_regset(A_PUSH,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+      list.concat(taicpu.op_reg_ref(A_LDR,NR_R0,tmpref));
+      list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_R0));
+      list.concat(taicpu.op_regset(A_POP,R_INTREGISTER,R_SUBWHOLE,[RS_R0]));
+      list.concat(taicpu.op_reg(A_BX,NR_R12));
+
+      { append const entry }
+      list.Concat(tai_align.Create(4));
+      list.Concat(tai_label.create(l));
+      list.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(externalname)));
+    end;
+
+
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      if GenerateThumbCode then
+        hlcg:=tthumbhlcgcpu.create
+      else
+        hlcg:=tarmhlcgcpu.create;
       create_codegen;
     end;
 
+begin
+  chlcgobj:=tbasehlcgarm;
 end.

compiler/arm/narmcnv.pas

@@ -206,7 +206,7 @@ implementation
                         instr.oppostfix:=PF_D;
                         current_asmdata.CurrAsmList.concat(instr);
 
-                        current_asmdata.getdatalabel(l1);
+                        current_asmdata.getglobaldatalabel(l1);
                         current_asmdata.getjumplabel(l2);
                         reference_reset_symbol(href,l1,0,const_align(8));
 

compiler/arm/narmcon.pas

@@ -53,11 +53,11 @@ interface
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
       const
-        floattype2ait:array[tfloattype] of taitype=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
+        floattype2ait:array[tfloattype] of tairealconsttype=
+          (aitrealconst_s32bit,aitrealconst_s64bit,aitrealconst_s80bit,aitrealconst_s80bit,aitrealconst_s64comp,aitrealconst_s64comp,aitrealconst_s128bit);
       var
          lastlabel : tasmlabel;
-         realait : taitype;
+         realait : tairealconsttype;
          hiloswapped : boolean;
 
       begin
@@ -73,55 +73,55 @@ interface
             current_procinfo.aktlocaldata.concat(Tai_label.Create(lastlabel));
             location.reference.symboldata:=current_procinfo.aktlocaldata.last;
             case realait of
-              ait_real_32bit :
+              aitrealconst_s32bit :
                 begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real)));
+                  current_procinfo.aktlocaldata.concat(tai_realconst.create_s32real(ts32real(value_real)));
                   { range checking? }
                   if floating_point_range_check_error and
-                    (tai_real_32bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
+                    (tai_realconst(current_procinfo.aktlocaldata.last).value.s32val=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 
-              ait_real_64bit :
+              aitrealconst_s64bit :
                 begin
                   if hiloswapped then
-                    current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
+                    current_procinfo.aktlocaldata.concat(tai_realconst.create_s64real_hiloswapped(ts64real(value_real)))
                   else
-                    current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real)));
+                    current_procinfo.aktlocaldata.concat(tai_realconst.create_s64real(ts64real(value_real)));
 
                   { range checking? }
                   if floating_point_range_check_error and
-                    (tai_real_64bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
+                    (tai_realconst(current_procinfo.aktlocaldata.last).value.s64val=MathInf.Value) then
                     Message(parser_e_range_check_error);
                end;
 
-              ait_real_80bit :
+              aitrealconst_s80bit :
                 begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real,tfloatdef(resultdef).size));
+                  current_procinfo.aktlocaldata.concat(tai_realconst.create_s80real(value_real,tfloatdef(resultdef).size));
 
                   { range checking? }
                   if floating_point_range_check_error and
-                    (tai_real_80bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
+                    (tai_realconst(current_procinfo.aktlocaldata.last).value.s80val=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 {$ifdef cpufloat128}
-              ait_real_128bit :
+              aitrealconst_s128bit :
                 begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real));
+                  current_procinfo.aktlocaldata.concat(tai_realconst.create_s128real(value_real));
 
                   { range checking? }
                   if floating_point_range_check_error and
-                    (tai_real_128bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then
+                    (tai_realconst(current_procinfo.aktlocaldata.last).value.s128val=MathInf.Value) then
                     Message(parser_e_range_check_error);
                 end;
 {$endif cpufloat128}
 
               { the round is necessary for native compilers where comp isn't a float }
-              ait_comp_64bit :
+              aitrealconst_s64comp :
                 if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
                   message(parser_e_range_check_error)
                 else
-                  current_procinfo.aktlocaldata.concat(Tai_comp_64bit.Create(round(value_real)));
+                  current_procinfo.aktlocaldata.concat(tai_realconst.create_s64compreal(round(value_real)));
             else
               internalerror(2005092401);
             end;

compiler/arm/narmset.pas

@@ -37,7 +37,7 @@ interface
 
        tarminnode = class(tcginnode)
          function pass_1: tnode; override;
-         procedure in_smallset(uopsize: tcgsize; opdef: tdef; setbase: aint); override;
+         procedure in_smallset(opdef: tdef; setbase: aint); override;
        end;
 
       tarmcasenode = class(tcgcasenode)
@@ -77,7 +77,7 @@ implementation
           end;
       end;
 
-    procedure tarminnode.in_smallset(uopsize: tcgsize; opdef: tdef; setbase: aint);
+    procedure tarminnode.in_smallset(opdef: tdef; setbase: aint);
       var
         so : tshifterop;
         hregister : tregister;
@@ -101,7 +101,7 @@ implementation
             hlcg.location_force_reg(current_asmdata.CurrAsmList, right.location,
              right.resultdef, right.resultdef, true);
 
-            hregister:=cg.getintregister(current_asmdata.CurrAsmList, uopsize);
+            hregister:=hlcg.getintregister(current_asmdata.CurrAsmList, opdef);
             current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_MOV,hregister,1));
 
             if GenerateThumbCode or GenerateThumb2Code then

compiler/arm/rgcpu.pas

@@ -28,7 +28,7 @@ unit rgcpu;
   interface
 
      uses
-       aasmbase,aasmtai,aasmdata,aasmcpu,
+       aasmbase,aasmtai,aasmsym,aasmdata,aasmcpu,
        cgbase,cgutils,
        cpubase,
        {$ifdef DEBUG_SPILLING}
@@ -41,9 +41,9 @@ unit rgcpu;
        private
          procedure spilling_create_load_store(list: TAsmList; pos: tai; const spilltemp:treference;tempreg:tregister; is_store: boolean);
        public
-         procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         function do_spill_replace(list : TAsmList;instr : taicpu;
+         procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         function do_spill_replace(list : TAsmList;instr : tai_cpu_abstract_sym;
            orgreg : tsuperregister;const spilltemp : treference) : boolean;override;
          procedure add_constraints(reg:tregister);override;
          function  get_spill_subreg(r:tregister) : tsubregister;override;
@@ -53,8 +53,8 @@ unit rgcpu;
        private
          procedure SplitITBlock(list:TAsmList;pos:tai);
        public
-         procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+         procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
        end;
 
        trgintcputhumb2 = class(trgcputhumb2)
@@ -250,7 +250,7 @@ unit rgcpu;
      end;
 
 
-    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       begin
         { don't load spilled register between
           mov lr,pc
@@ -269,20 +269,20 @@ unit rgcpu;
         if fix_spilling_offset(spilltemp.offset) then
           spilling_create_load_store(list, pos, spilltemp, tempreg, false)
         else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       begin
         if fix_spilling_offset(spilltemp.offset) then
           spilling_create_load_store(list, pos, spilltemp, tempreg, true)
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+    function trgcpu.do_spill_replace(list:TAsmList;instr:tai_cpu_abstract_sym;orgreg:tsuperregister;const spilltemp:treference):boolean;
       var
         b : byte;
       begin
@@ -291,7 +291,7 @@ unit rgcpu;
           exit;
 
         { ldr can't set the flags }
-        if instr.oppostfix=PF_S then
+        if taicpu(instr).oppostfix=PF_S then
           exit;
 
         if GenerateThumbCode and
@@ -426,7 +426,7 @@ unit rgcpu;
           list.InsertAfter(taicpu.op_cond(remOp,taicpu(hp).oper[0]^.cc), pos);
       end;
 
-    procedure trgcputhumb2.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcputhumb2.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister;orgsupreg:tsuperregister);
       var
         tmpref : treference;
         helplist : TAsmList;
@@ -494,11 +494,11 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    procedure trgcputhumb2.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcputhumb2.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister;orgsupreg:tsuperregister);
       var
         tmpref : treference;
         helplist : TAsmList;
@@ -552,7 +552,7 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 

compiler/asmutils.pas

@@ -1,194 +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;
-
-    function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
-
-
-implementation
-
-uses
-  globals,
-  systems,
-  verbose,
-  aasmtai,
-  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<>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<>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;
-
-
-    function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
-      const
-        ansistring_header_size =
-          { encoding }
-          2 +
-          { elesize }
-          2 +
-{$ifdef cpu64bitaddr}
-          { alignment }
-          4 +
-{$endif cpu64bitaddr}
-          { reference count }
-          sizeof(pint) +
-          { length }
-          sizeof(pint);
-        unicodestring_header_size = ansistring_header_size;
-      begin
-        if not(target_info.system in systems_darwin) then
-          result:=0
-        else case typ of
-          st_ansistring:
-            result:=ansistring_header_size;
-          st_unicodestring:
-            result:=unicodestring_header_size;
-          st_widestring:
-            if winlikewidestring then
-              result:=0
-            else
-              result:=unicodestring_header_size;
-          else
-            result:=0;
-        end;
-      end;
-
-
-end.

compiler/assemble.pas

@@ -83,6 +83,10 @@ interface
         lastsectype : TAsmSectionType;
         procedure WriteSourceLine(hp: tailineinfo);
         procedure WriteTempalloc(hp: tai_tempalloc);
+        procedure WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
+        function single2str(d : single) : string; virtual;
+        function double2str(d : double) : string; virtual;
+        function extended2str(e : extended) : string; virtual;
         Function DoPipe:boolean;
       public
         {# Returns the complete path and executable name of the assembler
@@ -117,7 +121,7 @@ interface
         Procedure AsmWriteLn(const s:ansistring);
 
         {# Write a new line to the assembler file }
-        Procedure AsmLn;
+        Procedure AsmLn; virtual;
 
         procedure AsmCreate(Aplace:tcutplace);
         procedure AsmClose;
@@ -272,6 +276,40 @@ Implementation
                                  TExternalAssembler
 *****************************************************************************}
 
+    function TExternalAssembler.single2str(d : single) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         single2str:='0d'+hs
+      end;
+
+    function TExternalAssembler.double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         double2str:='0d'+hs
+      end;
+
+    function TExternalAssembler.extended2str(e : extended) : string;
+      var
+         hs : string;
+      begin
+         str(e,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         extended2str:='0d'+hs
+      end;
+
+
     Function TExternalAssembler.DoPipe:boolean;
       begin
         DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
@@ -775,6 +813,109 @@ Implementation
             tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]);
       end;
 
+
+    procedure TExternalAssembler.WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
+      var
+        pdata: pbyte;
+        index, step, swapmask, count: longint;
+        ssingle: single;
+        ddouble: double;
+        ccomp: comp;
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+        eextended: extended;
+{$endif cpuextended}
+      begin
+        if do_line then
+          begin
+            case tai_realconst(hp).realtyp of
+              aitrealconst_s32bit:
+                AsmWriteLn(target_asm.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
+              aitrealconst_s64bit:
+                AsmWriteLn(target_asm.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+              { can't write full 80 bit floating point constants yet on non-x86 }
+              aitrealconst_s80bit:
+                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
+{$endif cpuextended}
+              aitrealconst_s64comp:
+                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
+              else
+                internalerror(2014050604);
+            end;
+          end;
+        AsmWrite(dbdir);
+        { generic float writing code: get start address of value, then write
+          byte by byte. Can't use fields directly, because e.g ts64comp is
+          defined as extended on x86 }
+        case tai_realconst(hp).realtyp of
+          aitrealconst_s32bit:
+            begin
+              ssingle:=single(tai_realconst(hp).value.s32val);
+              pdata:=@ssingle;
+            end;
+          aitrealconst_s64bit:
+            begin
+              ddouble:=double(tai_realconst(hp).value.s64val);
+              pdata:=@ddouble;
+            end;
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+          { can't write full 80 bit floating point constants yet on non-x86 }
+          aitrealconst_s80bit:
+            begin
+              eextended:=extended(tai_realconst(hp).value.s80val);
+              pdata:=@eextended;
+            end;
+{$endif cpuextended}
+          aitrealconst_s64comp:
+            begin
+              ccomp:=comp(tai_realconst(hp).value.s64compval);
+              pdata:=@ccomp;
+            end;
+          else
+            internalerror(2014051001);
+        end;
+        count:=tai_realconst(hp).datasize;
+        { write bytes in inverse order if source and target endianess don't
+          match }
+        if source_info.endian<>target_info.endian then
+          begin
+            { go from back to front }
+            index:=count-1;
+            step:=-1;
+          end
+        else
+          begin
+            index:=0;
+            step:=1;
+          end;
+{$ifdef ARM}
+        { ARM-specific: low and high dwords of a double may be swapped }
+        if tai_realconst(hp).formatoptions=fo_hiloswapped then
+          begin
+            { only supported for double }
+            if tai_realconst(hp).datasize<>8 then
+              internalerror(2014050605);
+            { switch bit of the index so that the words are written in
+              the opposite order }
+            swapmask:=4;
+          end
+        else
+{$endif ARM}
+          swapmask:=0;
+        repeat
+          AsmWrite(tostr(pdata[index xor swapmask]));
+          inc(index,step);
+          dec(count);
+          if count<>0 then
+            AsmWrite(',');
+        until count=0;
+        { padding }
+        for count:=tai_realconst(hp).datasize+1 to tai_realconst(hp).savesize do
+          AsmWrite(',0');
+        AsmLn;
+      end;
+
+
     procedure TExternalAssembler.WriteTree(p:TAsmList);
       begin
       end;
@@ -1162,14 +1303,8 @@ Implementation
                      ObjData.alloc(Tai_datablock(hp).size);
                    end;
                end;
-             ait_real_80bit :
-               ObjData.alloc(tai_real_80bit(hp).savesize);
-             ait_real_64bit :
-               ObjData.alloc(8);
-             ait_real_32bit :
-               ObjData.alloc(4);
-             ait_comp_64bit :
-               ObjData.alloc(8);
+             ait_realconst:
+               ObjData.alloc(tai_realconst(hp).savesize);
              ait_const:
                begin
                  { if symbols are provided we can calculate the value for relative symbols.
@@ -1296,14 +1431,8 @@ Implementation
                      ObjData.alloc(Tai_datablock(hp).size);
                    end;
                end;
-             ait_real_80bit :
-               ObjData.alloc(tai_real_80bit(hp).savesize);
-             ait_real_64bit :
-               ObjData.alloc(8);
-             ait_real_32bit :
-               ObjData.alloc(4);
-             ait_comp_64bit :
-               ObjData.alloc(8);
+             ait_realconst:
+               ObjData.alloc(tai_realconst(hp).savesize);
              ait_const:
                begin
                  { Recalculate relative symbols }
@@ -1380,9 +1509,6 @@ Implementation
     function TInternalAssembler.TreePass2(hp:Tai):Tai;
       var
         fillbuffer : tfillbuffer;
-{$ifdef x86}
-        co : comp;
-{$endif x86}
         leblen : byte;
         lebbuf : array[0..63] of byte;
         objsym,
@@ -1390,6 +1516,11 @@ Implementation
         objsymend : TObjSymbol;
         zerobuf : array[0..63] of byte;
         relative_reloc: boolean;
+        pdata : pointer;
+        ssingle : single;
+        ddouble : double;
+        eextended : extended;
+        ccomp : comp;
         tmp    : word;
       begin
         fillchar(zerobuf,sizeof(zerobuf),0);
@@ -1437,21 +1568,37 @@ Implementation
                      ObjData.alloc(Tai_datablock(hp).size);
                    end;
                end;
-             ait_real_80bit :
-               begin
-                 ObjData.writebytes(Tai_real_80bit(hp).value,10);
-                 ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
-               end;
-             ait_real_64bit :
-               ObjData.writebytes(Tai_real_64bit(hp).value,8);
-             ait_real_32bit :
-               ObjData.writebytes(Tai_real_32bit(hp).value,4);
-             ait_comp_64bit :
+             ait_realconst:
                begin
-{$ifdef x86}
-                 co:=comp(Tai_comp_64bit(hp).value);
-                 ObjData.writebytes(co,8);
-{$endif x86}
+                 case tai_realconst(hp).realtyp of
+                   aitrealconst_s32bit:
+                     begin
+                       ssingle:=single(tai_realconst(hp).value.s32val);
+                       pdata:=@ssingle;
+                     end;
+                   aitrealconst_s64bit:
+                     begin
+                       ddouble:=double(tai_realconst(hp).value.s64val);
+                       pdata:=@ddouble;
+                     end;
+         {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+                   { can't write full 80 bit floating point constants yet on non-x86 }
+                   aitrealconst_s80bit:
+                     begin
+                       eextended:=extended(tai_realconst(hp).value.s80val);
+                       pdata:=@eextended;
+                     end;
+         {$endif cpuextended}
+                   aitrealconst_s64comp:
+                     begin
+                       ccomp:=comp(tai_realconst(hp).value.s64compval);
+                       pdata:=@ccomp;
+                     end;
+                   else
+                     internalerror(2015030501);
+                 end;
+                 ObjData.writebytes(pdata^,tai_realconst(hp).datasize);
+                 ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize);
                end;
              ait_string :
                ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);

compiler/avr/cgcpu.pas

@@ -98,7 +98,6 @@ unit cgcpu;
         function normalize_ref(list : TAsmList;ref : treference;
           tmpreg : tregister) : treference;
 
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
         procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
 
         procedure a_adjust_sp(list: TAsmList; value: longint);
@@ -1875,12 +1874,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      begin
-        //internalerror(2011021324);
-      end;
-
-
     procedure tcgavr.emit_mov(list: TAsmList;reg2: tregister; reg1: tregister);
       var
          instr: taicpu;

compiler/avr/cpupara.pas

@@ -33,7 +33,7 @@ unit cpupara;
        symconst,symbase,symtype,symdef,parabase,paramgr;
 
     type
-       tavrparamanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
@@ -55,13 +55,13 @@ unit cpupara;
        defutil,symsym;
 
 
-    function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=VOLATILE_INTREGISTERS;
       end;
 
 
-    function tavrparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=VOLATILE_FPUREGISTERS;
       end;
@@ -116,7 +116,7 @@ unit cpupara;
       end;
 
 
-    function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         if varspez in [vs_var,vs_out,vs_constref] then
@@ -147,7 +147,7 @@ unit cpupara;
       end;
 
 
-    function tavrparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       begin
         if handle_common_ret_in_param(def,pd,result) then
           exit;
@@ -172,7 +172,7 @@ unit cpupara;
       end;
 
 
-    procedure tavrparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
+    procedure tcpuparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
       begin
         curintreg:=RS_R25;
         curfloatreg:=RS_INVALID;
@@ -181,8 +181,8 @@ unit cpupara;
       end;
 
 
-    { TODO : fix tavrparamanager.create_paraloc_info_intern }
-    function tavrparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+    { TODO : fix tcpuparamanager.create_paraloc_info_intern }
+    function tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
         var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
 
       var
@@ -380,7 +380,7 @@ unit cpupara;
       end;
 
 
-    function tavrparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
@@ -395,7 +395,7 @@ unit cpupara;
 
 
     { TODO : fix tavrparamanager.get_funcretloc }
-    function  tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         retcgsize : tcgsize;
         paraloc : pcgparalocation;
@@ -519,7 +519,7 @@ unit cpupara;
       end;
 
 
-    function tavrparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
@@ -535,5 +535,5 @@ unit cpupara;
       end;
 
 begin
-   paramanager:=tavrparamanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/avr/hlcgcpu.pas

@@ -28,18 +28,36 @@ unit hlcgcpu;
 
 interface
 
+  uses
+    aasmdata,
+    symdef,
+    hlcg2ll;
+
+  type
+    thlcgcpu = class(thlcg2ll)
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+    end;
+
   procedure create_hlcodegen;
 
 implementation
 
   uses
-    hlcgobj, hlcg2ll,
+    hlcgobj,
     cgcpu;
 
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    begin
+      //internalerror(2011021324);
+    end;
+
+
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
+begin
+  chlcgobj:=thlcgcpu;
 end.

compiler/avr/rgcpu.pas

@@ -36,8 +36,8 @@ unit rgcpu;
      type
        trgcpu = class(trgobj)
          procedure add_constraints(reg:tregister);override;
-         procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+         procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
        end;
 
        trgintcpu = class(trgcpu)
@@ -87,7 +87,7 @@ unit rgcpu;
       end;
 
 
-    procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         helpins  : tai;
         tmpref   : treference;
@@ -110,11 +110,11 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         tmpref   : treference;
         helplist : TAsmList;
@@ -135,7 +135,7 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
+          inherited;
     end;
 
 

compiler/cgbase.pas

@@ -175,7 +175,9 @@ interface
         R_MMXREGISTER,     { = 3 }
         R_MMREGISTER,      { = 4 }
         R_SPECIALREGISTER, { = 5 }
-        R_ADDRESSREGISTER  { = 6 }
+        R_ADDRESSREGISTER, { = 6 }
+        { used on llvm, every temp gets its own "base register" }
+        R_TEMPREGISTER     { = 7 }
       );
 
       { Sub registers }

compiler/cghlcpu.pas

@@ -38,13 +38,13 @@ uses
   type
     thlbasecgcpu = class(tcg)
      public
+      function makeregsize(list: TAsmList; reg: Tregister; size: Tcgsize): Tregister; override;
       procedure g_save_registers(list:TAsmList);override;
       procedure g_restore_registers(list:TAsmList);override;
       procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
       procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean); override;
       procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean); override;
       procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
-      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
 {$ifdef cpuflags}
       procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
       procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
@@ -185,12 +185,6 @@ implementation
       end;
 {$endif}
 
-    procedure thlbasecgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      begin
-        internalerror(2012042820);
-      end;
-
-
     procedure thlbasecgcpu.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
       begin
         internalerror(2012042820);
@@ -208,6 +202,17 @@ implementation
         internalerror(2012042822);
       end;
 
+
+    function thlbasecgcpu.makeregsize(list: TAsmList; reg: Tregister; size: Tcgsize): Tregister;
+      begin
+        { you can't just change the size of a (virtual) register on high level
+          targets, you have to allocate a new register of the right size and
+          move the data there }
+        internalerror(2014081201);
+        { suppress warning }
+        result:=NR_NO;
+      end;
+
     procedure thlbasecgcpu.g_save_registers(list: TAsmList);
       begin
         { do nothing }

compiler/cgobj.pas

@@ -85,6 +85,7 @@ unit cgobj;
           function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
           function getmmregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
           function getflagregister(list:TAsmList;size:Tcgsize):Tregister;virtual;
+          function gettempregister(list:TAsmList):Tregister;virtual;
           {Does the generic cg need SIMD registers, like getmmxregister? Or should
            the cpu specific child cg object have such a method?}
 
@@ -105,7 +106,7 @@ unit cgobj;
           procedure do_register_allocation(list:TAsmList;headertai:tai);virtual;
           procedure translate_register(var reg : tregister);
 
-          function makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister;
+          function makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister; virtual;
 
           {# Emit a label to the instruction stream. }
           procedure a_label(list : TAsmList;l : tasmlabel);virtual;
@@ -346,36 +347,6 @@ unit cgobj;
           }
           procedure optimize_op_const(size: TCGSize; var op: topcg; var a : tcgint);virtual;
 
-         {#
-             This routine is used in exception management nodes. It should
-             save the exception reason currently in the FUNCTION_RETURN_REG. The
-             save should be done either to a temp (pointed to by href).
-             or on the stack (pushing the value on the stack).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_save(list : TAsmList; const href : treference);virtual;
-         {#
-             This routine is used in exception management nodes. It should
-             save the exception reason constant. The
-             save should be done either to a temp (pointed to by href).
-             or on the stack (pushing the value on the stack).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);virtual;
-         {#
-             This routine is used in exception management nodes. It should
-             load the exception reason to the FUNCTION_RETURN_REG. The saved value
-             should either be in the temp. area (pointed to by href , href should
-             *NOT* be freed) or on the stack (the value should be popped).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_load(list : TAsmList; const href : treference);virtual;
 
           procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
@@ -446,15 +417,8 @@ unit cgobj;
           }
           procedure g_restore_registers(list:TAsmList);virtual;
 
-          procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);virtual;
 
-          { generate a stub which only purpose is to pass control the given external method,
-          setting up any additional environment before doing so (if required).
-
-          The default implementation issues a jump instruction to the external name. }
-          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
-
           { initialize the pic/got register }
           procedure g_maybe_got_init(list: TAsmList); virtual;
           { allocallcpuregisters, a_call_name, deallocallcpuregisters sequence }
@@ -671,6 +635,12 @@ implementation
       end;
 
 
+    function tcg.gettempregister(list: TAsmList): Tregister;
+      begin
+        result:=rg[R_TEMPREGISTER].getregister(list,R_SUBWHOLE);
+      end;
+
+
     function Tcg.makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister;
       var
         subreg:Tsubregister;
@@ -2392,25 +2362,6 @@ implementation
       end;
 
 
-    procedure tcg.g_exception_reason_save(list : TAsmList; const href : treference);
-      begin
-        a_load_reg_ref(list, OS_INT, OS_INT, NR_FUNCTION_RESULT_REG, href);
-      end;
-
-
-    procedure tcg.g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);
-      begin
-        a_load_const_ref(list, OS_INT, a, href);
-      end;
-
-
-    procedure tcg.g_exception_reason_load(list : TAsmList; const href : treference);
-      begin
-        a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
-        a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG);
-      end;
-
-
     procedure tcg.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
       var
         hsym : tsym;
@@ -2445,12 +2396,6 @@ implementation
       end;
 
 
-    procedure tcg.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
-      begin
-        a_jmp_name(list,externalname);
-      end;
-
-
     procedure tcg.a_call_name_static(list : TAsmList;const s : string);
       begin
         a_call_name(list,s,false);

compiler/compiler.pas

@@ -56,6 +56,9 @@ uses
 {$endif}
   { cpu targets }
   ,cputarg
+{$ifdef llvm}
+  ,llvmtarg
+{$endif llvm}
   { system information for source system }
   { the information about the target os  }
   { are pulled in by the t_* units       }

compiler/cresstr.pas

@@ -32,16 +32,15 @@ implementation
 
 uses
    SysUtils,
-   cclasses,widestr,
-   cutils,globtype,globals,systems,
-   symconst,symtype,symdef,symsym,
-   verbose,fmodule,ppu,
-   aasmbase,aasmtai,aasmdata,
-   aasmcpu,
 {$if FPC_FULLVERSION<20700}
    ccharset,
 {$endif}
-   asmutils;
+   cclasses,widestr,
+   cutils,globtype,globals,systems,
+   symbase,symconst,symtype,symdef,symsym,
+   verbose,fmodule,ppu,
+   aasmbase,aasmtai,aasmdata,aasmcnst,
+   aasmcpu;
 
     Type
       { These are used to form a singly-linked list, ordered by hash value }
@@ -137,10 +136,12 @@ uses
         resstrlab : tasmsymbol;
         endsymlab : tasmsymbol;
         R : TResourceStringItem;
+        tcb : ttai_typedconstbuilder;
       begin
         { Put resourcestrings in a new objectfile. Putting it in multiple files
           makes the linking too dependent on the linker script requiring a SORT(*) for
           the data sections }
+        tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
         maybe_new_object_file(current_asmdata.asmlists[al_const]);
         new_section(current_asmdata.asmlists[al_const],sec_rodata_norel,make_mangledname('RESSTRTABLE',current_module.localsymtable,''),sizeof(pint));
 
@@ -150,7 +151,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:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage);
         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 +167,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:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage)
             else
               begin
                 valuelab.lab:=nil;
@@ -174,7 +175,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:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage);
 
             {
               Resourcestring index:
@@ -198,6 +199,8 @@ uses
             current_asmdata.asmlists[al_resourcestrings].concat(tai_symbol_end.create(resstrlab));
             R:=TResourceStringItem(R.Next);
           end;
+        { nothing has been emited to the tcb itself }
+        tcb.free;
         new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'3_END'),sizeof(pint));
         endsymlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',current_module.localsymtable,'END'),AB_GLOBAL,AT_DATA);
         current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.create_global(endsymlab,0));
@@ -296,6 +299,10 @@ uses
       var
         resstrs : Tresourcestrings;
       begin
+        { needed for the typed constant defs that get generated/looked up }
+        if assigned(current_module.globalsymtable) then
+          symtablestack.push(current_module.globalsymtable);
+        symtablestack.push(current_module.localsymtable);
         resstrs:=Tresourcestrings.Create;
         resstrs.RegisterResourceStrings;
         if not resstrs.List.Empty then
@@ -305,6 +312,9 @@ uses
             resstrs.WriteRSJFile;
           end;
         resstrs.Free;
+        symtablestack.pop(current_module.localsymtable);
+        if assigned(current_module.globalsymtable) then
+          symtablestack.pop(current_module.globalsymtable);
       end;
 
 end.

compiler/dbgdwarf.pas

@@ -955,10 +955,10 @@ implementation
                       begin
                         { The pointer typecast is needed to prevent a problem with range checking
                           on when the typecast is changed to 'as' }
-                        current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_lab)));
-                        current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
+                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(def.dwarf_lab)));
+                        current_asmdata.getglobaldatalabel(TAsmLabel(pointer(def.dwarf_ref_lab)));
                         if is_implicit_pointer_object_type(def) then
-                          current_asmdata.getdatalabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
+                          current_asmdata.getglobaldatalabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab)));
                       end;
                   end;
               end
@@ -1763,7 +1763,7 @@ implementation
 
           { create a structure with two elements }
           if not(tf_dwarf_only_local_labels in target_info.flags) then
-            current_asmdata.getdatalabel(arr)
+            current_asmdata.getglobaldatalabel(arr)
           else
             current_asmdata.getaddrlabel(arr);
           append_entry(DW_TAG_structure_type,true,[
@@ -1899,7 +1899,7 @@ implementation
           begin
             { create a structure with two elements }
             if not(tf_dwarf_only_local_labels in target_info.flags) then
-              current_asmdata.getdatalabel(proc)
+              current_asmdata.getglobaldatalabel(proc)
             else
               current_asmdata.getaddrlabel(proc);
             append_entry(DW_TAG_structure_type,true,[
@@ -2768,12 +2768,12 @@ implementation
                 s32real:
                   begin
                     current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(pbestreal(sym.value.valueptr)^));
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s32real(pbestreal(sym.value.valueptr)^));
                   end;
                 s64real:
                   begin
                     current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8));
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pbestreal(sym.value.valueptr)^));
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s64real(pbestreal(sym.value.valueptr)^));
                   end;
                 s64comp,
                 s64currency:
@@ -2785,7 +2785,7 @@ implementation
                 sc80real:
                   begin
                     current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size));
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^,sym.constdef.size));
+                    current_asmdata.asmlists[al_dwarf_info].concat(tai_realconst.create_s80real(pextended(sym.value.valueptr)^,sym.constdef.size));
                   end;
                 else
                   internalerror(200601291);
@@ -3704,7 +3704,7 @@ implementation
             if assigned(def.elementdef) then
               begin
                 if not(tf_dwarf_only_local_labels in target_info.flags) then
-                  current_asmdata.getdatalabel(lab)
+                  current_asmdata.getglobaldatalabel(lab)
                 else
                   current_asmdata.getaddrlabel(lab);
                 append_labelentry_ref(DW_AT_type,lab);
@@ -4016,7 +4016,7 @@ implementation
           obj : tasmlabel;
         begin
           if not(tf_dwarf_only_local_labels in target_info.flags) then
-            current_asmdata.getdatalabel(obj)
+            current_asmdata.getglobaldatalabel(obj)
           else
             current_asmdata.getaddrlabel(obj);
           { implicit pointer }

compiler/expunix.pas

@@ -167,7 +167,7 @@ begin
 {$endif x86}
              end
            else
-             cg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,pd.mangledname);
+             hlcg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,pd.mangledname);
            current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
          end;
         exportedsymnames.insert(hp2.name^);

compiler/fmodule.pas

@@ -144,6 +144,9 @@ interface
         symlist       : TFPObjectList;
         ptrdefs       : tPtrDefHashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
         arraydefs     : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
+{$ifdef llvm}
+        llvmdefs      : THashSet; { defs added for llvm-specific reasons (not saved/restored) }
+{$endif llvm}
         ansistrdef    : tobject; { an ansistring def redefined for the current module }
         wpoinfo       : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit }
         globalsymtable,           { pointer to the global symtable of this unit }
@@ -569,6 +572,9 @@ implementation
         symlist:=TFPObjectList.Create(false);
         ptrdefs:=cPtrDefHashSet.Create;
         arraydefs:=THashSet.Create(64,true,false);
+{$ifdef llvm}
+        llvmdefs:=THashSet.Create(64,true,false);
+{$endif llvm}
         ansistrdef:=nil;
         wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
@@ -683,6 +689,9 @@ implementation
         symlist.free;
         ptrdefs.free;
         arraydefs.free;
+{$ifdef llvm}
+        llvmdefs.free;
+{$endif llvm}
         ansistrdef:=nil;
         wpoinfo.free;
         checkforwarddefs.free;
@@ -747,6 +756,10 @@ implementation
         ptrdefs:=cPtrDefHashSet.Create;
         arraydefs.free;
         arraydefs:=THashSet.Create(64,true,false);
+{$ifdef llvm}
+        llvmdefs.free;
+        llvmdefs:=THashSet.Create(64,true,false);
+{$endif llvm}
         wpoinfo.free;
         wpoinfo:=nil;
         checkforwarddefs.free;

compiler/fpcdefs.inc

@@ -259,3 +259,14 @@
 {$if not defined(FPC_HAS_TYPE_EXTENDED) and defined(i386)}
 {$error Cross-compiling from systems without support for an 80 bit extended floating point type to i386 is not yet supported at this time }
 {$endif}
+
+{ llvm backends partially use other backends for parameter info calculation,
+  alignment info, data sizes etc. They always support 64 bit alu though.
+}
+{$ifdef llvm}
+  {$undef SUPPORT_MMX}
+  {$undef cpu16bitalu}
+  {$undef cpu32bitalu}
+  {$define cpu64bitalu}
+  {$define cpuhighleveltarget}
+{$endif}

compiler/globals.pas

@@ -323,9 +323,7 @@ interface
      { Memory sizes }
        heapsize,
        maxheapsize,
-       stacksize,
-       jmp_buf_size,
-       jmp_buf_align : longint;
+       stacksize   : longint;
 
 {$Ifdef EXTDEBUG}
      { parameter switches }
@@ -375,6 +373,7 @@ interface
        defaultmainaliasname = 'main';
        mainaliasname : string = defaultmainaliasname;
 
+
     const
       default_settings : TSettings = (
         alignment : (
@@ -1429,11 +1428,6 @@ implementation
           in options or init_parser }
         stacksize:=0;
         { not initialized yet }
-{$ifndef jvm}
-        jmp_buf_size:=-1;
-{$else}
-        jmp_buf_size:=0;
-{$endif}
         apptype:=app_cui;
 
         { Init values }

compiler/hlcg2ll.pas

@@ -149,11 +149,11 @@ unit hlcg2ll;
           }
           procedure a_loadaddr_ref_cgpara(list : TAsmList;fromsize : tdef;const r : treference;const cgpara : TCGPara);override;
 
-          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
-          procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
+          function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override;
+          function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
+          function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
@@ -296,15 +296,8 @@ unit hlcg2ll;
           }
           procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
 
-          procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override;
 
-          { generate a stub which only purpose is to pass control the given external method,
-          setting up any additional environment before doing so (if required).
-
-          The default implementation issues a jump instruction to the external name. }
-//          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); override;
-
           { Generate code to exit an unwind-protected region. The default implementation
             produces a simple jump to destination label. }
           procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override;
@@ -449,18 +442,19 @@ implementation
       cg.a_loadaddr_ref_cgpara(list,r,cgpara);
     end;
 
-  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcg2ll.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       cg.a_call_name(list,s,weak);
       result:=get_call_result_cgpara(pd,forceresdef);
     end;
 
-  procedure thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+  function thlcg2ll.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
     begin
       cg.a_call_reg(list,reg);
+      result:=get_call_result_cgpara(pd,nil);
     end;
 
-  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
+  function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);
       result:=get_call_result_cgpara(pd,forceresdef);
@@ -946,6 +940,7 @@ implementation
     begin
       cg.g_flags2ref(list,def_cgsize(size),f,ref);
     end;
+
 {$endif cpuflags}
 
   procedure thlcg2ll.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
@@ -988,11 +983,6 @@ implementation
       cg.g_proc_exit(list,parasize,nostackframe);
     end;
 
-  procedure thlcg2ll.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-    begin
-      cg.g_intf_wrapper(list,procdef,labelname,ioffset);
-    end;
-
   procedure thlcg2ll.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
     begin
       cg.g_adjust_self_value(list,procdef,ioffset);

compiler/hlcgobj.pas

@@ -37,8 +37,9 @@ unit hlcgobj;
        cclasses,globtype,constexp,
        cpubase,cgbase,cgutils,parabase,
        aasmbase,aasmtai,aasmdata,aasmcpu,
-       symconst,symtype,symsym,symdef,
-       node,nutils
+       symconst,symbase,symtype,symsym,symdef,
+       node,nutils,
+       tgobj
        ;
 
     type
@@ -82,6 +83,7 @@ unit hlcgobj;
           { warning: only works correctly for fpu types currently }
           function getmmregister(list:TAsmList;size:tdef):Tregister;virtual;
           function getflagregister(list:TAsmList;size:tdef):Tregister;virtual;
+          function gettempregister(list:TAsmList;size:tdef):Tregister;virtual;
           function getregisterfordef(list: TAsmList;size:tdef):Tregister;virtual;
           {Does the generic cg need SIMD registers, like getmmxregister? Or should
            the cpu specific child cg object have such a method?}
@@ -104,8 +106,8 @@ unit hlcgobj;
           {# Returns the kind of register this type should be loaded in (it does not
              check whether this is actually possible, but if it's loaded in a register
              by the compiler for any purpose other than parameter passing/function
-             result loading, this is the register type used }
-          function def2regtyp(def: tdef): tregistertype; virtual;
+             result loading, this is the register type used) }
+          class function def2regtyp(def: tdef): tregistertype; virtual;
 
           {# Returns a reference with its base address set from a pointer that
              has been loaded in a register.
@@ -122,6 +124,9 @@ unit hlcgobj;
           }
           procedure reference_reset_base(var ref: treference; regsize: tdef; reg: tregister; offset, alignment: longint); virtual;
 
+          {# Returns a reference corresponding to a temp }
+          procedure temp_to_ref(p: ptemprecord; out ref: treference); virtual;
+
           {# Emit a label to the instruction stream. }
           procedure a_label(list : TAsmList;l : tasmlabel); inline;
 
@@ -217,14 +222,14 @@ unit hlcgobj;
              Returns the function result location.
              This routine must be overridden for each new target cpu.
           }
-          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
-          procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
+          function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
+          function a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister; const paras: array of pcgpara): tcgpara;virtual;abstract;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
-          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
+          function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             special static calls for inherited methods }
-          procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);virtual;
+          function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;virtual;
 
           { move instructions }
           procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);virtual;abstract;
@@ -282,8 +287,8 @@ unit hlcgobj;
           procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; regsize, tosize: tdef; bitnumber: tregister; const loc: tlocation);virtual;
           procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; tosize: tdef; bitnumber: tcgint; const loc: tlocation);virtual;
 
+          function  get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; virtual;
          protected
-           function  get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
            procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: torddef; out extra_load: boolean);
            procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual;
            procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual;
@@ -309,6 +314,7 @@ unit hlcgobj;
           procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); virtual; abstract;
           procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tdef; const ref1,ref2: treference);virtual;
           procedure a_loadfpu_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister);virtual;
+          procedure a_loadfpu_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);virtual;
           procedure a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);virtual;
           procedure a_loadfpu_reg_cgpara(list : TAsmList;fromsize: tdef;const r : tregister;const cgpara : TCGPara);virtual;
           procedure a_loadfpu_ref_cgpara(list : TAsmList;fromsize : tdef;const ref : treference;const cgpara : TCGPara);virtual;
@@ -321,6 +327,7 @@ unit hlcgobj;
           { required for subsetreg/ref; still tcgsize rather than tdef because of reason mentioned above }
           procedure a_loadmm_loc_reg(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const reg: tregister; shuffle : pmmshuffle);virtual;
           procedure a_loadmm_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);virtual;
+          procedure a_loadmm_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference; shuffle : pmmshuffle);virtual;
           procedure a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
           procedure a_loadmm_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
           procedure a_loadmm_loc_cgpara(list: TAsmList; fromsize: tdef; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
@@ -389,6 +396,42 @@ unit hlcgobj;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract;
 {$endif cpuflags}
 
+          {#
+              This routine is used in exception management nodes. It should
+              save the exception reason currently in the reg. The
+              save should be done either to a temp (pointed to by href).
+              or on the stack (pushing the value on the stack).
+           }
+          procedure g_exception_reason_save(list : TAsmList; fromsize, tosize: tdef; reg: tregister; const href : treference);virtual;
+
+          {#
+              This routine is used in exception management nodes. It should
+              save the exception reason constant. The
+              save should be done either to a temp (pointed to by href).
+              or on the stack (pushing the value on the stack).
+
+              The size of the value to save is OS_S32. The default version
+              saves the exception reason to a temp. memory area.
+           }
+          procedure g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference);virtual;
+
+          {#
+              This routine is used in exception management nodes. It should
+              load the exception reason to reg. The saved value
+              should either be in the temp. area (pointed to by href , href should
+              *NOT* be freed) or on the stack (the value should be popped).
+
+              The size of the value to save is OS_S32. The default version
+              saves the exception reason to a temp. memory area.
+           }
+          procedure g_exception_reason_load(list : TAsmList; fromsize, tosize: tdef; const href : treference; reg: tregister);virtual;
+          {#
+              This routine is called when the current exception reason can be
+              discarded. On platforms that use push/pop, it causes the current
+              value to be popped. On other platforms it doesn't do anything
+          }
+          procedure g_exception_reason_discard(list : TAsmList; size: tdef; href: treference); virtual;
+
           procedure g_maybe_testself(list : TAsmList; selftype: tdef; reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
@@ -474,7 +517,7 @@ unit hlcgobj;
           setting up any additional environment before doing so (if required).
 
           The default implementation issues a jump instruction to the external name. }
-//          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
+          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
 
          protected
           procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
@@ -488,6 +531,14 @@ unit hlcgobj;
             for targets without pointers. }
           procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); virtual;
 
+          { typecasts the pointer in reg to a new pointer. By default it does
+            nothing, only required for type-aware platforms like LLVM }
+          procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister); virtual;
+          { same but for a treference (considers the reference itself, not the
+            value stored at that place in memory). Replaces ref with a new
+            reference if necessary }
+          procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference); virtual;
+
 
           { routines migrated from ncgutil }
 
@@ -534,6 +585,10 @@ unit hlcgobj;
           { generates the code for decrementing the reference count of parameters }
           procedure final_paras(p:TObject;arg:pointer);
          public
+          { helper called by gen_alloc_symtable }
+          procedure varsym_set_localloc(list: TAsmList; vs:tabstractnormalvarsym); virtual;
+          { helper called by gen_alloc_symtable }
+          procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); virtual;
 
           procedure gen_load_para_value(list:TAsmList);virtual;
           { helpers called by gen_load_para_value }
@@ -546,6 +601,7 @@ unit hlcgobj;
             location if it's not initialised by the Pascal code, e.g.
             stack-based architectures. By default it does nothing }
           procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);virtual;
+          procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);virtual;
          public
           { load a tlocation into a cgpara }
           procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);virtual;
@@ -563,10 +619,10 @@ unit hlcgobj;
           procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); virtual;
 
           { generate a call to a routine in the system unit }
-          function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
-          function g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+          function g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
+          function g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
          protected
-          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
+          function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; virtual;
          public
 
 
@@ -574,10 +630,15 @@ unit hlcgobj;
             produces a simple jump to destination label. }
           procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual;abstract;
        end;
+     thlcgobjclass = class of thlcgobj;
 
     var
        {# Main high level code generator class }
        hlcg : thlcgobj;
+       { class type of high level code generator class (also valid when hlcg is
+         nil, in order to be able to call its virtual class methods) }
+       chlcgobj: thlcgobjclass;
+
 
     procedure destroy_hlcodegen;
 
@@ -587,9 +648,9 @@ implementation
        globals,systems,
        fmodule,export,
        verbose,defutil,paramgr,
-       symbase,symtable,
+       symtable,
        nbas,ncon,nld,ncgrtti,pass_1,pass_2,
-       cpuinfo,cgobj,tgobj,cutils,procinfo,
+       cpuinfo,cgobj,cutils,procinfo,
 {$ifdef x86}
        cgx86,
 {$endif x86}
@@ -649,6 +710,13 @@ implementation
       result:=cg.getflagregister(list,def_cgsize(size));
     end;
 
+  function thlcgobj.gettempregister(list: TAsmList; size: tdef): Tregister;
+    begin
+      { doesn't make sense to try to translate this size to tcgsize, temps
+        can have any size }
+      result:=cg.gettempregister(list);
+    end;
+
     function thlcgobj.getregisterfordef(list: TAsmList; size: tdef): Tregister;
       begin
         case def2regtyp(size) of
@@ -710,7 +778,7 @@ implementation
       cg.translate_register(reg);
     end;
 
-  function thlcgobj.def2regtyp(def: tdef): tregistertype;
+  class function thlcgobj.def2regtyp(def: tdef): tregistertype;
     begin
         case def.typ of
           enumdef,
@@ -750,6 +818,11 @@ implementation
       ref.offset:=offset;
     end;
 
+  procedure thlcgobj.temp_to_ref(p: ptemprecord; out ref: treference);
+    begin
+      reference_reset_base(ref,voidstackpointertype,current_procinfo.framepointer,p^.pos,p^.alignment);
+    end;
+
   procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline;
     begin
       cg.a_label(list,l);
@@ -1017,15 +1090,15 @@ implementation
          end;
     end;
 
-  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
+  function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
-      result:=a_call_name(list,pd,s,forceresdef,false);
+      result:=a_call_name(list,pd,s,paras,forceresdef,false);
     end;
 
-    procedure thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
-      begin
-        a_call_name(list,pd,s,nil,false);
-      end;
+  function thlcgobj.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara;
+    begin
+      result:=a_call_name(list,pd,s,paras,nil,false);
+    end;
 
   procedure thlcgobj.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
     var
@@ -1701,7 +1774,7 @@ implementation
     end;
 
 
-  function thlcgobj.get_call_result_cgpara(pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
     begin
       if not assigned(forceresdef) then
         begin
@@ -2366,6 +2439,26 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.a_loadfpu_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);
+    var
+      reg: tregister;
+    begin
+      case loc.loc of
+        LOC_REFERENCE, LOC_CREFERENCE:
+          begin
+            reg:=getfpuregister(list,tosize);
+            a_loadfpu_ref_reg(list,fromsize,tosize,loc.reference,reg);
+            a_loadfpu_reg_ref(list,tosize,tosize,reg,ref);
+          end;
+        LOC_FPUREGISTER, LOC_CFPUREGISTER:
+          begin
+            a_loadfpu_reg_ref(list,fromsize,tosize,loc.register,ref);
+          end;
+        else
+          internalerror(2014080802);
+      end;
+    end;
+
   procedure thlcgobj.a_loadfpu_reg_loc(list: TAsmList; fromsize, tosize: tdef; const reg: tregister; const loc: tlocation);
     begin
       case loc.loc of
@@ -2410,8 +2503,9 @@ implementation
 
   procedure thlcgobj.a_loadfpu_ref_cgpara(list: TAsmList; fromsize: tdef; const ref: treference; const cgpara: TCGPara);
     var
+       hreg : tregister;
        href : treference;
-//       hsize: tcgsize;
+       intptrdef: tdef;
     begin
        case cgpara.location^.loc of
         LOC_FPUREGISTER,LOC_CFPUREGISTER:
@@ -2427,22 +2521,19 @@ implementation
             { concatcopy should choose the best way to copy the data }
             g_concatcopy(list,fromsize,ref,href);
           end;
-        (* not yet supported
         LOC_REGISTER,LOC_CREGISTER:
           begin
-            { force integer size }
-            hsize:=int_cgsize(tcgsize2size[size]);
-{$ifndef cpu64bitalu}
-            if (hsize in [OS_S64,OS_64]) then
-              cg64.a_load64_ref_cgpara(list,ref,cgpara)
-            else
-{$endif not cpu64bitalu}
-              begin
-                cgpara.check_simple_location;
-                a_load_ref_cgpara(list,hsize,ref,cgpara)
-              end;
+            cgpara.check_simple_location;
+            if fromsize.size<>cgpara.location^.def.size then
+              internalerror(2014080603);
+            { convert the reference from a floating point location to an
+              integer location, and load that }
+            intptrdef:=getpointerdef(cgpara.location^.def);
+            hreg:=getaddressregister(list,intptrdef);
+            a_loadaddr_ref_reg(list,fromsize,intptrdef,ref,hreg);
+            reference_reset_base(href,intptrdef,hreg,0,ref.alignment);
+            a_load_ref_cgpara(list,cgpara.location^.def,ref,cgpara);
           end
-        *)
         else
           internalerror(2010120423);
       end;
@@ -2492,6 +2583,39 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.a_loadmm_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference; shuffle: pmmshuffle);
+    var
+      intreg, reg: tregister;
+    begin
+      case loc.loc of
+        LOC_MMREGISTER,LOC_CMMREGISTER:
+          a_loadmm_reg_ref(list,fromsize,tosize,loc.register,ref,shuffle);
+        LOC_REFERENCE,LOC_CREFERENCE:
+          begin
+            reg:=getmmregister(list,tosize);
+            a_loadmm_ref_reg(list,fromsize,tosize,loc.reference,reg,shuffle);
+            a_loadmm_reg_ref(list,tosize,tosize,reg,ref,shuffle);
+          end;
+        LOC_REGISTER,LOC_CREGISTER:
+          begin
+            reg:=getmmregister(list,tosize);
+            a_loadmm_intreg_reg(list,fromsize,tosize,loc.register,reg,shuffle);
+            a_loadmm_reg_ref(list,tosize,tosize,reg,ref,shuffle);
+          end;
+        LOC_SUBSETREG,LOC_CSUBSETREG,
+        LOC_SUBSETREF,LOC_CSUBSETREF:
+          begin
+            intreg:=getintregister(list,fromsize);
+            reg:=getmmregister(list,tosize);
+            a_load_loc_reg(list,fromsize,fromsize,loc,intreg);
+            a_loadmm_intreg_reg(list,fromsize,tosize,intreg,reg,shuffle);
+            a_loadmm_reg_ref(list,tosize,tosize,reg,ref,shuffle);
+          end
+        else
+          internalerror(2014080803);
+      end;
+    end;
+
   procedure thlcgobj.a_loadmm_reg_cgpara(list: TAsmList; fromsize: tdef; reg: tregister; const cgpara: TCGPara; shuffle: pmmshuffle);
     var
       href  : treference;
@@ -2818,7 +2942,7 @@ implementation
     var
       tmpreg: tregister;
     begin
-      tmpreg:=getintregister(list,size);
+      tmpreg:=getregisterfordef(list,size);
       a_load_const_reg(list,size,a,tmpreg);
       a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
     end;
@@ -2827,7 +2951,7 @@ implementation
     var
       tmpreg: tregister;
     begin
-      tmpreg:=getintregister(list,size);
+      tmpreg:=getregisterfordef(list,size);
       a_load_ref_reg(list,size,size,ref,tmpreg);
       a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
     end;
@@ -2955,6 +3079,30 @@ implementation
       end;
     end;
 
+
+  procedure thlcgobj.g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference);
+    begin
+      a_load_reg_ref(list,fromsize,tosize,reg,href);
+    end;
+
+  procedure thlcgobj.g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference);
+    begin
+      a_load_const_ref(list,size,a,href);
+    end;
+
+
+  procedure thlcgobj.g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister);
+    begin
+      a_load_ref_reg(list,fromsize,tosize,href,reg);
+    end;
+
+
+  procedure thlcgobj.g_exception_reason_discard(list: TAsmList; size: tdef; href: treference);
+    begin
+      { do nothing by default }
+    end;
+
+
   procedure thlcgobj.g_maybe_testself(list: TAsmList; selftype: tdef; reg: tregister);
     var
       OKLabel : tasmlabel;
@@ -2971,7 +3119,7 @@ implementation
          paramanager.getintparaloc(pd,1,cgpara1);
          a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
          paramanager.freecgpara(list,cgpara1);
-         g_call_system_proc(list,pd,nil);
+         g_call_system_proc(list,pd,[@cgpara1],nil);
          cgpara1.done;
          a_label(list,oklabel);
        end;
@@ -3019,7 +3167,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3047,7 +3195,7 @@ implementation
         end;
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
       cgpara2.done;
       cgpara1.done;
     end;
@@ -3086,7 +3234,7 @@ implementation
             { these functions get the pointer by value }
             a_load_ref_cgpara(list,t,ref,cgpara1);
           paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil);
         end
        else
         begin
@@ -3108,7 +3256,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
         end;
        cgpara2.done;
        cgpara1.done;
@@ -3134,7 +3282,7 @@ implementation
            paramanager.getintparaloc(pd,1,cgpara1);
            a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
            paramanager.freecgpara(list,cgpara1);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1],nil);
          end
        else
          begin
@@ -3156,7 +3304,7 @@ implementation
               end;
             paramanager.freecgpara(list,cgpara1);
             paramanager.freecgpara(list,cgpara2);
-            g_call_system_proc(list,pd,nil);
+            g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
          end;
        cgpara1.done;
        cgpara2.done;
@@ -3206,7 +3354,7 @@ implementation
             end;
           paramanager.freecgpara(list,cgpara1);
           paramanager.freecgpara(list,cgpara2);
-          g_call_system_proc(list,pd,nil);
+          g_call_system_proc(list,pd,[@cgpara1,@cgpara2],nil);
           cgpara1.done;
           cgpara2.done;
           exit;
@@ -3216,7 +3364,7 @@ implementation
       paramanager.getintparaloc(pd,1,cgpara1);
       a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil);
       cgpara1.done;
     end;
 
@@ -3270,7 +3418,7 @@ implementation
       paramanager.freecgpara(list,cgpara1);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara3);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
 
       cgpara3.done;
       cgpara2.done;
@@ -3441,7 +3589,7 @@ implementation
                   { if low(to) > maxlongint also range error }
                   (lto > aintmax) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
                    exit
                  end;
                { from is signed and to is unsigned -> when looking at to }
@@ -3456,7 +3604,7 @@ implementation
                if (lfrom > aintmax) or
                   (hto < 0) then
                  begin
-                   g_call_system_proc(list,'fpc_rangeerror',nil);
+                   g_call_system_proc(list,'fpc_rangeerror',[],nil);
                    exit
                  end;
                { from is unsigned and to is signed -> when looking at to }
@@ -3479,7 +3627,7 @@ implementation
         a_cmp_const_reg_label(list,maxdef,OC_BE,aintmax,hreg,neglabel)
       else
         a_cmp_const_reg_label(list,maxdef,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
-      g_call_system_proc(list,'fpc_rangeerror',nil);
+      g_call_system_proc(list,'fpc_rangeerror',[],nil);
       a_label(list,neglabel);
     end;
 
@@ -3521,7 +3669,7 @@ implementation
       paramanager.getintparaloc(pd,1,cgpara1);
       a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      getmemres:=g_call_system_proc(list,pd,ptrarrdef);
+      getmemres:=g_call_system_proc(list,pd,[@cgpara1],ptrarrdef);
       cgpara1.done;
       { return the new address }
       location_reset(destloc,LOC_REGISTER,OS_ADDR);
@@ -3557,7 +3705,7 @@ implementation
       paramanager.freecgpara(list,cgpara3);
       paramanager.freecgpara(list,cgpara2);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1,@cgpara2,@cgpara3],nil);
       cgpara3.done;
       cgpara2.done;
       cgpara1.done;
@@ -3576,7 +3724,7 @@ implementation
       { load source }
       a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
       paramanager.freecgpara(list,cgpara1);
-      g_call_system_proc(list,pd,nil);
+      g_call_system_proc(list,pd,[@cgpara1],nil);
       cgpara1.done;
     end;
 
@@ -3584,6 +3732,11 @@ implementation
     begin
     end;
 
+  procedure thlcgobj.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+    begin
+      cg.a_jmp_name(list,externalname);
+    end;
+
   procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
     begin
       case regtyp of
@@ -3649,6 +3802,16 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister);
+    begin
+      { nothing to do }
+    end;
+
+  procedure thlcgobj.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference);
+    begin
+      { nothing to do }
+    end;
+
   procedure thlcgobj.location_force_reg(list: TAsmList; var l: tlocation; src_size, dst_size: tdef; maybeconst: boolean);
     var
       hregister,
@@ -3982,7 +4145,7 @@ implementation
                 cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi))
               else
 {$endif cpu64bitalu}
-                cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
+                a_load_reg_reg(list,n.resultdef,n.resultdef,n.location.register,rr.new);
             end;
           LOC_CFPUREGISTER:
             cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new);
@@ -3991,7 +4154,7 @@ implementation
             cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil);
 {$endif SUPPORT_MMX}
           LOC_CMMREGISTER:
-            cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil);
+            a_loadmm_reg_reg(list,n.resultdef,n.resultdef,n.location.register,rr.new,nil);
           else
             internalerror(2006090920);
         end;
@@ -4271,6 +4434,30 @@ implementation
       current_procinfo:=old_current_procinfo;
     end;
 
+  procedure thlcgobj.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
+    begin
+      if cs_asm_source in current_settings.globalswitches then
+        begin
+          case vs.initialloc.loc of
+            LOC_REFERENCE :
+              begin
+                if not assigned(vs.initialloc.reference.symbol) then
+                  list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
+                     std_regname(vs.initialloc.reference.base)+tostr_with_plus(vs.initialloc.reference.offset)+
+                     ', size='+tcgsize2str(vs.initialloc.size))));
+              end;
+          end;
+        end;
+      vs.localloc:=vs.initialloc;
+      FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
+    end;
+
+  procedure thlcgobj.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
+    begin
+      reference_reset_base(vs.initialloc.reference,voidstackpointertype,tparavarsym(vs).paraloc[calleeside].location^.reference.index,
+          tparavarsym(vs).paraloc[calleeside].location^.reference.offset,tparavarsym(vs).paraloc[calleeside].alignment);
+    end;
+
   procedure thlcgobj.gen_entry_code(list: TAsmList);
     begin
       { the actual profile code can clobber some registers,
@@ -4288,19 +4475,14 @@ implementation
             end;
         end;
 
-      { TODO: create high level version (create compilerprocs in system unit,
-          look up procdef, use hlcgobj.a_call_name()) }
-
       { call startup helpers from main program }
       if (current_procinfo.procdef.proctypeoption=potype_proginit) then
        begin
          { initialize units }
-         cg.allocallcpuregisters(list);
          if not(current_module.islibrary) then
-           cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
+           g_call_system_proc(list,'fpc_initializeunits',[],nil)
          else
-           cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
-         cg.deallocallcpuregisters(list);
+           g_call_system_proc(list,'fpc_libinitializeunits',[],nil);
        end;
 
       list.concat(Tai_force_line.Create);
@@ -4318,7 +4500,7 @@ implementation
       { call __EXIT for main program }
       if (not DLLsource) and
          (current_procinfo.procdef.proctypeoption=potype_proginit) then
-        cg.a_call_name(list,'FPC_DO_EXIT',false);
+        g_call_system_proc(list,'fpc_do_exit',[],nil);
     end;
 
   procedure thlcgobj.inittempvariables(list: TAsmList);
@@ -4329,10 +4511,11 @@ implementation
       hp:=tg.templist;
       while assigned(hp) do
        begin
-         if assigned(hp^.def) and
+         if hp^.fini and
+            assigned(hp^.def) and
             is_managed_type(hp^.def) then
           begin
-            reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
+            temp_to_ref(hp,href);
             g_initialize(list,hp^.def,href);
           end;
          hp:=hp^.next;
@@ -4376,11 +4559,12 @@ implementation
       hp:=tg.templist;
       while assigned(hp) do
        begin
-         if assigned(hp^.def) and
+         if hp^.fini and
+            assigned(hp^.def) and
             is_managed_type(hp^.def) then
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
-            reference_reset_base(href,voidstackpointertype,current_procinfo.framepointer,hp^.pos,voidstackpointertype.size);
+            temp_to_ref(hp,href);
             g_finalize(list,hp^.def,href);
           end;
          hp:=hp^.next;
@@ -4838,6 +5022,11 @@ implementation
       { do nothing by default }
     end;
 
+  procedure thlcgobj.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
+    begin
+      gen_load_loc_cgpara(list,vardef,l,current_procinfo.procdef.funcretloc[calleeside]);
+    end;
+
   procedure thlcgobj.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
     begin
       { Handle Floating point types differently
@@ -4915,7 +5104,6 @@ implementation
   procedure thlcgobj.gen_load_return_value(list: TAsmList);
     var
       ressym : tabstractnormalvarsym;
-      funcretloc : TCGPara;
       retdef : tdef;
     begin
       { Is the loading needed? }
@@ -4928,8 +5116,6 @@ implementation
          ) then
         exit;
 
-      funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
-
       { constructors return self }
       if (current_procinfo.procdef.proctypeoption=potype_constructor) then
         begin
@@ -4949,10 +5135,10 @@ implementation
         begin
           { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
           if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
-            gen_load_loc_cgpara(list,retdef,ressym.localloc,funcretloc);
+            gen_load_loc_function_result(list,retdef,ressym.localloc);
         end
       else
-        gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,funcretloc)
+        gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside])
     end;
 
   procedure thlcgobj.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
@@ -4967,26 +5153,28 @@ implementation
         current_asmdata.asmlists[al_procedures].concatlist(data);
     end;
 
-  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     var
       pd: tprocdef;
     begin
       pd:=search_system_proc(procname);
-      result:=g_call_system_proc_intern(list,pd,forceresdef);
+      pd.init_paraloc_info(callerside);
+      result:=g_call_system_proc_intern(list,pd,paras,forceresdef);
     end;
 
-  function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       { separate non-virtual routine to make it clear that the routine to
         override, if any, is g_call_system_proc_intern (and that none of
         the g_call_system_proc variants should be made virtual) }
-      result:=g_call_system_proc_intern(list,pd,forceresdef);
+      pd.init_paraloc_info(callerside);
+      result:=g_call_system_proc_intern(list,pd,paras,forceresdef);
     end;
 
-  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgobj.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       allocallcpuregisters(list);
-      result:=a_call_name(list,pd,pd.mangledname,forceresdef,false);
+      result:=a_call_name(list,pd,pd.mangledname,paras,forceresdef,false);
       deallocallcpuregisters(list);
     end;
 

compiler/i386/cgcpu.pas

@@ -48,10 +48,6 @@ unit cgcpu;
         procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
         procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
 
-        procedure g_exception_reason_save(list : TAsmList; const href : treference);override;
-        procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);override;
-        procedure g_exception_reason_load(list : TAsmList; const href : treference);override;
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
         procedure g_maybe_got_init(list: TAsmList); override;
      end;
 
@@ -550,36 +546,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.g_exception_reason_save(list : TAsmList; const href : treference);
-      begin
-        if not paramanager.use_fixed_stack then
-          list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
-        else
-         inherited g_exception_reason_save(list,href);
-      end;
-
-
-    procedure tcg386.g_exception_reason_save_const(list : TAsmList;const href : treference; a: tcgint);
-      begin
-        if not paramanager.use_fixed_stack then
-          list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[OS_INT],a))
-        else
-          inherited g_exception_reason_save_const(list,href,a);
-      end;
-
-
-    procedure tcg386.g_exception_reason_load(list : TAsmList; const href : treference);
-      begin
-        if not paramanager.use_fixed_stack then
-          begin
-            a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
-            list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
-          end
-        else
-          inherited g_exception_reason_load(list,href);
-      end;
-
-
     procedure tcg386.g_maybe_got_init(list: TAsmList);
       var
         notdarwin: boolean;
@@ -622,183 +588,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      {
-      possible calling conventions:
-                    default stdcall cdecl pascal register
-      default(0):      OK     OK    OK     OK       OK
-      virtual(1):      OK     OK    OK     OK       OK(2 or 1)
-
-      (0):
-          set self parameter to correct value
-          jmp mangledname
-
-      (1): The wrapper code use %ecx to reach the virtual method address
-           set self to correct value
-           move self,%eax
-           mov  0(%eax),%ecx ; load vmt
-           jmp  vmtoffs(%ecx) ; method offs
-
-      (2): Virtual use values pushed on stack to reach the method address
-           so the following code be generated:
-           set self to correct value
-           push %ebx ; allocate space for function address
-           push %eax
-           mov  self,%eax
-           mov  0(%eax),%eax ; load vmt
-           mov  vmtoffs(%eax),eax ; method offs
-           mov  %eax,4(%esp)
-           pop  %eax
-           ret  0; jmp the address
-
-      }
-
-      { returns whether ECX is used (either as a parameter or is nonvolatile and shouldn't be changed) }
-      function is_ecx_used: boolean;
-        var
-          i: Integer;
-          hp: tparavarsym;
-          paraloc: PCGParaLocation;
-        begin
-          if not (RS_ECX in paramanager.get_volatile_registers_int(procdef.proccalloption)) then
-            exit(true);
-          for i:=0 to procdef.paras.count-1 do
-           begin
-             hp:=tparavarsym(procdef.paras[i]);
-             procdef.init_paraloc_info(calleeside);
-             paraloc:=hp.paraloc[calleeside].Location;
-             while paraloc<>nil do
-               begin
-                 if (paraloc^.Loc=LOC_REGISTER) and (getsupreg(paraloc^.register)=RS_ECX) then
-                   exit(true);
-                 paraloc:=paraloc^.Next;
-               end;
-           end;
-          Result:=false;
-        end;
-
-      procedure getselftoeax(offs: longint);
-        var
-          href : treference;
-          selfoffsetfromsp : longint;
-        begin
-          { mov offset(%esp),%eax }
-          if (procdef.proccalloption<>pocall_register) then
-            begin
-              { framepointer is pushed for nested procs }
-              if procdef.parast.symtablelevel>normal_function_level then
-                selfoffsetfromsp:=2*sizeof(aint)
-              else
-                selfoffsetfromsp:=sizeof(aint);
-              reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs,4);
-              a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
-            end;
-        end;
-
-      procedure loadvmtto(reg: tregister);
-        var
-          href : treference;
-        begin
-          { mov  0(%eax),%reg ; load vmt}
-          reference_reset_base(href,NR_EAX,0,4);
-          a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
-        end;
-
-      procedure op_onregmethodaddr(op: TAsmOp; reg: tregister);
-        var
-          href : treference;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          { call/jmp  vmtoffs(%reg) ; method offs }
-          reference_reset_base(href,reg,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
-          list.concat(taicpu.op_ref(op,S_L,href));
-        end;
-
-
-      procedure loadmethodoffstoeax;
-        var
-          href : treference;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          { mov vmtoffs(%eax),%eax ; method offs }
-          reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
-          a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
-        end;
-
-
-      var
-        lab : tasmsymbol;
-        make_global : boolean;
-        href : treference;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef.struct) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>ObjectSymtable then
-          Internalerror(200109191);
-
-        make_global:=false;
-        if (not current_module.is_unit) or
-           create_smartlink or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { set param1 interface to self  }
-        g_adjust_self_value(list,procdef,ioffset);
-
-        if (po_virtualmethod in procdef.procoptions) and
-            not is_objectpascal_helper(procdef.struct) then
-          begin
-            if (procdef.proccalloption=pocall_register) and is_ecx_used then
-              begin
-                { case 2 }
-                list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
-                list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
-                getselftoeax(8);
-                loadvmtto(NR_EAX);
-                loadmethodoffstoeax;
-                { mov %eax,4(%esp) }
-                reference_reset_base(href,NR_ESP,4,4);
-                list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href));
-                { pop  %eax }
-                list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX));
-                { ret  ; jump to the address }
-                list.concat(taicpu.op_none(A_RET,S_L));
-              end
-            else
-              begin
-                { case 1 }
-                getselftoeax(0);
-                loadvmtto(NR_ECX);
-                op_onregmethodaddr(A_JMP,NR_ECX);
-              end;
-          end
-        { case 0 }
-        else
-          begin
-            if (target_info.system <> system_i386_darwin) then
-              begin
-                lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
-                list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
-              end
-            else
-              list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname,false)))
-          end;
-
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
 { ************* 64bit operations ************ }
 
     procedure tcg64f386.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);

compiler/i386/cpupara.pas

@@ -32,7 +32,7 @@ unit cpupara;
        parabase,paramgr;
 
     type
-       ti386paramanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function param_use_paraloc(const cgpara:tcgpara):boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
@@ -62,10 +62,10 @@ unit cpupara;
         parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
 
 {****************************************************************************
-                                TI386PARAMANAGER
+                                tcpuparamanager
 ****************************************************************************}
 
-    function ti386paramanager.param_use_paraloc(const cgpara:tcgpara):boolean;
+    function tcpuparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -86,7 +86,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       var
         size: longint;
       begin
@@ -164,7 +164,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         { var,out,constref always require address }
@@ -237,7 +237,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.get_para_align(calloption : tproccalloption):byte;
+    function tcpuparamanager.get_para_align(calloption : tproccalloption):byte;
       begin
         if calloption=pocall_oldfpccall then
           begin
@@ -251,7 +251,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
         case calloption of
           pocall_internproc :
@@ -274,21 +274,19 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[0..first_fpu_imreg-1];
       end;
 
 
-    function ti386paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[0..first_mm_imreg-1];
       end;
 
 
-
-
-    function  ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
+    function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
       var
         retcgsize  : tcgsize;
         paraloc : pcgparalocation;
@@ -381,7 +379,7 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
+    procedure tcpuparamanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
       var
         i  : integer;
         hp : tparavarsym;
@@ -530,7 +528,7 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
+    procedure tcpuparamanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
                                                             var parareg,parasize:longint);
       var
         hp : tparavarsym;
@@ -703,7 +701,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         parasize,
         parareg : longint;
@@ -731,7 +729,7 @@ unit cpupara;
       end;
 
 
-    function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
@@ -744,7 +742,7 @@ unit cpupara;
       end;
 
 
-    procedure ti386paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
+    procedure tcpuparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       begin
         { Never a need for temps when value is pushed (calls inside parameters
           will simply allocate even more stack space for their parameters) }
@@ -755,5 +753,5 @@ unit cpupara;
 
 
 begin
-   paramanager:=ti386paramanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/i386/hlcgcpu.pas

@@ -29,6 +29,7 @@ unit hlcgcpu;
 interface
 
   uses
+    globtype,
     aasmdata,
     symtype,symdef,parabase,
     cgbase,cgutils,
@@ -42,6 +43,12 @@ interface
      public
       procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
       procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
+      procedure g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference); override;
+      procedure g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference); override;
+      procedure g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister); override;
+      procedure g_exception_reason_discard(list: TAsmList; size: tdef; href: treference); override;
+
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     end;
 
   procedure create_hlcodegen;
@@ -49,9 +56,12 @@ interface
 implementation
 
   uses
-    globtype,verbose,
+    verbose,
+    fmodule,systems,
+    aasmbase,aasmtai,
     paramgr,
-    cpubase,tgobj,cgobj,cgcpu;
+    symconst,symsym,defutil,
+    cpubase,aasmcpu,tgobj,cgobj,cgx86,cgcpu;
 
   { thlcgcpu }
 
@@ -192,6 +202,221 @@ implementation
     end;
 
 
+  procedure thlcgcpu.g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[def_cgsize(tosize)],reg))
+      else
+        inherited
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[def_cgsize(size)],a))
+      else
+        inherited;
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(tosize)],reg))
+      else
+        inherited;
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_discard(list: TAsmList; size: tdef; href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        begin
+          getcpuregister(list,NR_FUNCTION_RESULT_REG);
+          list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(size)],NR_FUNCTION_RESULT_REG));
+          ungetcpuregister(list,NR_FUNCTION_RESULT_REG);
+        end;
+    end;
+
+
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    {
+    possible calling conventions:
+                  default stdcall cdecl pascal register
+    default(0):      OK     OK    OK     OK       OK
+    virtual(1):      OK     OK    OK     OK       OK(2 or 1)
+
+    (0):
+        set self parameter to correct value
+        jmp mangledname
+
+    (1): The wrapper code use %ecx to reach the virtual method address
+         set self to correct value
+         move self,%eax
+         mov  0(%eax),%ecx ; load vmt
+         jmp  vmtoffs(%ecx) ; method offs
+
+    (2): Virtual use values pushed on stack to reach the method address
+         so the following code be generated:
+         set self to correct value
+         push %ebx ; allocate space for function address
+         push %eax
+         mov  self,%eax
+         mov  0(%eax),%eax ; load vmt
+         mov  vmtoffs(%eax),eax ; method offs
+         mov  %eax,4(%esp)
+         pop  %eax
+         ret  0; jmp the address
+
+    }
+
+    { returns whether ECX is used (either as a parameter or is nonvolatile and shouldn't be changed) }
+    function is_ecx_used: boolean;
+      var
+        i: Integer;
+        hp: tparavarsym;
+        paraloc: PCGParaLocation;
+      begin
+        if not (RS_ECX in paramanager.get_volatile_registers_int(procdef.proccalloption)) then
+          exit(true);
+        for i:=0 to procdef.paras.count-1 do
+         begin
+           hp:=tparavarsym(procdef.paras[i]);
+           procdef.init_paraloc_info(calleeside);
+           paraloc:=hp.paraloc[calleeside].Location;
+           while paraloc<>nil do
+             begin
+               if (paraloc^.Loc=LOC_REGISTER) and (getsupreg(paraloc^.register)=RS_ECX) then
+                 exit(true);
+               paraloc:=paraloc^.Next;
+             end;
+         end;
+        Result:=false;
+      end;
+
+    procedure getselftoeax(offs: longint);
+      var
+        href : treference;
+        selfoffsetfromsp : longint;
+      begin
+        { mov offset(%esp),%eax }
+        if (procdef.proccalloption<>pocall_register) then
+          begin
+            { framepointer is pushed for nested procs }
+            if procdef.parast.symtablelevel>normal_function_level then
+              selfoffsetfromsp:=2*sizeof(aint)
+            else
+              selfoffsetfromsp:=sizeof(aint);
+            reference_reset_base(href,voidstackpointertype,NR_ESP,selfoffsetfromsp+offs,4);
+            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
+          end;
+      end;
+
+    procedure loadvmtto(reg: tregister);
+      var
+        href : treference;
+      begin
+        { mov  0(%eax),%reg ; load vmt}
+        reference_reset_base(href,voidpointertype,NR_EAX,0,4);
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,reg);
+      end;
+
+    procedure op_onregmethodaddr(op: TAsmOp; reg: tregister);
+      var
+        href : treference;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(200006139);
+        { call/jmp  vmtoffs(%reg) ; method offs }
+        reference_reset_base(href,voidpointertype,reg,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
+        list.concat(taicpu.op_ref(op,S_L,href));
+      end;
+
+
+    procedure loadmethodoffstoeax;
+      var
+        href : treference;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(200006139);
+        { mov vmtoffs(%eax),%eax ; method offs }
+        reference_reset_base(href,voidpointertype,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
+      end;
+
+
+    var
+      lab : tasmsymbol;
+      make_global : boolean;
+      href : treference;
+    begin
+      if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+        Internalerror(200006137);
+      if not assigned(procdef.struct) or
+         (procdef.procoptions*[po_classmethod, po_staticmethod,
+           po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+        Internalerror(200006138);
+      if procdef.owner.symtabletype<>ObjectSymtable then
+        Internalerror(200109191);
+
+      make_global:=false;
+      if (not current_module.is_unit) or
+         create_smartlink or
+         (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+        make_global:=true;
+
+      if make_global then
+        List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+      else
+        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+      { set param1 interface to self  }
+      g_adjust_self_value(list,procdef,ioffset);
+
+      if (po_virtualmethod in procdef.procoptions) and
+          not is_objectpascal_helper(procdef.struct) then
+        begin
+          if (procdef.proccalloption=pocall_register) and is_ecx_used then
+            begin
+              { case 2 }
+              list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address}
+              list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX));
+              getselftoeax(8);
+              loadvmtto(NR_EAX);
+              loadmethodoffstoeax;
+              { mov %eax,4(%esp) }
+              reference_reset_base(href,voidstackpointertype,NR_ESP,4,4);
+              list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href));
+              { pop  %eax }
+              list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX));
+              { ret  ; jump to the address }
+              list.concat(taicpu.op_none(A_RET,S_L));
+            end
+          else
+            begin
+              { case 1 }
+              getselftoeax(0);
+              loadvmtto(NR_ECX);
+              op_onregmethodaddr(A_JMP,NR_ECX);
+            end;
+        end
+      { case 0 }
+      else
+        begin
+          if (target_info.system <> system_i386_darwin) then
+            begin
+              lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
+              list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
+            end
+          else
+            list.concat(taicpu.op_sym(A_JMP,S_NO,tcgx86(cg).get_darwin_call_stub(procdef.mangledname,false)))
+        end;
+
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
   procedure create_hlcodegen;
     begin
       hlcg:=thlcgcpu.create;
@@ -200,4 +425,6 @@ implementation
 
 
 
+begin
+  chlcgobj:=thlcgcpu;
 end.

compiler/i8086/cgcpu.pas

@@ -91,12 +91,7 @@ unit cgcpu;
         procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);
         procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
 
-        procedure g_exception_reason_save(list : TAsmList; const href : treference);override;
-        procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);override;
-        procedure g_exception_reason_load(list : TAsmList; const href : treference);override;
-
         procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);override;
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
 
         procedure get_32bit_ops(op: TOpCG; out op1,op2: TAsmOp);
 
@@ -1956,36 +1951,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg8086.g_exception_reason_save(list : TAsmList; const href : treference);
-      begin
-        if not paramanager.use_fixed_stack then
-          list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
-        else
-         inherited g_exception_reason_save(list,href);
-      end;
-
-
-    procedure tcg8086.g_exception_reason_save_const(list : TAsmList;const href : treference; a: tcgint);
-      begin
-        if not paramanager.use_fixed_stack then
-          push_const(list,OS_INT,a)
-        else
-          inherited g_exception_reason_save_const(list,href,a);
-      end;
-
-
-    procedure tcg8086.g_exception_reason_load(list : TAsmList; const href : treference);
-      begin
-        if not paramanager.use_fixed_stack then
-          begin
-            cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
-            list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG))
-          end
-        else
-          inherited g_exception_reason_load(list,href);
-      end;
-
-
     procedure tcg8086.get_32bit_ops(op: TOpCG; out op1, op2: TAsmOp);
       begin
         case op of
@@ -2142,208 +2107,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg8086.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      {
-      possible calling conventions:
-                    default stdcall cdecl pascal register
-      default(0):      OK     OK    OK     OK       OK
-      virtual(1):      OK     OK    OK     OK       OK(2)
-
-      (0):
-          set self parameter to correct value
-          jmp mangledname
-
-      (1): The wrapper code use %eax to reach the virtual method address
-           set self to correct value
-           move self,%bx
-           mov  0(%bx),%bx ; load vmt
-           jmp  vmtoffs(%bx) ; method offs
-
-      (2): Virtual use values pushed on stack to reach the method address
-           so the following code be generated:
-           set self to correct value
-           push %bx ; allocate space for function address
-           push %bx
-           push %di
-           mov  self,%bx
-           mov  0(%bx),%bx ; load vmt
-           mov  vmtoffs(%bx),bx ; method offs
-           mov  %sp,%di
-           mov  %bx,4(%di)
-           pop  %di
-           pop  %bx
-           ret  0; jmp the address
-
-      }
-
-      procedure getselftobx(offs: longint);
-        var
-          href : treference;
-          selfoffsetfromsp : longint;
-        begin
-          { "mov offset(%sp),%bx" }
-          if (procdef.proccalloption<>pocall_register) then
-            begin
-              list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
-              { framepointer is pushed for nested procs }
-              if procdef.parast.symtablelevel>normal_function_level then
-                selfoffsetfromsp:=2*sizeof(aint)
-              else
-                selfoffsetfromsp:=sizeof(aint);
-              if current_settings.x86memorymodel in x86_far_code_models then
-                inc(selfoffsetfromsp,2);
-              list.concat(taicpu.op_reg_reg(A_mov,S_W,NR_SP,NR_DI));
-              reference_reset_base(href,NR_DI,selfoffsetfromsp+offs+2,2);
-              if not segment_regs_equal(NR_SS,NR_DS) then
-                href.segment:=NR_SS;
-              if current_settings.x86memorymodel in x86_near_data_models then
-                cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX)
-              else
-                list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
-              list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
-            end
-          else
-            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_BX,NR_BX);
-        end;
-
-
-      procedure loadvmttobx;
-        var
-          href : treference;
-        begin
-          { mov  0(%bx),%bx ; load vmt}
-          if current_settings.x86memorymodel in x86_near_data_models then
-            begin
-              reference_reset_base(href,NR_BX,0,2);
-              cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
-            end
-          else
-            begin
-              reference_reset_base(href,NR_BX,0,2);
-              href.segment:=NR_ES;
-              list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
-            end;
-        end;
-
-
-      procedure loadmethodoffstobx;
-        var
-          href : treference;
-          srcseg: TRegister;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          if current_settings.x86memorymodel in x86_far_data_models then
-            srcseg:=NR_ES
-          else
-            srcseg:=NR_NO;
-          if current_settings.x86memorymodel in x86_far_code_models then
-            begin
-              { mov vmtseg(%bx),%si ; method seg }
-              reference_reset_base(href,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)+2,2);
-              href.segment:=srcseg;
-              cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_SI);
-            end;
-          { mov vmtoffs(%bx),%bx ; method offs }
-          reference_reset_base(href,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),2);
-          href.segment:=srcseg;
-          cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
-        end;
-
-
-      var
-        lab : tasmsymbol;
-        make_global : boolean;
-        href : treference;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef.struct) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>ObjectSymtable then
-          Internalerror(200109191);
-
-        make_global:=false;
-        if (not current_module.is_unit) or
-           create_smartlink or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { set param1 interface to self  }
-        g_adjust_self_value(list,procdef,ioffset);
-
-        if (po_virtualmethod in procdef.procoptions) and
-            not is_objectpascal_helper(procdef.struct) then
-          begin
-            { case 1 & case 2 }
-            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX)); { allocate space for address}
-            if current_settings.x86memorymodel in x86_far_code_models then
-              list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
-            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
-            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
-            if current_settings.x86memorymodel in x86_far_code_models then
-              list.concat(taicpu.op_reg(A_PUSH,S_W,NR_SI));
-            if current_settings.x86memorymodel in x86_far_code_models then
-              getselftobx(10)
-            else
-              getselftobx(6);
-            loadvmttobx;
-            loadmethodoffstobx;
-            { set target address
-              "mov %bx,4(%sp)" }
-            if current_settings.x86memorymodel in x86_far_code_models then
-              reference_reset_base(href,NR_DI,6,2)
-            else
-              reference_reset_base(href,NR_DI,4,2);
-            if not segment_regs_equal(NR_DS,NR_SS) then
-              href.segment:=NR_SS;
-            list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_SP,NR_DI));
-            list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_BX,href));
-            if current_settings.x86memorymodel in x86_far_code_models then
-              begin
-                inc(href.offset,2);
-                list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_SI,href));
-              end;
-
-            { load ax? }
-            if procdef.proccalloption=pocall_register then
-              list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_BX,NR_AX));
-
-            { restore register
-              pop  %di,bx }
-            if current_settings.x86memorymodel in x86_far_code_models then
-              list.concat(taicpu.op_reg(A_POP,S_W,NR_SI));
-            list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
-            list.concat(taicpu.op_reg(A_POP,S_W,NR_BX));
-
-            { ret  ; jump to the address }
-            if current_settings.x86memorymodel in x86_far_code_models then
-              list.concat(taicpu.op_none(A_RETF,S_W))
-            else
-              list.concat(taicpu.op_none(A_RET,S_W));
-          end
-        { case 0 }
-        else
-          begin
-            lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
-
-            if current_settings.x86memorymodel in x86_far_code_models then
-              list.concat(taicpu.op_sym(A_JMP,S_FAR,lab))
-            else
-              list.concat(taicpu.op_sym(A_JMP,S_NO,lab));
-          end;
-
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
 { ************* 64bit operations ************ }
 
     procedure tcg64f8086.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);

compiler/i8086/cpupara.pas

@@ -32,7 +32,7 @@ unit cpupara;
        parabase,paramgr;
 
     type
-       ti8086paramanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function param_use_paraloc(const cgpara:tcgpara):boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
@@ -74,10 +74,10 @@ unit cpupara;
         parasupregs : array[0..2] of tsuperregister = (RS_AX,RS_DX,RS_CX);
 
 {****************************************************************************
-                                ti8086paramanager
+                                tcpuparamanager
 ****************************************************************************}
 
-    function ti8086paramanager.param_use_paraloc(const cgpara:tcgpara):boolean;
+    function tcpuparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -98,7 +98,7 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       var
         size: longint;
       begin
@@ -115,7 +115,7 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         { var,out,constref always require address }
@@ -188,13 +188,13 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.get_para_align(calloption : tproccalloption):byte;
+    function tcpuparamanager.get_para_align(calloption : tproccalloption):byte;
       begin
         result:=std_param_align;
       end;
 
 
-    function ti8086paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
       begin
         case calloption of
           pocall_internproc :
@@ -215,19 +215,19 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[0..first_fpu_imreg-1];
       end;
 
 
-    function ti8086paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
       begin
         result:=[0..first_mm_imreg-1];
       end;
 
 
-    procedure ti8086paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
+    procedure tcpuparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
       var
         paraloc : pcgparalocation;
         psym: tparavarsym;
@@ -274,7 +274,7 @@ unit cpupara;
       end;
 
 
-    function  ti8086paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
+    function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
       var
         retcgsize  : tcgsize;
         paraloc : pcgparalocation;
@@ -396,7 +396,7 @@ unit cpupara;
       end;
 
 
-    procedure ti8086paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
+    procedure tcpuparamanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
       var
         i  : integer;
         hp : tparavarsym;
@@ -556,7 +556,7 @@ unit cpupara;
       end;
 
 
-    procedure ti8086paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
+    procedure tcpuparamanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
                                                             var parareg,parasize:longint);
       var
         hp : tparavarsym;
@@ -737,7 +737,7 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         parasize,
         parareg : longint;
@@ -765,7 +765,7 @@ unit cpupara;
       end;
 
 
-    function ti8086paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
@@ -778,7 +778,7 @@ unit cpupara;
       end;
 
 
-    procedure ti8086paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
+    procedure tcpuparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       begin
         { Never a need for temps when value is pushed (calls inside parameters
           will simply allocate even more stack space for their parameters) }
@@ -789,5 +789,5 @@ unit cpupara;
 
 
 begin
-   paramanager:=ti8086paramanager.create;
+   paramanager:=tcpuparamanager.create;
 end.

compiler/i8086/hlcgcpu.pas

@@ -69,7 +69,7 @@ interface
 
       procedure reference_reset_base(var ref: treference; regsize: tdef; reg: tregister; offset, alignment: longint); override;
 
-      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
+      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
 
       procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
       procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
@@ -77,6 +77,13 @@ interface
       procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
       procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
 
+      procedure g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference); override;
+      procedure g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference); override;
+      procedure g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister); override;
+      procedure g_exception_reason_discard(list: TAsmList; size: tdef; href: treference); override;
+
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+
       procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
     end;
 
@@ -87,7 +94,8 @@ implementation
   uses
     verbose,
     paramgr,
-    cpubase,cpuinfo,tgobj,cgobj,cgcpu,
+    aasmbase,aasmtai,
+    cpubase,cpuinfo,tgobj,cgobj,cgx86,cgcpu,
     defutil,
     symconst,symcpu,
     procinfo,fmodule,
@@ -279,7 +287,7 @@ implementation
     end;
 
 
-  function thlcgcpu.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcgcpu.a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       if is_proc_far(pd) then
         begin
@@ -393,6 +401,246 @@ implementation
     end;
 
 
+  procedure thlcgcpu.g_exception_reason_save(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[def_cgsize(tosize)],reg))
+      else
+        inherited
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_save_const(list: TAsmList; size: tdef; a: tcgint; const href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[def_cgsize(size)],a))
+      else
+        inherited;
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_load(list: TAsmList; fromsize, tosize: tdef; const href: treference; reg: tregister);
+    begin
+      if not paramanager.use_fixed_stack then
+        list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(tosize)],reg))
+      else
+        inherited;
+    end;
+
+
+  procedure thlcgcpu.g_exception_reason_discard(list: TAsmList; size: tdef; href: treference);
+    begin
+      if not paramanager.use_fixed_stack then
+        begin
+          getcpuregister(list,NR_FUNCTION_RESULT_REG);
+          list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[def_cgsize(size)],NR_FUNCTION_RESULT_REG));
+          ungetcpuregister(list,NR_FUNCTION_RESULT_REG);
+        end;
+    end;
+
+
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    {
+    possible calling conventions:
+                  default stdcall cdecl pascal register
+    default(0):      OK     OK    OK     OK       OK
+    virtual(1):      OK     OK    OK     OK       OK(2)
+
+    (0):
+        set self parameter to correct value
+        jmp mangledname
+
+    (1): The wrapper code use %eax to reach the virtual method address
+         set self to correct value
+         move self,%bx
+         mov  0(%bx),%bx ; load vmt
+         jmp  vmtoffs(%bx) ; method offs
+
+    (2): Virtual use values pushed on stack to reach the method address
+         so the following code be generated:
+         set self to correct value
+         push %bx ; allocate space for function address
+         push %bx
+         push %di
+         mov  self,%bx
+         mov  0(%bx),%bx ; load vmt
+         mov  vmtoffs(%bx),bx ; method offs
+         mov  %sp,%di
+         mov  %bx,4(%di)
+         pop  %di
+         pop  %bx
+         ret  0; jmp the address
+
+    }
+
+    procedure getselftobx(offs: longint);
+      var
+        href : treference;
+        selfoffsetfromsp : longint;
+      begin
+        { "mov offset(%sp),%bx" }
+        if (procdef.proccalloption<>pocall_register) then
+          begin
+            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
+            { framepointer is pushed for nested procs }
+            if procdef.parast.symtablelevel>normal_function_level then
+              selfoffsetfromsp:=2*sizeof(aint)
+            else
+              selfoffsetfromsp:=sizeof(aint);
+            if current_settings.x86memorymodel in x86_far_code_models then
+              inc(selfoffsetfromsp,2);
+            list.concat(taicpu.op_reg_reg(A_mov,S_W,NR_SP,NR_DI));
+            reference_reset_base(href,voidpointertype,NR_DI,selfoffsetfromsp+offs+2,2);
+            if not segment_regs_equal(NR_SS,NR_DS) then
+              href.segment:=NR_SS;
+            if current_settings.x86memorymodel in x86_near_data_models then
+              cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX)
+            else
+              list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
+            list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
+          end
+        else
+          cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_BX,NR_BX);
+      end;
+
+
+    procedure loadvmttobx;
+      var
+        href : treference;
+      begin
+        { mov  0(%bx),%bx ; load vmt}
+        if current_settings.x86memorymodel in x86_near_data_models then
+          begin
+            reference_reset_base(href,voidpointertype,NR_BX,0,2);
+            cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
+          end
+        else
+          begin
+            reference_reset_base(href,voidpointertype,NR_BX,0,2);
+            href.segment:=NR_ES;
+            list.concat(taicpu.op_ref_reg(A_LES,S_W,href,NR_BX));
+          end;
+      end;
+
+
+    procedure loadmethodoffstobx;
+      var
+        href : treference;
+        srcseg: TRegister;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(200006139);
+        if current_settings.x86memorymodel in x86_far_data_models then
+          srcseg:=NR_ES
+        else
+          srcseg:=NR_NO;
+        if current_settings.x86memorymodel in x86_far_code_models then
+          begin
+            { mov vmtseg(%bx),%si ; method seg }
+            reference_reset_base(href,voidpointertype,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)+2,2);
+            href.segment:=srcseg;
+            cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_SI);
+          end;
+        { mov vmtoffs(%bx),%bx ; method offs }
+        reference_reset_base(href,voidpointertype,NR_BX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),2);
+        href.segment:=srcseg;
+        cg.a_load_ref_reg(list,OS_16,OS_16,href,NR_BX);
+      end;
+
+
+    var
+      lab : tasmsymbol;
+      make_global : boolean;
+      href : treference;
+    begin
+      if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+        Internalerror(200006137);
+      if not assigned(procdef.struct) or
+         (procdef.procoptions*[po_classmethod, po_staticmethod,
+           po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+        Internalerror(200006138);
+      if procdef.owner.symtabletype<>ObjectSymtable then
+        Internalerror(200109191);
+
+      make_global:=false;
+      if (not current_module.is_unit) or
+         create_smartlink or
+         (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+        make_global:=true;
+
+      if make_global then
+        List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+      else
+        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+      { set param1 interface to self  }
+      g_adjust_self_value(list,procdef,ioffset);
+
+      if (po_virtualmethod in procdef.procoptions) and
+          not is_objectpascal_helper(procdef.struct) then
+        begin
+          { case 1 & case 2 }
+          list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX)); { allocate space for address}
+          if current_settings.x86memorymodel in x86_far_code_models then
+            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
+          list.concat(taicpu.op_reg(A_PUSH,S_W,NR_BX));
+          list.concat(taicpu.op_reg(A_PUSH,S_W,NR_DI));
+          if current_settings.x86memorymodel in x86_far_code_models then
+            list.concat(taicpu.op_reg(A_PUSH,S_W,NR_SI));
+          if current_settings.x86memorymodel in x86_far_code_models then
+            getselftobx(10)
+          else
+            getselftobx(6);
+          loadvmttobx;
+          loadmethodoffstobx;
+          { set target address
+            "mov %bx,4(%sp)" }
+          if current_settings.x86memorymodel in x86_far_code_models then
+            reference_reset_base(href,voidpointertype,NR_DI,6,2)
+          else
+            reference_reset_base(href,voidpointertype,NR_DI,4,2);
+          if not segment_regs_equal(NR_DS,NR_SS) then
+            href.segment:=NR_SS;
+          list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_SP,NR_DI));
+          list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_BX,href));
+          if current_settings.x86memorymodel in x86_far_code_models then
+            begin
+              inc(href.offset,2);
+              list.concat(taicpu.op_reg_ref(A_MOV,S_W,NR_SI,href));
+            end;
+
+          { load ax? }
+          if procdef.proccalloption=pocall_register then
+            list.concat(taicpu.op_reg_reg(A_MOV,S_W,NR_BX,NR_AX));
+
+          { restore register
+            pop  %di,bx }
+          if current_settings.x86memorymodel in x86_far_code_models then
+            list.concat(taicpu.op_reg(A_POP,S_W,NR_SI));
+          list.concat(taicpu.op_reg(A_POP,S_W,NR_DI));
+          list.concat(taicpu.op_reg(A_POP,S_W,NR_BX));
+
+          { ret  ; jump to the address }
+          if current_settings.x86memorymodel in x86_far_code_models then
+            list.concat(taicpu.op_none(A_RETF,S_W))
+          else
+            list.concat(taicpu.op_none(A_RET,S_W));
+        end
+      { case 0 }
+      else
+        begin
+          lab:=current_asmdata.RefAsmSymbol(procdef.mangledname);
+
+          if current_settings.x86memorymodel in x86_far_code_models then
+            list.concat(taicpu.op_sym(A_JMP,S_FAR,lab))
+          else
+            list.concat(taicpu.op_sym(A_JMP,S_NO,lab));
+        end;
+
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
   procedure thlcgcpu.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
     var
       r,tmpref: treference;
@@ -442,5 +690,6 @@ implementation
     end;
 
 
-
+begin
+  chlcgobj:=thlcgcpu;
 end.

compiler/i8086/n8086cal.pas

@@ -28,6 +28,7 @@ interface
 { $define AnsiStrRef}
 
     uses
+      parabase,
       nx86cal,cgutils;
 
     type
@@ -36,7 +37,7 @@ interface
           procedure pop_parasize(pop_size:longint);override;
           procedure extra_interrupt_code;override;
           procedure extra_call_ref_code(var ref: treference);override;
-          procedure do_call_ref(ref: treference);override;
+          function do_call_ref(ref: treference): tcgpara;override;
        end;
 
 
@@ -49,6 +50,7 @@ implementation
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
       ncal,nbas,nmem,nld,ncnv,
+      hlcgobj,
       cga,cgobj,cgx86,cpuinfo;
 
 
@@ -114,12 +116,13 @@ implementation
       end;
 
 
-    procedure ti8086callnode.do_call_ref(ref: treference);
+    function ti8086callnode.do_call_ref(ref: treference): tcgpara;
       begin
         if current_settings.x86memorymodel in x86_far_code_models then
           current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_FAR,ref))
         else
           current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+        result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
       end;
 
 

compiler/i8086/n8086mem.pas

@@ -161,7 +161,7 @@ implementation
                paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
                paraloc1.done;
                hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
-               hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+               hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',[],nil,false);
                hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
              end;
           end

compiler/i8086/n8086tcon.pas

@@ -63,9 +63,9 @@ uses
         if node.nodetype=niln then
           begin
             if is_farpointer(def) or is_hugepointer(def) then
-              list.concat(Tai_const.Create_32bit(0))
+              ftcb.emit_tai(Tai_const.Create_32bit(0),u32inttype)
             else
-              list.concat(Tai_const.Create_16bit(0));
+              ftcb.emit_tai(Tai_const.Create_16bit(0),u16inttype);
           end
         else
           inherited tc_emit_pointerdef(def, node);

compiler/i8086/rgcpu.pas

@@ -30,7 +30,7 @@ unit rgcpu;
     uses
       cpubase,
       cpuinfo,
-      aasmbase,aasmtai,aasmdata,aasmcpu,
+      aasmbase,aasmtai,aasmsym,aasmdata,aasmcpu,
       cclasses,globtype,cgbase,cgutils,rgobj,rgx86;
 
     type
@@ -38,7 +38,7 @@ unit rgcpu;
        { trgcpu }
 
        trgcpu = class(trgx86)
-          function  do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;override;
+          function  do_spill_replace(list:TAsmList;instr:tai_cpu_abstract_sym;orgreg:tsuperregister;const spilltemp:treference):boolean;override;
           procedure add_constraints(reg:Tregister);override;
        end;
 
@@ -62,7 +62,7 @@ implementation
                                  trgcpu
 *************************************************************************}
 
-    function trgcpu.do_spill_replace(list: TAsmList; instr: taicpu; orgreg: tsuperregister; const spilltemp: treference): boolean;
+    function trgcpu.do_spill_replace(list:TAsmList;instr:tai_cpu_abstract_sym;orgreg:tsuperregister;const spilltemp:treference): boolean;
       var
         spilltemp2: treference;
       begin

compiler/i8086/tgcpu.pas

@@ -37,7 +37,7 @@ unit tgcpu;
 
       ttgi8086 = class(ttgobj)
       protected
-        procedure alloctemp(list: TAsmList; size,alignment : longint; temptype : ttemptype; def:tdef; out ref: treference);override;
+        procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference);override;
       end;
 
 implementation
@@ -47,7 +47,7 @@ uses
 
 { ttgi8086 }
 
-procedure ttgi8086.alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference);
+procedure ttgi8086.alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference);
   begin
     inherited;
     ref.segment:=NR_SS;

compiler/jvm/cpupara.pas

@@ -32,9 +32,9 @@ interface
 
     type
 
-      { TJVMParaManager }
+      { tcpuparamanager }
 
-      TJVMParaManager=class(TParaManager)
+      tcpuparamanager=class(TParaManager)
         function  push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
         function  keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
         function  push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
@@ -64,13 +64,13 @@ implementation
       hlcgobj;
 
 
-    procedure TJVMParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
+    procedure tcpuparamanager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
       begin
         { not yet implemented/used }
         internalerror(2010121001);
       end;
 
-    function TJVMParaManager.push_high_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+    function tcpuparamanager.push_high_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
       begin
         { we don't need a separate high parameter, since all arrays in Java
           have an implicit associated length }
@@ -82,7 +82,7 @@ implementation
       end;
 
 
-    function TJVMParaManager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+    function tcpuparamanager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
       begin
         { even though these don't need a high parameter (see push_high_param),
           we do have to keep the original parameter's array length because it's
@@ -96,7 +96,7 @@ implementation
 
 
     { true if a parameter is too large to copy and only the address is pushed }
-    function TJVMParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=
           jvmimplicitpointertype(def) or
@@ -105,7 +105,7 @@ implementation
       end;
 
 
-    function TJVMParaManager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+    function tcpuparamanager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
       begin
         { in principle also for vs_constref, but since we can't have real
           references, that won't make a difference }
@@ -115,7 +115,7 @@ implementation
       end;
 
 
-    function TJVMParaManager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
+    function tcpuparamanager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
       begin
         { all aggregate types are emulated using indirect pointer types }
         if def.typ in [arraydef,recorddef,setdef,stringdef] then
@@ -125,7 +125,7 @@ implementation
       end;
 
 
-    function TJVMParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
@@ -178,13 +178,13 @@ implementation
         paraloc^.def:=result.def;
       end;
 
-    function TJVMParaManager.param_use_paraloc(const cgpara: tcgpara): boolean;
+    function tcpuparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
       begin
         { all parameters are copied by the VM to local variable locations }
         result:=true;
       end;
 
-    function TJVMParaManager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       begin
         { not as efficient as returning in param for jvmimplicitpointertypes,
           but in the latter case the routines are harder to use from Java
@@ -193,14 +193,14 @@ implementation
         Result:=false;
       end;
 
-    function TJVMParaManager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
+    function tcpuparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
       begin
         { all parameters are passed on the evaluation stack }
         result:=true;
       end;
 
 
-    function TJVMParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
@@ -213,7 +213,7 @@ implementation
       end;
 
 
-    procedure TJVMParaManager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
+    procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
                                                            var parasize:longint);
       var
         paraloc      : pcgparalocation;
@@ -288,7 +288,7 @@ implementation
       end;
 
 
-    function TJVMParaManager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         parasize : longint;
       begin
@@ -302,5 +302,5 @@ implementation
 
 
 begin
-   ParaManager:=TJVMParaManager.create;
+   ParaManager:=tcpuparamanager.create;
 end.

compiler/jvm/hlcgcpu.pas

@@ -47,13 +47,13 @@ uses
       procedure incstack(list : TAsmList;slots: longint);
       procedure decstack(list : TAsmList;slots: longint);
 
-      function def2regtyp(def: tdef): tregistertype; override;
+      class function def2regtyp(def: tdef): tregistertype; override;
 
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
 
-      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
-      procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr);override;
-      procedure a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister); override;
+      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
+      function a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara): tcgpara;override;
+      function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
 
       procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
       procedure a_load_const_ref(list : TAsmList;tosize : tdef;a : tcgint;const ref : treference);override;
@@ -202,7 +202,7 @@ uses
 
       procedure inittempvariables(list:TAsmList);override;
 
-      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; override;
+      function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
 
       { in case of an array, the array base address and index have to be
         put on the evaluation stack before the stored value; similarly, for
@@ -288,7 +288,7 @@ implementation
         list.concat(tai_comment.Create(strpnew('    freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
     end;
 
-  function thlcgjvm.def2regtyp(def: tdef): tregistertype;
+  class function thlcgjvm.def2regtyp(def: tdef): tregistertype;
     begin
       case def.typ of
         { records and enums are implemented via classes }
@@ -316,20 +316,21 @@ implementation
       inherited a_load_const_cgpara(list, tosize, a, cgpara);
     end;
 
-  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     begin
       result:=a_call_name_intern(list,pd,s,forceresdef,false);
     end;
 
-  procedure thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr);
+  function thlcgjvm.a_call_name_inherited(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara): tcgpara;
     begin
-      a_call_name_intern(list,pd,s,nil,true);
+      result:=a_call_name_intern(list,pd,s,nil,true);
     end;
 
 
-  procedure thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister);
+  function thlcgjvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
     begin
       internalerror(2012042824);
+      result.init;
     end;
 
 
@@ -707,30 +708,30 @@ implementation
           a_load_const_stack(list,s32inttype,initdim-1,R_INTREGISTER);
           case elemdef.typ of
             arraydef:
-              g_call_system_proc(list,'fpc_initialize_array_dynarr',nil);
+              g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil);
             recorddef,setdef,procvardef:
               begin
                 tg.gethltemp(list,elemdef,elemdef.size,tt_persistent,recref);
                 a_load_ref_stack(list,elemdef,recref,prepare_stack_for_ref(list,recref,false));
                 case elemdef.typ of
                   recorddef:
-                    g_call_system_proc(list,'fpc_initialize_array_record',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_record',[],nil);
                   setdef:
                     begin
                       if tsetdef(elemdef).elementdef.typ=enumdef then
-                        g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
+                        g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
                       else
-                        g_call_system_proc(list,'fpc_initialize_array_bitset',nil)
+                        g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil)
                     end;
                   procvardef:
-                    g_call_system_proc(list,'fpc_initialize_array_procvar',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_procvar',[],nil);
                 end;
                 tg.ungettemp(list,recref);
               end;
             enumdef:
               begin
                 a_load_ref_stack(list,java_jlobject,enuminitref,prepare_stack_for_ref(list,enuminitref,false));
-                g_call_system_proc(list,'fpc_initialize_array_object',nil);
+                g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
               end;
             stringdef:
               begin
@@ -738,13 +739,13 @@ implementation
                   st_shortstring:
                     begin
                       a_load_const_stack_intern(list,u8inttype,tstringdef(elemdef).len,R_INTREGISTER,true);
-                      g_call_system_proc(list,'fpc_initialize_array_shortstring',nil);
+                      g_call_system_proc(list,'fpc_initialize_array_shortstring',[],nil);
                     end;
                   st_ansistring:
-                    g_call_system_proc(list,'fpc_initialize_array_ansistring',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil);
                   st_unicodestring,
                   st_widestring:
-                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil);
+                    g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil);
                   else
                     internalerror(2011081801);
                 end;
@@ -952,7 +953,7 @@ implementation
     end;
 
 
-  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+  function thlcgjvm.g_call_system_proc_intern(list: TAsmList; pd: tprocdef; const paras: array of pcgpara; forceresdef: tdef): tcgpara;
     begin
       result:=inherited;
       pd.init_paraloc_info(callerside);
@@ -1415,7 +1416,7 @@ implementation
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
          a_load_const_stack(list,s32inttype,-1,R_INTREGISTER);
        end;
-     g_call_system_proc(list,procname,nil);
+     g_call_system_proc(list,procname,[],nil);
      if ndim<>1 then
        begin
          { pop return value, must be the same as dest }
@@ -1439,7 +1440,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,size.typename+'.fpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,nil,false);
+        a_call_name(list,pd,pd.mangledname,[],nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1451,9 +1452,9 @@ implementation
         a_load_ref_stack(list,size,dest,prepare_stack_for_ref(list,dest,false));
         { call set copy helper }
         if tsetdef(size).elementdef.typ=enumdef then
-          g_call_system_proc(list,'fpc_enumset_copy',nil)
+          g_call_system_proc(list,'fpc_enumset_copy',[],nil)
         else
-          g_call_system_proc(list,'fpc_bitset_copy',nil);
+          g_call_system_proc(list,'fpc_bitset_copy',[],nil);
       end;
 
 
@@ -1472,7 +1473,7 @@ implementation
            (srsym.typ<>procsym) then
           Message1(cg_f_unknown_compilerproc,'ShortstringClass.FpcDeepCopy');
         pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
-        a_call_name(list,pd,pd.mangledname,nil,false);
+        a_call_name(list,pd,pd.mangledname,[],nil,false);
         { both parameters are removed, no function result }
         decstack(list,2);
       end;
@@ -1661,22 +1662,22 @@ implementation
       a_load_const_stack(list,s32inttype,normaldim,R_INTREGISTER);
       { highloc is invalid, the length is part of the array in Java }
       if is_wide_or_unicode_string(t) then
-        g_call_system_proc(list,'fpc_initialize_array_unicodestring',nil)
+        g_call_system_proc(list,'fpc_initialize_array_unicodestring',[],nil)
       else if is_ansistring(t) then
-        g_call_system_proc(list,'fpc_initialize_array_ansistring',nil)
+        g_call_system_proc(list,'fpc_initialize_array_ansistring',[],nil)
       else if is_dynamic_array(t) then
-        g_call_system_proc(list,'fpc_initialize_array_dynarr',nil)
+        g_call_system_proc(list,'fpc_initialize_array_dynarr',[],nil)
       else if is_record(t) or
               (t.typ=setdef) then
         begin
           tg.gethltemp(list,t,t.size,tt_persistent,eleref);
           a_load_ref_stack(list,t,eleref,prepare_stack_for_ref(list,eleref,false));
           if is_record(t) then
-            g_call_system_proc(list,'fpc_initialize_array_record',nil)
+            g_call_system_proc(list,'fpc_initialize_array_record',[],nil)
           else if tsetdef(t).elementdef.typ=enumdef then
-            g_call_system_proc(list,'fpc_initialize_array_enumset',nil)
+            g_call_system_proc(list,'fpc_initialize_array_enumset',[],nil)
           else
-            g_call_system_proc(list,'fpc_initialize_array_bitset',nil);
+            g_call_system_proc(list,'fpc_initialize_array_bitset',[],nil);
           tg.ungettemp(list,eleref);
         end
       else if (t.typ=enumdef) then
@@ -1684,7 +1685,7 @@ implementation
           if get_enum_init_val_ref(t,eleref) then
             begin
               a_load_ref_stack(list,java_jlobject,eleref,prepare_stack_for_ref(list,eleref,false));
-              g_call_system_proc(list,'fpc_initialize_array_object',nil);
+              g_call_system_proc(list,'fpc_initialize_array_object',[],nil);
             end;
         end
       else
@@ -1717,7 +1718,7 @@ implementation
           else
             internalerror(2013113008);
           a_load_ref_stack(list,java_jlobject,ref,prepare_stack_for_ref(list,ref,false));
-          a_call_name(list,pd,pd.mangledname,nil,false);
+          a_call_name(list,pd,pd.mangledname,[],nil,false);
           { parameter removed, no result }
           decstack(list,1);
         end
@@ -1744,7 +1745,7 @@ implementation
         exit;
       current_asmdata.getjumplabel(hl);
       a_cmp_const_loc_label(list,s32inttype,OC_EQ,0,ovloc,hl);
-      g_call_system_proc(list,'fpc_overflow',nil);
+      g_call_system_proc(list,'fpc_overflow',[],nil);
       a_label(list,hl);
     end;
 
@@ -2556,4 +2557,6 @@ implementation
       create_codegen;
     end;
 
+begin
+  chlcgobj:=thlcgjvm;
 end.

compiler/jvm/njvmflw.pas

@@ -41,10 +41,14 @@ interface
 
        tjvmtryexceptnode = class(ttryexceptnode)
           procedure pass_generate_code;override;
+         protected
+          procedure adjust_estimated_stack_size; override;
        end;
 
        tjvmtryfinallynode = class(ttryfinallynode)
           procedure pass_generate_code;override;
+         protected
+          procedure adjust_estimated_stack_size; override;
        end;
 
        tjvmonnode = class(tonnode)
@@ -258,6 +262,12 @@ implementation
       end;
 
 
+    procedure tjvmtryexceptnode.adjust_estimated_stack_size;
+      begin
+        { do nothing }
+      end;
+
+
     {*****************************************************************************
                                    SecondOn
     *****************************************************************************}
@@ -498,6 +508,12 @@ implementation
          flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
       end;
 
+
+    procedure tjvmtryfinallynode.adjust_estimated_stack_size;
+      begin
+        { do nothing }
+      end;
+
 begin
    cfornode:=tjvmfornode;
    craisenode:=tjvmraisenode;

compiler/jvm/njvmmat.pas

@@ -26,7 +26,7 @@ unit njvmmat;
 interface
 
     uses
-      node,nmat,ncgmat;
+      node,nmat,ncgmat,ncghlmat;
 
     type
       tjvmmoddivnode = class(tmoddivnode)
@@ -40,9 +40,7 @@ interface
          procedure pass_generate_code;override;
       end;
 
-      tjvmnotnode = class(tcgnotnode)
-         function pass_1: tnode; override;
-         procedure second_boolean;override;
+      tjvmnotnode = class(tcghlnotnode)
       end;
 
       tjvmunaryminusnode = class(tcgunaryminusnode)
@@ -158,7 +156,7 @@ implementation
              hlcg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,resultdef,left.location.register,tmpreg);
              current_asmdata.getjumplabel(lab);
              hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,-1,tmpreg,lab);
-             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil);
+             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil);
              hlcg.a_label(current_asmdata.CurrAsmList,lab);
            end;
       end;
@@ -187,35 +185,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                               tjvmnotnode
-*****************************************************************************}
-
-    function tjvmnotnode.pass_1: tnode;
-      begin
-        result:=inherited;
-        if not assigned(result) and
-           is_boolean(resultdef) then
-          expectloc:=LOC_JUMP;
-      end;
-
-
-    procedure tjvmnotnode.second_boolean;
-      var
-        hl : tasmlabel;
-      begin
-        hl:=current_procinfo.CurrTrueLabel;
-        current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
-        current_procinfo.CurrFalseLabel:=hl;
-        secondpass(left);
-        hlcg.maketojumpbool(current_asmdata.CurrAsmList,left);
-        hl:=current_procinfo.CurrTrueLabel;
-        current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
-        current_procinfo.CurrFalseLabel:=hl;
-        location.loc:=LOC_JUMP;
-      end;
-
-
 {*****************************************************************************
                             tjvmunaryminustnode
 *****************************************************************************}

compiler/jvm/njvmmem.pas

@@ -46,6 +46,11 @@ interface
           procedure pass_generate_code; override;
        end;
 
+       tjvmsubscriptnode = class(tcgsubscriptnode)
+        protected
+         function handle_platform_subscript: boolean; override;
+       end;
+
        tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode)
          procedure pass_generate_code; override;
        end;
@@ -123,6 +128,27 @@ implementation
           end
       end;
 
+
+{*****************************************************************************
+                            TJVMSUBSCRIPTNODE
+*****************************************************************************}
+
+    function tjvmsubscriptnode.handle_platform_subscript: boolean;
+      begin
+        result:=false;
+        if is_java_class_or_interface(left.resultdef) or
+           (left.resultdef.typ=recorddef) then
+          begin
+            if (location.loc<>LOC_REFERENCE) or
+               (location.reference.index<>NR_NO) or
+               assigned(location.reference.symbol) then
+              internalerror(2011011301);
+            location.reference.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
+            result:=true;
+          end
+      end;
+
+
 {*****************************************************************************
                               TJVMADDRNODE
 *****************************************************************************}
@@ -418,7 +444,7 @@ implementation
                   (tprocsym(psym).ProcdefList.count<>1) then
                  internalerror(2011062607);
                thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,right.resultdef,right.location);
-               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,nil,false);
+               hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(tprocsym(psym).procdeflist[0]),tprocdef(tprocsym(psym).procdeflist[0]).mangledname,[],nil,false);
                { call replaces self parameter with longint result -> no stack
                  height change }
                location_reset(right.location,LOC_REGISTER,OS_S32);
@@ -478,6 +504,7 @@ implementation
 
 begin
    cderefnode:=tjvmderefnode;
+   csubscriptnode:=tjvmsubscriptnode;
    caddrnode:=tjvmaddrnode;
    cvecnode:=tjvmvecnode;
    cloadvmtaddrnode:=tjvmloadvmtaddrnode;

compiler/jvm/tgcpu.pas

@@ -41,13 +41,13 @@ unit tgcpu;
        ttgjvm = class(ttgobj)
         protected
          procedure getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
-         function getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
-         procedure alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference); override;
+         function getifspecialtemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference): boolean;
+         procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); override;
         public
-         procedure setfirsttemp(l : longint); override;
-         procedure getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference); override;
+         procedure setfirsttemp(l : asizeint); override;
+         procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference); override;
          procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
-         procedure gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
+         procedure gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
        end;
 
   implementation
@@ -85,14 +85,14 @@ unit tgcpu;
           end
         else
           internalerror(2011060301);
-        hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+        hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
         thlcgjvm(hlcg).decstack(list,1);
         { store reference to instance }
         thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
       end;
 
 
-    function ttgjvm.getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
+    function ttgjvm.getifspecialtemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference): boolean;
       var
         eledef: tdef;
         ndim: longint;
@@ -145,7 +145,7 @@ unit tgcpu;
                       if tprocsym(sym).procdeflist.Count<>1 then
                         internalerror(2011062801);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
-                      hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                      hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                     end;
                   { static calls method replaces parameter with set instance
                     -> no change in stack height }
@@ -169,7 +169,7 @@ unit tgcpu;
                     end
                   else
                     internalerror(2011062803);
-                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                   { duplicate self pointer is removed }
                   thlcgjvm(hlcg).decstack(list,1);
                 end;
@@ -202,7 +202,7 @@ unit tgcpu;
                       if tprocsym(sym).procdeflist.Count<>1 then
                         internalerror(2011052404);
                       pd:=tprocdef(tprocsym(sym).procdeflist[0]);
-                      hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                      hlcg.a_call_name(list,pd,pd.mangledname,[],nil,false);
                     end;
                   { static calls method replaces parameter with string instance
                     -> no change in stack height }
@@ -215,7 +215,7 @@ unit tgcpu;
       end;
 
 
-    procedure ttgjvm.alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference);
+    procedure ttgjvm.alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference);
       begin
         { the JVM only supports 1 slot (= 4 bytes in FPC) and 2 slot (= 8 bytes in
           FPC) temps on the stack. double and int64 are 2 slots, the rest is one slot.
@@ -227,18 +227,18 @@ unit tgcpu;
           internalerror(2010121401);
         { don't pass on "def", since we don't care if a slot is used again for a
           different type }
-        inherited alloctemp(list, size shr 2, 1, temptype, nil,ref);
+        inherited alloctemp(list, size shr 2, 1, temptype, nil, false, ref);
       end;
 
 
-    procedure ttgjvm.setfirsttemp(l: longint);
+    procedure ttgjvm.setfirsttemp(l: asizeint);
       begin
         firsttemp:=l;
         lasttemp:=l;
       end;
 
 
-    procedure ttgjvm.getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference);
+    procedure ttgjvm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference);
       begin
         if not getifspecialtemp(list,def,size,tt_persistent,ref) then
           inherited;
@@ -251,7 +251,7 @@ unit tgcpu;
           inherited;
       end;
 
-    procedure ttgjvm.gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+    procedure ttgjvm.gethltempmanaged(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
       begin
         gethltemp(list,def,def.size,temptype,ref);
       end;

compiler/llvm/aasmllvm.pas

@@ -0,0 +1,871 @@
+{
+    Copyright (c) 2010, 2013 by Jonas Maebe
+
+    Contains the assembler object 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 aasmllvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,verbose,cclasses,
+      aasmbase,aasmtai,aasmdata,aasmsym,
+      cpubase,cgbase,cgutils,
+      symtype,symdef,symsym,
+      llvmbase;
+
+    type
+      { taillvm }
+      taillvm = class(tai_cpu_abstract_sym)
+       private
+        procedure maybe_declare(def: tdef; const ref: treference);
+       public
+        llvmopcode: tllvmop;
+
+        constructor create_llvm(op: tllvmop);
+
+        { e.g. ret void }
+        constructor op_size(op : tllvmop; size: tdef);
+
+        { e.g. dst = alloca size }
+        constructor op_reg_size(op:tllvmop;dst:tregister;size:tdef);
+        { e.g. dst = alloca size }
+        constructor op_ref_size(op:tllvmop;const dst:treference;size:tdef);
+
+        { e.g. dst = add size src1, src2 }
+        constructor op_reg_size_reg_reg(op:tllvmop;dst:tregister;size:tdef;src1,src2:tregister);
+        { e.g. dst = shl size src1, 1 ( = src1 shl 1) }
+        constructor op_reg_size_reg_const(op:tllvmop;dst:tregister;size:tdef;src1:tregister;src2:int64);
+        { e.g. dst = sub size 0, src2 ( = 0 - src2) }
+        constructor op_reg_size_const_reg(op:tllvmop;dst:tregister;size:tdef;src1:int64;src2:tregister);
+        { e.g. dst = bitcast size1 src to tosize }
+        constructor op_reg_size_reg_size(op:tllvmop;dst:tregister;fromsize:tdef;src:tregister;tosize:tdef);
+        { e.g. dst = bitcast fromsize 255 to tosize }
+        constructor op_reg_size_const_size(op:tllvmop;dst:tregister;fromsize:tdef;src:int64;tosize:tdef);
+        { e.g. dst = bitcast fromsize double to tosize }
+        constructor op_reg_size_fpconst_size(op:tllvmop;dst:tregister;fromsize:tdef;src:double;tosize:tdef);
+{$ifdef cpuextended}
+        { e.g. dst = bitcast fromsize extended to tosize }
+        constructor op_reg_size_fpconst80_size(op:tllvmop;dst:tregister;fromsize:tdef;src:extended;tosize:tdef);
+{$endif cpuextended}
+        { e.g. dst = bitcast fromsize @globalvar to tosize }
+        constructor op_reg_size_sym_size(op:tllvmop;dst:tregister;fromsize:tdef;src:TAsmSymbol;tosize:tdef);
+        { e.g. dst = bitcast fromsize <abstracttaidata> to tosize }
+        constructor op_reg_tai_size(op:tllvmop;dst:tregister;src:tai;tosize:tdef);
+
+        { e.g. dst = bitcast fromsize src to tosize }
+        constructor op_reg_size_ref_size(op:tllvmop;dst:tregister;fromsize:tdef;const src:treference;tosize:tdef);
+        { e.g. store fromsize src, ptrsize toref}
+        constructor op_size_reg_size_ref(op:tllvmop;fromsize:tdef;src:tregister;ptrsize:tdef;const toref:treference);
+        { e.g. store fromsize srcref, ptrsize toref (with srcref.refaddr=full) }
+        constructor op_size_ref_size_ref(op:tllvmop;fromsize:tdef;const src:treference;ptrsize:tdef;const toref:treference);
+        { e.g. store fromsize const, ptrsize toref}
+        constructor op_size_const_size_ref(op:tllvmop;fromsize:tdef;src:int64;ptrsize:tdef;const toref:treference);
+        { e.g. dst = load fromsize fromref }
+        constructor op_reg_size_ref(op:tllvmop;dst:tregister;fromsize:tdef;const fromref:treference);
+
+        { e.g. dst = icmp cmpcond size reg1, reg2 }
+        constructor op_reg_cond_size_reg_reg(op:tllvmop;dst:tregister;cmpcond:topcmp;size:tdef;reg1,reg2:tregister);
+        { e.g. dst = icmp cmpcond size reg1, constant }
+        constructor op_reg_cond_size_reg_const(op:tllvmop;dst:tregister;cmpcond:topcmp;size:tdef;reg1:tregister;cnst:int64);
+        { e.g. dst = fcmp cmpcond size reg1, reg2 }
+        constructor op_reg_fpcond_size_reg_reg(op:tllvmop;dst:tregister;cmpcond:tllvmfpcmp;size:tdef;reg1,reg2:tregister);
+        { e.g. br label lab }
+        constructor op_lab(op:tllvmop;lab:tasmlabel);
+        { e.g. br i1 condreg, label iftrue, label iffalse }
+        constructor op_size_reg_lab_lab(op:tllvmop;fromsize:tdef;condreg:tregister;labtrue,labfalse: tasmlabel);
+
+        { e.g. la_ret retdef retval }
+        constructor op_size_reg(op:tllvmop;def: tdef;reg: tregister);
+
+        { e.g. dst = getelementptr ptrsize ref, i32 0 (if indirect), index1type index1 }
+        constructor getelementptr_reg_size_ref_size_reg(dst:tregister;ptrsize:tdef;const ref:treference;indextype:tdef;index1:tregister;indirect:boolean);
+        constructor getelementptr_reg_size_ref_size_const(dst:tregister;ptrsize:tdef;const ref:treference;indextype:tdef;index1:ptrint;indirect:boolean);
+        constructor getelementptr_reg_tai_size_const(dst:tregister;const ai:tai;indextype:tdef;index1:ptrint;indirect:boolean);
+
+        { e.g. dst = call retsize name (paras) }
+        constructor call_size_name_paras(dst: tregister;retsize: tdef;name:tasmsymbol;paras: tfplist);
+        { e.g. dst = call retsize reg (paras) }
+        constructor call_size_reg_paras(dst: tregister;retsize: tdef;reg:tregister;paras: tfplist);
+
+        procedure loadtai(opidx: longint; _ai: tai);
+        procedure loaddef(opidx: longint; _def: tdef);
+        procedure loadsingle(opidx: longint; _sval: single);
+        procedure loaddouble(opidx: longint; _dval: double);
+{$ifdef cpuextended}
+        procedure loadextended(opidx: longint; _eval: extended);
+{$endif cpuextended}
+        procedure loadcond(opidx: longint; _cond: topcmp);
+        procedure loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
+        procedure loadparas(opidx: longint; _paras: tfplist);
+
+        { register spilling code }
+        function spilling_get_operation_type(opnr: longint): topertype;override;
+        function spilling_get_reg_type(opnr: longint): tdef;
+      end;
+
+
+    tllvmvisibility = (llv_default, llv_hidden, llv_protected);
+
+    tllvmlinkage = (
+      { llvm 2.5 }
+      lll_default { = externally visible/global },
+      lll_private, lll_internal, lll_linkonce, lll_common,
+      lll_weak, lll_appending, lll_extern_weak,
+      lll_dllimport, lll_dllexport,
+      { llvm 2.6+ }
+      lll_linker_private, lll_private_weak, lll_private_weak_def_auto,
+      lll_available_externally,lll_linkonce_odr, lll_weak_odr
+      );
+
+    taillvmalias = class(tailineinfo)
+      vis: tllvmvisibility;
+      linkage: tllvmlinkage;
+      oldsym, newsym: TAsmSymbol;
+      def: tdef;
+      constructor create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage);
+    end;
+
+    { declarations/definitions of symbols (procedures, variables), both defined
+      here and external }
+    taillvmdecl = class(tai)
+      { initialisation data, if any }
+      initdata: tasmlist;
+      namesym: tasmsymbol;
+      def: tdef;
+      sec: TAsmSectiontype;
+      alignment: shortint;
+      tls: boolean;
+      constructor create(_namesym: tasmsymbol; _def: tdef; _initdata: tasmlist; _sec: tasmsectiontype; _alignment: shortint);
+      constructor createtls(_namesym: tasmsymbol; _def: tdef; _alignment: shortint);
+      destructor destroy; override;
+    end;
+
+    { parameter to an llvm call instruction }
+    pllvmcallpara = ^tllvmcallpara;
+    tllvmcallpara = record
+      def: tdef;
+      valueext: tllvmvalueextension;
+      case loc: tcgloc of
+        LOC_REFERENCE,
+        LOC_REGISTER,
+        LOC_FPUREGISTER,
+        LOC_MMREGISTER: (reg: tregister);
+    end;
+
+
+implementation
+
+uses
+  cutils, strings,
+  symconst,
+  aasmcpu;
+
+    { taillvmprocdecl }
+
+    constructor taillvmdecl.create(_namesym: tasmsymbol; _def: tdef; _initdata: tasmlist; _sec: tasmsectiontype; _alignment: shortint);
+      begin
+        inherited create;
+        typ:=ait_llvmdecl;
+        namesym:=_namesym;
+        def:=_def;
+        initdata:=_initdata;
+        sec:=_sec;
+        alignment:=_alignment;
+        _namesym.declared:=true;
+      end;
+
+
+    constructor taillvmdecl.createtls(_namesym: tasmsymbol; _def: tdef; _alignment: shortint);
+      begin
+        create(_namesym,_def,nil,sec_data,_alignment);
+        tls:=true;
+      end;
+
+
+    destructor taillvmdecl.destroy;
+      begin
+        initdata.free;
+        inherited destroy;
+      end;
+
+    { taillvmalias }
+
+    constructor taillvmalias.create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage);
+      begin
+        inherited Create;
+        typ:=ait_llvmalias;
+        oldsym:=_oldsym;
+        newsym:=current_asmdata.DefineAsmSymbol(newname,AB_GLOBAL,AT_FUNCTION);
+        def:=_def;
+        vis:=_vis;
+        linkage:=_linkage;
+      end;
+
+
+
+
+{*****************************************************************************
+                                 taicpu Constructors
+*****************************************************************************}
+
+    procedure taillvm.maybe_declare(def: tdef; const ref: treference);
+      begin
+        { add llvm declarations for imported symbols }
+        if not assigned(ref.symbol) or
+           (ref.symbol.declared) or
+           not(ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) then
+          exit;
+        if ref.refaddr<>addr_full then
+          begin
+            if def.typ<>pointerdef then
+              internalerror(2014020701);
+            def:=tpointerdef(def).pointeddef;
+          end;
+        current_asmdata.AsmLists[al_imports].concat(taillvmdecl.create(ref.symbol,def,nil,sec_none,def.alignment));
+      end;
+
+
+    constructor taillvm.create_llvm(op: tllvmop);
+      begin
+        create(a_none);
+        llvmopcode:=op;
+        typ:=ait_llvmins;
+      end;
+
+
+    procedure taillvm.loadtai(opidx: longint; _ai: tai);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_tai then
+             clearop(opidx);
+           ai:=_ai;
+           typ:=top_tai;
+         end;
+      end;
+
+
+    procedure taillvm.loaddef(opidx:longint;_def: tdef);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_def then
+             clearop(opidx);
+           def:=_def;
+           typ:=top_def;
+         end;
+      end;
+
+
+    procedure taillvm.loadsingle(opidx: longint; _sval: single);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_single then
+             clearop(opidx);
+           sval:=_sval;
+           typ:=top_single;
+         end;
+      end;
+
+
+    procedure taillvm.loaddouble(opidx: longint; _dval: double);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_double then
+             clearop(opidx);
+           dval:=_dval;
+           typ:=top_double;
+         end;
+      end;
+
+
+{$ifdef cpuextended}
+    procedure taillvm.loadextended(opidx: longint; _eval: extended);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_extended80 then
+             clearop(opidx);
+           eval:=_eval;
+           typ:=top_extended80;
+         end;
+      end;
+{$endif cpuextended}
+
+
+    procedure taillvm.loadcond(opidx: longint; _cond: topcmp);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_cond then
+             clearop(opidx);
+           cond:=_cond;
+           typ:=top_cond;
+         end;
+      end;
+
+    procedure taillvm.loadfpcond(opidx: longint; _fpcond: tllvmfpcmp);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+         begin
+           if typ<>top_fpcond then
+             clearop(opidx);
+           fpcond:=_fpcond;
+           typ:=top_fpcond;
+         end;
+      end;
+
+
+    procedure taillvm.loadparas(opidx: longint; _paras: tfplist);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+          begin
+            clearop(opidx);
+            paras:=_paras;
+            typ:=top_para;
+          end;
+      end;
+
+
+    function taillvm.spilling_get_operation_type(opnr: longint): topertype;
+      begin
+        case llvmopcode of
+          la_ret, la_br, la_switch, la_indirectbr,
+          la_invoke, la_resume,
+          la_unreachable,
+          la_store,
+          la_fence,
+          la_cmpxchg,
+          la_atomicrmw:
+            begin
+              { instructions that never have a result }
+              result:=operand_read;
+            end;
+          la_alloca,
+          la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+          la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+          la_ptrtoint, la_inttoptr,
+          la_bitcast,
+          la_add, la_fadd, la_sub, la_fsub, la_mul, la_fmul,
+          la_udiv,la_sdiv, la_fdiv, la_urem, la_srem, la_frem,
+          la_shl, la_lshr, la_ashr, la_and, la_or, la_xor,
+          la_extractelement, la_insertelement, la_shufflevector,
+          la_extractvalue, la_insertvalue,
+          la_getelementptr,
+          la_load,
+          la_icmp, la_fcmp,
+          la_phi, la_select, la_call,
+          la_va_arg, la_landingpad:
+            begin
+              if opnr=0 then
+                result:=operand_write
+              else
+                result:=operand_read;
+            end;
+          else
+            internalerror(2013103101)
+        end;
+      end;
+
+
+    function taillvm.spilling_get_reg_type(opnr: longint): tdef;
+      begin
+        case llvmopcode of
+          la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+          la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+          la_ptrtoint, la_inttoptr,
+          la_bitcast:
+            begin
+              { toreg = bitcast fromsize fromreg to tosize }
+              case opnr of
+                0: result:=oper[3]^.def;
+                2: result:=oper[1]^.def
+                else
+                  internalerror(2013103102);
+              end;
+            end;
+          la_ret, la_switch, la_indirectbr,
+          la_resume:
+            begin
+              { ret size reg }
+              if opnr=1 then
+                result:=oper[0]^.def
+              else
+                internalerror(2013110101);
+            end;
+          la_invoke, la_call:
+            begin
+              internalerror(2013110102);
+            end;
+          la_br,
+          la_unreachable:
+            internalerror(2013110103);
+          la_store:
+            begin
+              case opnr of
+                1: result:=oper[0]^.def;
+                { type of the register in the reference }
+                3: result:=oper[2]^.def;
+                else
+                  internalerror(2013110104);
+              end;
+            end;
+          la_load,
+          la_getelementptr:
+            begin
+              { dst = load ptrdef srcref }
+              case opnr of
+                0: result:=tpointerdef(oper[1]^.def).pointeddef;
+                2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110105);
+              end;
+            end;
+          la_fence,
+          la_cmpxchg,
+          la_atomicrmw:
+            begin
+              internalerror(2013110610);
+            end;
+          la_add, la_fadd, la_sub, la_fsub, la_mul, la_fmul,
+          la_udiv,la_sdiv, la_fdiv, la_urem, la_srem, la_frem,
+          la_shl, la_lshr, la_ashr, la_and, la_or, la_xor:
+            begin
+              case opnr of
+                0,2,3:
+                  result:=oper[1]^.def;
+                else
+                  internalerror(2013110106);
+              end;
+            end;
+          la_extractelement, la_insertelement, la_shufflevector,
+          la_extractvalue:
+            begin
+              { todo }
+              internalerror(2013110107);
+            end;
+          la_insertvalue:
+            begin
+              case opnr of
+                0,2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110108);
+              end;
+            end;
+          la_icmp, la_fcmp:
+            begin
+              case opnr of
+                0: result:=pasbool8type;
+                3,4: result:=oper[2]^.def;
+                else
+                  internalerror(2013110801);
+              end
+            end;
+          la_alloca:
+            begin
+              { shouldn't be spilled, the result of alloca should be read-only }
+              internalerror(2013110109);
+            end;
+          la_select:
+            begin
+              case opnr of
+                0,4,6: result:=oper[3]^.def;
+                2: result:=oper[1]^.def;
+                else
+                  internalerror(2013110110);
+              end;
+            end;
+          else
+            internalerror(2013103101)
+        end;
+      end;
+
+
+    constructor taillvm.op_size(op : tllvmop; size: tdef);
+      begin
+        create_llvm(op);
+        ops:=1;
+        loaddef(0,size);
+      end;
+
+
+    constructor taillvm.op_reg_size(op: tllvmop; dst: tregister; size: tdef);
+      begin
+        create_llvm(op);
+        ops:=2;
+        loadreg(0,dst);
+        loaddef(1,size);
+      end;
+
+
+    constructor taillvm.op_ref_size(op: tllvmop; const dst: treference; size: tdef);
+      begin
+        create_llvm(op);
+        ops:=2;
+        loadref(0,dst);
+        loaddef(1,size);
+      end;
+
+
+    { %dst = add i32 %src1, %src2 }
+    constructor taillvm.op_reg_size_reg_reg(op: tllvmop; dst: tregister;size: tdef; src1, src2: tregister);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,size);
+        loadreg(2,src1);
+        loadreg(3,src2);
+      end;
+
+    { %dst = shl i32 %reg, 1 (= %reg shl 1) }
+    constructor taillvm.op_reg_size_reg_const(op: tllvmop; dst: tregister; size: tdef; src1: tregister; src2: int64);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,size);
+        loadreg(2,src1);
+        loadconst(3,src2);
+      end;
+
+
+    { %dst = sub i32 1, %src (= 1 - %src) }
+    constructor taillvm.op_reg_size_const_reg(op: tllvmop; dst: tregister; size: tdef; src1: int64; src2: tregister);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,size);
+        loadconst(2,src1);
+        loadreg(3,src2);
+      end;
+
+
+    { %dst = bitcast i32 %src to i8 }
+    constructor taillvm.op_reg_size_reg_size(op: tllvmop; dst: tregister; fromsize: tdef; src: tregister; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,fromsize);
+        loadreg(2,src);
+        loaddef(3,tosize);
+      end;
+
+
+    { %dst = bitcast i32 -1 to i8 }
+    constructor taillvm.op_reg_size_const_size(op: tllvmop; dst: tregister; fromsize: tdef; src: int64; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,fromsize);
+        loadconst(2,src);
+        loaddef(3,tosize);
+      end;
+
+
+    constructor taillvm.op_reg_size_fpconst_size(op: tllvmop; dst: tregister; fromsize: tdef; src: double; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,fromsize);
+        if fromsize.typ<>floatdef then
+          internalerror(2014012214);
+        case tfloatdef(fromsize).floattype of
+          s32real:
+            loadsingle(2,src);
+          s64real:
+            loaddouble(2,src);
+          else
+            internalerror(2014012215);
+        end;
+        loaddef(3,tosize);
+      end;
+
+{$ifdef cpuextended}
+    constructor taillvm.op_reg_size_fpconst80_size(op: tllvmop; dst: tregister; fromsize: tdef; src: extended; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,fromsize);
+        loadextended(2,src);
+        loaddef(3,tosize);
+      end;
+{$endif cpuextended}
+
+
+    constructor taillvm.op_reg_size_sym_size(op: tllvmop; dst: tregister; fromsize: tdef; src: TAsmSymbol; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,fromsize);
+        loadsymbol(2,src,0);
+        loaddef(3,tosize);
+      end;
+
+
+    constructor taillvm.op_reg_tai_size(op:tllvmop;dst:tregister;src:tai;tosize:tdef);
+      begin
+        create_llvm(op);
+        ops:=3;
+        loadreg(0,dst);
+        loadtai(1,src);
+        loaddef(2,tosize);
+      end;
+
+
+    constructor taillvm.op_reg_size_ref_size(op: tllvmop; dst: tregister; fromsize: tdef; const src: treference; tosize: tdef);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loadreg(0,dst);
+        maybe_declare(fromsize,src);
+        loaddef(1,fromsize);
+        loadref(2,src);
+        loaddef(3,tosize);
+      end;
+
+
+    { store i32 3, i32* %ptr }
+    constructor taillvm.op_size_reg_size_ref(op: tllvmop; fromsize: tdef; src: tregister; ptrsize: tdef; const toref: treference);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loaddef(0,fromsize);
+        loadreg(1,src);
+        maybe_declare(ptrsize,toref);
+        loaddef(2,ptrsize);
+        loadref(3,toref);
+      end;
+
+
+    constructor taillvm.op_size_ref_size_ref(op: tllvmop; fromsize: tdef; const src: treference; ptrsize: tdef; const toref: treference);
+      begin
+        create_llvm(op);
+        ops:=4;
+        maybe_declare(fromsize,src);
+        loaddef(0,fromsize);
+        loadref(1,src);
+        maybe_declare(ptrsize,toref);
+        loaddef(2,ptrsize);
+        loadref(3,toref);
+      end;
+
+
+    constructor taillvm.op_size_const_size_ref(op: tllvmop; fromsize: tdef; src: int64; ptrsize: tdef; const toref: treference);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loaddef(0,fromsize);
+        loadconst(1,src);
+        maybe_declare(ptrsize,toref);
+        loaddef(2,ptrsize);
+        loadref(3,toref);
+      end;
+
+
+    constructor taillvm.op_reg_size_ref(op: tllvmop; dst: tregister; fromsize: tdef; const fromref: treference);
+      begin
+        create_llvm(op);
+        ops:=3;
+        loadreg(0,dst);
+        maybe_declare(fromsize,fromref);
+        loaddef(1,fromsize);
+        loadref(2,fromref);
+      end;
+
+
+    constructor taillvm.op_reg_cond_size_reg_reg(op: tllvmop; dst: tregister; cmpcond: topcmp; size: tdef; reg1, reg2: tregister);
+      begin
+        create_llvm(op);
+        ops:=5;
+        loadreg(0,dst);
+        loadcond(1,cmpcond);
+        loaddef(2,size);
+        loadreg(3,reg1);
+        loadreg(4,reg2);
+      end;
+
+    constructor taillvm.op_reg_cond_size_reg_const(op: tllvmop; dst: tregister; cmpcond: topcmp; size: tdef; reg1: tregister; cnst: int64);
+      begin
+        create_llvm(op);
+        ops:=5;
+        loadreg(0,dst);
+        loadcond(1,cmpcond);
+        loaddef(2,size);
+        loadreg(3,reg1);
+        loadconst(4,cnst);
+      end;
+
+    constructor taillvm.op_reg_fpcond_size_reg_reg(op: tllvmop; dst: tregister; cmpcond: tllvmfpcmp; size: tdef; reg1, reg2: tregister);
+      begin
+        create_llvm(op);
+        ops:=5;
+        loadreg(0,dst);
+        loadfpcond(1,cmpcond);
+        loaddef(2,size);
+        loadreg(3,reg1);
+        loadreg(4,reg2);
+      end;
+
+
+    constructor taillvm.op_lab(op: tllvmop; lab: tasmlabel);
+      begin
+        create_llvm(op);
+        ops:=1;
+        loadsymbol(0,lab,0);
+      end;
+
+
+    constructor taillvm.op_size_reg_lab_lab(op: tllvmop; fromsize: tdef; condreg: tregister; labtrue, labfalse: tasmlabel);
+      begin
+        create_llvm(op);
+        ops:=4;
+        loaddef(0,fromsize);
+        loadreg(1,condreg);
+        loadsymbol(2,labtrue,0);
+        loadsymbol(3,labfalse,0);
+      end;
+
+
+    constructor taillvm.op_size_reg(op: tllvmop; def: tdef; reg: tregister);
+      begin
+        create_llvm(op);
+        ops:=2;
+        loaddef(0,def);
+        loadreg(1,reg);
+      end;
+
+
+    constructor taillvm.getelementptr_reg_size_ref_size_reg(dst: tregister; ptrsize: tdef; const ref: treference; indextype: tdef; index1: tregister; indirect: boolean);
+      var
+        index: longint;
+      begin
+        create_llvm(la_getelementptr);
+        if indirect then
+          ops:=7
+        else
+          ops:=5;
+        loadreg(0,dst);
+        maybe_declare(ptrsize,ref);
+        loaddef(1,ptrsize);
+        loadref(2,ref);
+        if indirect then
+          begin
+            loaddef(3,s32inttype);
+            loadconst(4,0);
+            index:=5;
+          end
+        else
+          index:=3;
+        loaddef(index,indextype);
+        loadreg(index+1,index1);
+      end;
+
+
+    constructor taillvm.getelementptr_reg_size_ref_size_const(dst: tregister; ptrsize: tdef; const ref: treference; indextype: tdef; index1: ptrint; indirect: boolean);
+      var
+        index: longint;
+      begin
+        create_llvm(la_getelementptr);
+        if indirect then
+          ops:=7
+        else
+          ops:=5;
+        loadreg(0,dst);
+        maybe_declare(ptrsize,ref);
+        loaddef(1,ptrsize);
+        loadref(2,ref);
+        if indirect then
+          begin
+            loaddef(3,s32inttype);
+            loadconst(4,0);
+            index:=5;
+          end
+        else
+          index:=3;
+        loaddef(index,indextype);
+        loadconst(index+1,index1);
+      end;
+
+
+    constructor taillvm.getelementptr_reg_tai_size_const(dst: tregister; const ai: tai; indextype: tdef; index1: ptrint; indirect: boolean);
+      var
+        index: longint;
+      begin
+        create_llvm(la_getelementptr);
+        if indirect then
+          ops:=6
+        else
+          ops:=4;
+        loadreg(0,dst);
+        loadtai(1,ai);
+        if indirect then
+          begin
+            loaddef(2,s32inttype);
+            loadconst(3,0);
+            index:=4;
+          end
+        else
+          index:=2;
+        loaddef(index,indextype);
+        loadconst(index+1,index1);
+      end;
+
+
+    constructor taillvm.call_size_name_paras(dst: tregister; retsize: tdef; name:tasmsymbol; paras: tfplist);
+      begin
+        create_llvm(la_call);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,retsize);
+        loadsymbol(2,name,0);
+        loadparas(3,paras);
+      end;
+
+
+    constructor taillvm.call_size_reg_paras(dst: tregister; retsize: tdef; reg: tregister; paras: tfplist);
+      begin
+        create_llvm(la_call);
+        ops:=4;
+        loadreg(0,dst);
+        loaddef(1,retsize);
+        loadreg(2,reg);
+        loadparas(3,paras);
+      end;
+
+end.

compiler/llvm/agllvm.pas

@@ -0,0 +1,1119 @@
+{
+    Copyright (c) 1998-2013 by the Free Pascal team
+
+    This unit implements the generic part of the LLVM IR writer
+
+    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 agllvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,globals,
+      aasmbase,aasmtai,aasmdata,
+      assemble;
+
+    type
+      TLLVMInstrWriter = class;
+      { TLLVMAssember }
+
+      TLLVMAssember=class(texternalassembler)
+      protected
+        fdecllevel: longint;
+
+        procedure WriteExtraHeader;virtual;
+        procedure WriteExtraFooter;virtual;
+        procedure WriteInstruction(hp: tai);
+        procedure WriteLlvmInstruction(hp: tai);
+//        procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
+        procedure WriteDirectiveName(dir: TAsmDirective); virtual;
+        procedure WriteWeakSymbolDef(s: tasmsymbol);
+        procedure WriteRealConst(hp: tai_realconst; do_line: boolean);
+        procedure WriteOrdConst(hp: tai_const);
+        procedure WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var hp: tai);
+       public
+        constructor create(smart: boolean); override;
+        procedure AsmLn; override;
+        function MakeCmdLine: TCmdStr; override;
+        procedure WriteTree(p:TAsmList);override;
+        procedure WriteAsmList;override;
+        destructor destroy; override;
+       protected
+        InstrWriter: TLLVMInstrWriter;
+      end;
+
+
+      {# This is the base class for writing instructions.
+
+         The WriteInstruction() method must be overridden
+         to write a single instruction to the assembler
+         file.
+      }
+      TLLVMInstrWriter = class
+        constructor create(_owner: TLLVMAssember);
+        procedure WriteInstruction(hp : tai);
+       protected
+        owner: TLLVMAssember;
+        fstr: TSymStr;
+
+        function getopstr(const o:toper; refwithalign: boolean) : TSymStr;
+      end;
+
+
+implementation
+
+    uses
+      SysUtils,
+      cutils,cfileutl,systems,
+      fmodule,verbose,
+      aasmcnst,symconst,symdef,
+      llvmbase,aasmllvm,itllvm,llvmdef,
+      cgbase,cgutils,cpubase;
+
+    const
+      line_length = 70;
+
+    type
+{$ifdef cpuextended}
+      t80bitarray = array[0..9] of byte;
+{$endif cpuextended}
+      t64bitarray = array[0..7] of byte;
+      t32bitarray = array[0..3] of byte;
+
+{****************************************************************************}
+{                          Support routines                                  }
+{****************************************************************************}
+
+    function single2str(d : single) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         single2str:=hs
+      end;
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         double2str:=hs
+      end;
+
+    function extended2str(e : extended) : string;
+      var
+         hs : string;
+      begin
+         str(e,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         extended2str:=hs
+      end;
+
+
+
+
+ {****************************************************************************}
+ {                        LLVM Instruction writer                             }
+ {****************************************************************************}
+
+    function getregisterstring(reg: tregister): ansistring;
+      begin
+        if getregtype(reg)=R_TEMPREGISTER then
+          result:='%tmp.'
+        else
+          result:='%reg.'+tostr(byte(getregtype(reg)))+'_';
+        result:=result+tostr(getsupreg(reg));
+      end;
+
+
+    function getreferencealignstring(var ref: treference) : ansistring;
+      begin
+        result:=', align '+tostr(ref.alignment);
+      end;
+
+
+    function getreferencestring(var ref : treference; withalign: boolean) : ansistring;
+      begin
+        result:='';
+        if assigned(ref.relsymbol) or
+           (assigned(ref.symbol) =
+            (ref.base<>NR_NO)) or
+           (ref.index<>NR_NO) or
+           (ref.offset<>0) then
+          begin
+            result:=' **(error ref: ';
+            if assigned(ref.symbol) then
+              result:=result+'sym='+ref.symbol.name+', ';
+            if assigned(ref.relsymbol) then
+              result:=result+'sym='+ref.relsymbol.name+', ';
+            if ref.base=NR_NO then
+              result:=result+'base=NR_NO, ';
+            if ref.index<>NR_NO then
+              result:=result+'index<>NR_NO, ';
+            if ref.offset<>0 then
+              result:=result+'offset='+tostr(ref.offset);
+            result:=result+')**'
+//            internalerror(2013060225);
+          end;
+         if ref.base<>NR_NO then
+           result:=result+getregisterstring(ref.base)
+         else
+           result:=result+LlvmAsmSymName(ref.symbol);
+         if withalign then
+           result:=result+getreferencealignstring(ref);
+      end;
+
+
+   function getparas(const o: toper): ansistring;
+     var
+       i: longint;
+       para: pllvmcallpara;
+     begin
+       result:='(';
+       for i:=0 to o.paras.count-1 do
+         begin
+           if i<>0 then
+             result:=result+', ';
+           para:=pllvmcallpara(o.paras[i]);
+           result:=result+llvmencodetype(para^.def);
+           if para^.valueext<>lve_none then
+             result:=result+llvmvalueextension2str[para^.valueext];
+           case para^.loc of
+             LOC_REGISTER,
+             LOC_FPUREGISTER,
+             LOC_MMREGISTER:
+               result:=result+' '+getregisterstring(para^.reg);
+             else
+               internalerror(2014010801);
+           end;
+         end;
+       result:=result+')';
+     end;
+
+
+   function llvmdoubletostr(const d: double): TSymStr;
+     type
+       tdoubleval = record
+         case byte of
+           1: (d: double);
+           2: (i: int64);
+       end;
+     begin
+       { "When using the hexadecimal form, constants of types half,
+         float, and double are represented using the 16-digit form shown
+         above (which matches the IEEE754 representation for double)"
+
+         And always in big endian form (sign bit leftmost)
+       }
+       result:='0x'+hexstr(tdoubleval(d).i,16);
+     end;
+
+
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+    function llvmextendedtostr(const e: extended): TSymStr;
+      var
+        extendedval: record
+          case byte of
+            1: (e: extended);
+            2: (r: packed record
+      {$ifdef FPC_LITTLE_ENDIAN}
+                  l: int64;
+                  h: word;
+      {$else FPC_LITTLE_ENDIAN}
+                  h: int64;
+                  l: word;
+      {$endif FPC_LITTLE_ENDIAN}
+                end;
+               );
+        end;
+      begin
+        extendedval.e:=e;
+        { hex format is always big endian in llvm }
+        result:='0xK'+hexstr(extendedval.r.h,sizeof(extendedval.r.h)*2)+
+                      hexstr(extendedval.r.l,sizeof(extendedval.r.l)*2);
+      end;
+
+{$endif cpuextended}
+
+
+   function TLLVMInstrWriter.getopstr(const o:toper; refwithalign: boolean) : TSymStr;
+     var
+       hs : ansistring;
+       hp: tai;
+       tmpinline: cardinal;
+     begin
+       case o.typ of
+         top_reg:
+           getopstr:=getregisterstring(o.reg);
+         top_const:
+           getopstr:=tostr(int64(o.val));
+         top_ref:
+           if o.ref^.refaddr=addr_full then
+             begin
+               getopstr:='';
+               getopstr:=LlvmAsmSymName(o.ref^.symbol);
+               if o.ref^.offset<>0 then
+                 internalerror(2013060223);
+             end
+           else
+             getopstr:=getreferencestring(o.ref^,refwithalign);
+         top_def:
+           begin
+             getopstr:=llvmencodetype(o.def);
+           end;
+         top_cond:
+           begin
+             getopstr:=llvm_cond2str[o.cond];
+           end;
+         top_fpcond:
+           begin
+             getopstr:=llvm_fpcond2str[o.fpcond];
+           end;
+         top_single,
+         top_double:
+           begin
+             { "When using the hexadecimal form, constants of types half,
+               float, and double are represented using the 16-digit form shown
+               above (which matches the IEEE754 representation for double)"
+
+               And always in big endian form (sign bit leftmost)
+             }
+             if o.typ=top_double then
+               result:=llvmdoubletostr(o.dval)
+             else
+               result:=llvmdoubletostr(o.sval)
+           end;
+         top_para:
+           begin
+             result:=getparas(o);
+           end;
+         top_tai:
+           begin
+             tmpinline:=1;
+             hp:=o.ai;
+             owner.AsmWrite(fstr);
+             fstr:='';
+             owner.WriteTai(false,false,tmpinline,hp);
+             result:='';
+           end;
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+         top_extended80:
+           begin
+             result:=llvmextendedtostr(o.eval);
+           end;
+{$endif cpuextended}
+         else
+           internalerror(2013060227);
+       end;
+     end;
+
+
+  procedure TLLVMInstrWriter.WriteInstruction(hp: tai);
+    var
+      op: tllvmop;
+      sep: TSymStr;
+      i, opstart: byte;
+      nested: boolean;
+      done: boolean;
+    begin
+      op:=taillvm(hp).llvmopcode;
+      { we write everything immediately rather than adding it into a string,
+        because operands may contain other tai that will also write things out
+        (and their output must come after everything that was processed in this
+         instruction, such as its opcode or previous operands) }
+      if owner.fdecllevel=0 then
+        owner.AsmWrite(#9);
+      sep:=' ';
+      done:=false;
+      opstart:=0;
+      nested:=false;
+      case op of
+        la_ret, la_br, la_switch, la_indirectbr,
+        la_invoke, la_resume,
+        la_unreachable,
+        la_store,
+        la_fence,
+        la_cmpxchg,
+        la_atomicrmw:
+          begin
+            { instructions that never have a result }
+          end;
+        la_call:
+          begin
+            if taillvm(hp).oper[0]^.reg<>NR_NO then
+              owner.AsmWrite(getregisterstring(taillvm(hp).oper[0]^.reg)+' = ');
+            sep:=' ';
+            opstart:=1;
+          end;
+        la_alloca:
+          begin
+            owner.AsmWrite(getreferencestring(taillvm(hp).oper[0]^.ref^,false)+' = ');
+            sep:=' ';
+            opstart:=1;
+          end;
+        la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+        la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+        la_ptrtoint, la_inttoptr,
+        la_bitcast:
+          begin
+            { destination can be empty in case of nested constructs, or
+              data initialisers }
+            if (taillvm(hp).oper[0]^.typ<>top_reg) or
+               (taillvm(hp).oper[0]^.reg<>NR_NO) then
+              owner.AsmWrite(getopstr(taillvm(hp).oper[0]^,false)+' = ')
+            else
+              nested:=true;
+            owner.AsmWrite(llvm_op2str[op]);
+            if not nested then
+              owner.AsmWrite(' ')
+            else
+              owner.AsmWrite(' (');
+            owner.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
+            { if there's a tai operand, its def is used instead of an
+              explicit def operand }
+            if taillvm(hp).ops=4 then
+              begin
+                owner.AsmWrite(' ');
+                owner.AsmWrite(getopstr(taillvm(hp).oper[2]^,false));
+                opstart:=3;
+              end
+            else
+              opstart:=2;
+            owner.AsmWrite(' to ');
+            owner.AsmWrite(getopstr(taillvm(hp).oper[opstart]^,false));
+            done:=true;
+          end
+        else
+          begin
+            if (taillvm(hp).oper[0]^.typ<>top_reg) or
+               (taillvm(hp).oper[0]^.reg<>NR_NO) then
+              begin
+                owner.AsmWrite(getopstr(taillvm(hp).oper[0]^,true)+' = ');
+              end
+            else
+              nested:=true;
+            sep:=' ';
+            opstart:=1
+          end;
+      end;
+      { process operands }
+      if not done then
+        begin
+          owner.AsmWrite(llvm_op2str[op]);
+          if nested then
+            owner.AsmWrite(' (');
+          if taillvm(hp).ops<>0 then
+            begin
+              for i:=opstart to taillvm(hp).ops-1 do
+                begin
+                   owner.AsmWrite(sep);
+                   owner.AsmWrite(getopstr(taillvm(hp).oper[i]^,op in [la_load,la_store]));
+                   if (taillvm(hp).oper[i]^.typ in [top_def,top_cond,top_fpcond]) or
+                      (op=la_call) then
+                     sep :=' '
+                   else
+                     sep:=', ';
+                end;
+            end;
+        end;
+      if op=la_alloca then
+        owner.AsmWrite(getreferencealignstring(taillvm(hp).oper[0]^.ref^));
+      if nested then
+        owner.AsmWrite(')');
+      owner.AsmLn;
+    end;
+
+{****************************************************************************}
+{                          LLVM Assembler writer                              }
+{****************************************************************************}
+
+    destructor TLLVMAssember.Destroy;
+      begin
+        InstrWriter.free;
+        inherited destroy;
+      end;
+
+
+    function TLLVMAssember.MakeCmdLine: TCmdStr;
+      var
+        optstr: TCmdStr;
+      begin
+        result := inherited MakeCmdLine;
+        { standard optimization flags for llc -- todo: this needs to be split
+          into a call to opt and one to llc }
+        if cs_opt_level3 in current_settings.optimizerswitches then
+          optstr:='-O3'
+        else if cs_opt_level2 in current_settings.optimizerswitches then
+          optstr:='-O2'
+        else if cs_opt_level1 in current_settings.optimizerswitches then
+          optstr:='-O1'
+        else
+          optstr:='-O0';
+        { stack frame elimination }
+        if not(cs_opt_stackframe in current_settings.optimizerswitches) then
+          optstr:=optstr+' -disable-fp-elim';
+        { fast math }
+        if cs_opt_fastmath in current_settings.optimizerswitches then
+          optstr:=optstr+' -enable-unsafe-fp-math -enable-fp-mad -fp-contract=fast';
+        { smart linking }
+        if cs_create_smart in current_settings.moduleswitches then
+          optstr:=optstr+' -fdata-sections -fcode-sections';
+        { pic }
+        if cs_create_pic in current_settings.moduleswitches then
+          optstr:=optstr+' -relocation-model=pic'
+        else if not(target_info.system in systems_darwin) then
+          optstr:=optstr+' -relocation-model=static'
+        else
+          optstr:=optstr+' -relocation-model=dynamic-no-pic';
+        { our stack alignment is non-standard on some targets. The following
+          parameter is however ignored on some targets by llvm, so it may not
+          be enough }
+        optstr:=optstr+' -stack-alignment='+tostr(target_info.stackalign*8);
+        { force object output instead of textual assembler code }
+        optstr:=optstr+' -filetype=obj';
+        replace(result,'$OPT',optstr);
+      end;
+
+
+    procedure TLLVMAssember.WriteTree(p:TAsmList);
+    var
+      hp       : tai;
+      InlineLevel : cardinal;
+      do_line  : boolean;
+      replaceforbidden: boolean;
+    begin
+      if not assigned(p) then
+       exit;
+      replaceforbidden:=target_asm.dollarsign<>'$';
+
+      InlineLevel:=0;
+      { lineinfo is only needed for al_procedures (PFV) }
+      do_line:=(cs_asm_source in current_settings.globalswitches) or
+               ((cs_lineinfo in current_settings.moduleswitches)
+                 and (p=current_asmdata.asmlists[al_procedures]));
+      hp:=tai(p.first);
+      while assigned(hp) do
+       begin
+         prefetch(pointer(hp.next)^);
+         if not(hp.typ in SkipLineInfo) then
+          begin
+            current_filepos:=tailineinfo(hp).fileinfo;
+            { no line info for inlined code }
+            if do_line and (inlinelevel=0) then
+              WriteSourceLine(hp as tailineinfo);
+          end;
+
+         WriteTai(replaceforbidden, do_line, InlineLevel, hp);
+         hp:=tai(hp.next);
+       end;
+    end;
+
+
+    procedure TLLVMAssember.WriteExtraHeader;
+      begin
+        AsmWrite('target datalayout = "');
+        AsmWrite(target_info.llvmdatalayout);
+        AsmWriteln('"');
+        AsmWrite('target triple = "');
+        AsmWrite(llvm_target_name);
+        AsmWriteln('"');
+      end;
+
+
+    procedure TLLVMAssember.WriteExtraFooter;
+      begin
+      end;
+
+
+    procedure TLLVMAssember.WriteInstruction(hp: tai);
+      begin
+
+      end;
+
+
+    procedure TLLVMAssember.WriteLlvmInstruction(hp: tai);
+      begin
+        InstrWriter.WriteInstruction(hp);
+      end;
+
+
+    procedure TLLVMAssember.WriteWeakSymbolDef(s: tasmsymbol);
+      begin
+        AsmWriteLn(#9'.weak '+LlvmAsmSymName(s));
+      end;
+
+
+    procedure TLLVMAssember.WriteRealConst(hp: tai_realconst; do_line: boolean);
+      begin
+        if do_line and
+           (fdecllevel=0) then
+          begin
+            case tai_realconst(hp).realtyp of
+              aitrealconst_s32bit:
+                AsmWriteLn(target_asm.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
+              aitrealconst_s64bit:
+                AsmWriteLn(target_asm.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+              { can't write full 80 bit floating point constants yet on non-x86 }
+              aitrealconst_s80bit:
+                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
+{$endif cpuextended}
+              aitrealconst_s64comp:
+                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
+              else
+                internalerror(2014050604);
+            end;
+          end;
+        case hp.realtyp of
+          aitrealconst_s32bit:
+            AsmWriteln(llvmdoubletostr(hp.value.s32val));
+          aitrealconst_s64bit:
+            AsmWriteln(llvmdoubletostr(hp.value.s64val));
+{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
+          aitrealconst_s80bit:
+            AsmWriteln(llvmextendedtostr(hp.value.s80val));
+{$endif defined(cpuextended)}
+          aitrealconst_s64comp:
+            { handled as int64 most of the time in llvm }
+            AsmWriteln(tostr(round(hp.value.s64compval)));
+          else
+            internalerror(2014062401);
+        end;
+      end;
+
+
+    procedure TLLVMAssember.WriteOrdConst(hp: tai_const);
+      var
+        consttyp: taiconst_type;
+      begin
+        if fdecllevel=0 then
+          asmwrite(target_asm.comment+' const ');
+        consttyp:=hp.consttype;
+        case consttyp of
+          aitconst_got,
+          aitconst_gotoff_symbol,
+          aitconst_uleb128bit,
+          aitconst_sleb128bit,
+          aitconst_rva_symbol,
+          aitconst_secrel32_symbol,
+          aitconst_darwin_dwarf_delta32,
+          aitconst_darwin_dwarf_delta64,
+          aitconst_half16bit:
+            internalerror(2014052901);
+          aitconst_128bit,
+          aitconst_64bit,
+          aitconst_32bit,
+          aitconst_16bit,
+          aitconst_8bit,
+          aitconst_16bit_unaligned,
+          aitconst_32bit_unaligned,
+          aitconst_64bit_unaligned:
+            begin
+              if fdecllevel=0 then
+                AsmWrite(target_asm.comment);
+              { can't have compile-time differences between symbols; these are
+                normally for PIC, but llvm takes care of that for us }
+              if assigned(hp.endsym) then
+                internalerror(2014052902);
+              if assigned(hp.sym) then
+                begin
+                  AsmWrite(LlvmAsmSymName(hp.sym));
+                  { can't have offsets }
+                  if hp.value<>0 then
+                    if fdecllevel<>0 then
+                      internalerror(2014052903)
+                    else
+                      asmwrite(' -- symbol offset: ' + tostr(hp.value));
+                end
+              else if hp.value=0 then
+                AsmWrite('zeroinitializer')
+              else
+                AsmWrite(tostr(hp.value));
+              AsmLn;
+            end;
+          else
+            internalerror(200704251);
+        end;
+      end;
+
+
+    procedure TLLVMAssember.WriteTai(const replaceforbidden: boolean; const do_line: boolean; var InlineLevel: cardinal; var hp: tai);
+
+      procedure WriteTypedConstData(hp: tai_abstracttypedconst);
+        var
+          p: tai_abstracttypedconst;
+          pval: tai;
+          defstr: TSymStr;
+          first, gotstring: boolean;
+        begin
+          defstr:=llvmencodetype(hp.def);
+          { write the struct, array or simple type }
+          case hp.adetyp of
+            tck_record:
+              begin
+                AsmWrite(defstr);
+                AsmWrite(' ');
+                AsmWrite('<{');
+                first:=true;
+                for p in tai_aggregatetypedconst(hp) do
+                  begin
+                    if not first then
+                      AsmWrite(', ')
+                    else
+                      first:=false;
+                    WriteTypedConstData(p);
+                  end;
+                AsmWrite('}>');
+              end;
+            tck_array:
+              begin
+                AsmWrite(defstr);
+                first:=true;
+                gotstring:=false;
+                for p in tai_aggregatetypedconst(hp) do
+                  begin
+                    if not first then
+                      AsmWrite(',')
+                    else
+                      begin
+                        AsmWrite(' ');
+                        if (tai_abstracttypedconst(p).adetyp=tck_simple) and
+                           (tai_simpletypedconst(p).val.typ=ait_string) then
+                          begin
+                            gotstring:=true;
+                          end
+                        else
+                          begin
+                            AsmWrite('[');
+                          end;
+                        first:=false;
+                      end;
+                    { cannot concat strings and other things }
+                    if gotstring and
+                       ((tai_abstracttypedconst(p).adetyp<>tck_simple) or
+                        (tai_simpletypedconst(p).val.typ<>ait_string)) then
+                      internalerror(2014062701);
+                    WriteTypedConstData(p);
+                  end;
+                if not gotstring then
+                  AsmWrite(']');
+              end;
+            tck_simple:
+              begin
+                pval:=tai_simpletypedconst(hp).val;
+                if pval.typ<>ait_string then
+                  begin
+                    AsmWrite(defstr);
+                    AsmWrite(' ');
+                  end;
+                WriteTai(replaceforbidden,do_line,InlineLevel,pval);
+              end;
+          end;
+        end;
+
+      var
+        hp2: tai;
+        s: string;
+        i: longint;
+        ch: ansichar;
+      begin
+        case hp.typ of
+          ait_comment :
+            begin
+              AsmWrite(target_asm.comment);
+              AsmWritePChar(tai_comment(hp).str);
+              AsmLn;
+            end;
+
+          ait_regalloc :
+            begin
+              if (cs_asm_regalloc in current_settings.globalswitches) then
+                begin
+                  AsmWrite(#9+target_asm.comment+'Register ');
+                  repeat
+                    AsmWrite(std_regname(Tai_regalloc(hp).reg));
+                     if (hp.next=nil) or
+                       (tai(hp.next).typ<>ait_regalloc) or
+                       (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
+                      break;
+                    hp:=tai(hp.next);
+                    AsmWrite(',');
+                  until false;
+                  AsmWrite(' ');
+                  AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
+                end;
+            end;
+
+          ait_tempalloc :
+            begin
+              if (cs_asm_tempalloc in current_settings.globalswitches) then
+                WriteTempalloc(tai_tempalloc(hp));
+            end;
+
+          ait_align,
+          ait_section :
+            begin
+              { ignore, specified as part of declarations -- don't write
+                comment, because could appear in the middle of an aggregate
+                constant definition }
+            end;
+
+          ait_datablock :
+            begin
+              AsmWrite(target_asm.comment);
+              AsmWriteln('datablock');
+            end;
+
+          ait_const:
+            begin
+              WriteOrdConst(tai_const(hp));
+            end;
+
+          ait_realconst :
+            begin
+              WriteRealConst(tai_realconst(hp), do_line);
+            end;
+
+          ait_string :
+            begin
+              if fdecllevel=0 then
+                AsmWrite(target_asm.comment);
+              AsmWrite('c"');
+              for i:=1 to tai_string(hp).len do
+               begin
+                 ch:=tai_string(hp).str[i-1];
+                 case ch of
+                           #0, {This can't be done by range, because a bug in FPC}
+                      #1..#31,
+                   #128..#255,
+                          '"',
+                          '\' : s:='\'+hexStr(ord(ch),2);
+                 else
+                   s:=ch;
+                 end;
+                 AsmWrite(s);
+               end;
+              AsmWriteLn('"');
+            end;
+
+          ait_label :
+            begin
+              if (tai_label(hp).labsym.is_used) then
+                begin
+                  if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then
+                    begin
+                     { should be emitted as part of the variable/function def }
+                     internalerror(2013010703);
+                   end;
+                 if tai_label(hp).labsym.bind in [AB_GLOBAL, AB_PRIVATE_EXTERN] then
+                   begin
+                     { should be emitted as part of the variable/function def }
+                     //internalerror(2013010704);
+                     AsmWriteln(target_asm.comment+'global/privateextern label: '+tai_label(hp).labsym.name);
+                   end;
+                 if replaceforbidden then
+                   AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_label(hp).labsym.name))
+                 else
+                   AsmWrite(tai_label(hp).labsym.name);
+                 AsmWriteLn(':');
+               end;
+            end;
+
+          ait_symbol :
+            begin
+              if fdecllevel=0 then
+                AsmWrite(target_asm.comment);
+              AsmWriteln(LlvmAsmSymName(tai_symbol(hp).sym));
+              { todo }
+              if tai_symbol(hp).has_value then
+                internalerror(2014062402);
+            end;
+          ait_llvmdecl:
+            begin
+              if taillvmdecl(hp).def.typ=procdef then
+                begin
+                  if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
+                    begin
+                      asmwrite('declare');
+                      asmwriteln(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), taillvmdecl(hp).namesym.name, lpd_decl));
+                    end
+                  else
+                    begin
+                      asmwrite('define');
+                      asmwrite(llvmencodeproctype(tprocdef(taillvmdecl(hp).def), '', lpd_decl));
+                      asmwriteln(' {');
+                    end;
+                end
+              else
+                begin
+                  asmwrite(LlvmAsmSymName(taillvmdecl(hp).namesym));
+                  case taillvmdecl(hp).namesym.bind of
+                    AB_EXTERNAL:
+                      asmwrite(' = external ');
+                    AB_COMMON:
+                      asmwrite(' = common ');
+                    AB_LOCAL:
+                      asmwrite(' = internal ');
+                    AB_GLOBAL:
+                      asmwrite(' = ');
+                    AB_WEAK_EXTERNAL:
+                      asmwrite(' = extern_weak ');
+                    AB_PRIVATE_EXTERN:
+                      asmwrite('= linker_private ');
+                    else
+                      internalerror(2014020104);
+                  end;
+                  if taillvmdecl(hp).tls then
+                    asmwrite('thread_local ');
+                  { todo: handle more different section types (mainly
+                      Objective-C }
+                  if taillvmdecl(hp).sec in [sec_rodata,sec_rodata_norel] then
+                    asmwrite('unnamed_addr constant ')
+                  else
+                    asmwrite('global ');
+                  if not assigned(taillvmdecl(hp).initdata) then
+                    begin
+                      asmwrite(llvmencodetype(taillvmdecl(hp).def));
+                      if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL]) then
+                        asmwrite(' zeroinitializer');
+                    end
+                  else
+                    begin
+                      inc(fdecllevel);
+                      { can't have an external symbol with initialisation data }
+                      if taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL] then
+                        internalerror(2014052905);
+                      { bitcast initialisation data to the type of the constant }
+                      { write initialisation data }
+                      hp2:=tai(taillvmdecl(hp).initdata.first);
+                      while assigned(hp2) do
+                        begin
+                          WriteTai(replaceforbidden,do_line,InlineLevel,hp2);
+                          hp2:=tai(hp2.next);
+                        end;
+                      dec(fdecllevel);
+                    end;
+                  { alignment }
+                  asmwrite(', align ');
+                  asmwriteln(tostr(taillvmdecl(hp).alignment));
+                end;
+            end;
+          ait_llvmalias:
+            begin
+              asmwrite(LlvmAsmSymName(taillvmalias(hp).newsym));
+              asmwrite(' = alias ');
+              if taillvmalias(hp).linkage<>lll_default then
+                begin
+                  str(taillvmalias(hp).linkage, s);
+                  asmwrite(copy(s, length('lll_'), 255));
+                  asmwrite(' ');
+                end
+              else
+                asmwrite('external ');
+              if taillvmalias(hp).vis<>llv_default then
+                begin
+                  str(taillvmalias(hp).vis, s);
+                  asmwrite(copy(s, length('llv_'), 255));
+                  asmwrite(' ');
+                end;
+              asmwrite(llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias));
+              asmwrite('* ');
+              asmwriteln(LlvmAsmSymName(taillvmalias(hp).oldsym));
+            end;
+          ait_symbolpair:
+            begin
+              { should be emitted as part of the symbol def }
+              internalerror(2013010708);
+            end;
+
+          ait_weak:
+            begin
+              { should be emitted as part of the symbol def }
+              internalerror(2013010709);
+            end;
+
+          ait_symbol_end :
+            begin
+              if tai_symbol_end(hp).sym.typ=AT_FUNCTION then
+                asmwriteln('}')
+              else
+                asmwriteln('; ait_symbol_end error, should not be generated');
+//                internalerror(2013010711);
+            end;
+
+          ait_instruction :
+            begin
+              WriteInstruction(hp);
+            end;
+
+          ait_llvmins:
+            begin
+              WriteLlvmInstruction(hp);
+            end;
+
+          ait_stab :
+            begin
+              internalerror(2013010712);
+            end;
+
+          ait_force_line,
+          ait_function_name :
+            ;
+
+          ait_cutobject :
+            begin
+            end;
+
+          ait_marker :
+            if tai_marker(hp).kind=mark_NoLineInfoStart then
+              inc(InlineLevel)
+            else if tai_marker(hp).kind=mark_NoLineInfoEnd then
+              dec(InlineLevel);
+
+          ait_directive :
+            begin
+              WriteDirectiveName(tai_directive(hp).directive);
+              if tai_directive(hp).name <>'' then
+                AsmWrite(tai_directive(hp).name);
+              AsmLn;
+            end;
+
+          ait_seh_directive :
+            begin
+              internalerror(2013010713);
+            end;
+          ait_varloc:
+            begin
+              if tai_varloc(hp).newlocationhi<>NR_NO then
+                AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                  std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
+              else
+                AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                  std_regname(tai_varloc(hp).newlocation)));
+              AsmLn;
+            end;
+           ait_typedconst:
+             begin
+               WriteTypedConstData(tai_abstracttypedconst(hp));
+             end
+          else
+            internalerror(2006012201);
+        end;
+      end;
+
+
+    constructor TLLVMAssember.create(smart: boolean);
+      begin
+        inherited create(smart);
+        InstrWriter:=TLLVMInstrWriter.create(self);
+      end;
+
+
+    procedure TLLVMAssember.AsmLn;
+      begin
+        { don't write newlines in the middle of declarations }
+        if fdecllevel=0 then
+          inherited AsmLn;
+      end;
+
+
+
+    procedure TLLVMAssember.WriteDirectiveName(dir: TAsmDirective);
+      begin
+        AsmWrite('.'+directivestr[dir]+' ');
+      end;
+
+
+    procedure TLLVMAssember.WriteAsmList;
+      var
+        n : string;
+        hal : tasmlisttype;
+        i: longint;
+      begin
+
+        if current_module.mainsource<>'' then
+          n:=ExtractFileName(current_module.mainsource)
+        else
+          n:=InputFileName;
+
+        { gcc does not add it either for Darwin. Grep for
+          TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h
+        }
+        if not(target_info.system in systems_darwin) then
+          AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
+
+        WriteExtraHeader;
+        AsmStartSize:=AsmSize;
+
+        for hal:=low(TasmlistType) to high(TasmlistType) do
+          begin
+            AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
+            writetree(current_asmdata.asmlists[hal]);
+            AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
+          end;
+
+        { add weak symbol markers }
+        for i:=0 to current_asmdata.asmsymboldict.count-1 do
+          if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
+            writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
+
+        AsmLn;
+      end;
+
+
+
+{****************************************************************************}
+{                        Abstract Instruction Writer                         }
+{****************************************************************************}
+
+     constructor TLLVMInstrWriter.create(_owner: TLLVMAssember);
+       begin
+         inherited create;
+         owner := _owner;
+       end;
+
+
+   const
+     as_llvm_info : tasminfo =
+        (
+          id     : as_llvm;
+
+          idtxt  : 'LLVM-AS';
+          asmbin : 'llc';
+          asmcmd: '$OPT -o $OBJ $ASM';
+          supported_targets : [system_x86_64_linux,system_x86_64_darwin,system_powerpc64_darwin];
+          flags : [af_smartlink_sections];
+          labelprefix : 'L';
+          comment : '; ';
+          dollarsign: '$';
+        );
+
+
+begin
+  RegisterAssembler(as_llvm_info,TLLVMAssember);
+end.

compiler/llvm/cgllvm.pas

@@ -0,0 +1,124 @@
+{
+    Copyright (c) 2010-2013 by Jonas Maebe
+
+    This unit implements the code generator for LLVM
+
+    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 cgllvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       globtype,parabase,
+       cgbase,cgutils,cgobj,cghlcpu,
+       llvmbase,llvminfo,aasmbase,aasmtai,aasmdata,aasmllvm;
+
+    type
+      tcgllvm=class(thlbasecgcpu)
+     public
+        procedure a_label(list : TAsmList;l : tasmlabel);override;
+        procedure a_jmp_always(list: TAsmList; l: tasmlabel); override;
+        procedure init_register_allocators;override;
+        procedure done_register_allocators;override;
+        function  getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
+        function  getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
+      end;
+
+    procedure create_codegen;
+
+implementation
+
+  uses
+    globals,verbose,systems,cutils,
+    paramgr,fmodule,
+    tgobj,rgllvm,cpubase,
+    procinfo,cpupi;
+
+
+{****************************************************************************
+                              Assembler code
+****************************************************************************}
+
+    procedure tcgllvm.a_label(list: TAsmList; l: tasmlabel);
+      begin
+        { in llvm, every block must end with a terminator instruction, such as
+          a branch -> if the previous instruction is not a terminator instruction,
+          add an unconditional branch to the next block (= the one starting with
+          this label) }
+        if not assigned(list.last) or
+           (tai(list.Last).typ<>ait_llvmins) or
+           not(taillvm(list.Last).llvmopcode in llvmterminatoropcodes) then
+          a_jmp_always(list,l);
+        inherited;
+      end;
+
+
+    procedure tcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
+      begin
+        list.concat(taillvm.op_lab(la_br,l));
+      end;
+
+
+    procedure tcgllvm.init_register_allocators;
+      begin
+        inherited init_register_allocators;
+        rg[R_INTREGISTER]:=Trgllvm.create(R_INTREGISTER,R_SUBWHOLE,
+          [0],first_int_imreg,[]);
+        rg[R_FPUREGISTER]:=Trgllvm.create(R_FPUREGISTER,R_SUBWHOLE,
+          [0],first_fpu_imreg,[]);
+        rg[R_MMREGISTER]:=Trgllvm.create(R_MMREGISTER,R_SUBWHOLE,
+          [0],first_mm_imreg,[]);
+        { every temp gets its own "base register" to uniquely identify it }
+        rg[R_TEMPREGISTER]:=trgllvm.Create(R_TEMPREGISTER,R_SUBWHOLE,
+          [0],1,[]);
+      end;
+
+
+    procedure tcgllvm.done_register_allocators;
+      begin
+        rg[R_INTREGISTER].free;
+        rg[R_FPUREGISTER].free;
+        rg[R_TEMPREGISTER].free;
+        inherited done_register_allocators;
+      end;
+
+
+    function tcgllvm.getintregister(list:TAsmList;size:Tcgsize):Tregister;
+      begin
+        { all size determinations are based on tdef, subregisters are
+          irrelevant }
+        result:=rg[R_INTREGISTER].getregister(list,R_SUBWHOLE)
+      end;
+
+
+    function tcgllvm.getfpuregister(list:TAsmList;size:Tcgsize):Tregister;
+      begin
+        { all size determinations are based on tdef, subregisters are
+          irrelevant }
+        result:=rg[R_FPUREGISTER].getregister(list,R_SUBWHOLE);
+      end;
+
+
+    procedure create_codegen;
+      begin
+        cg:=tcgllvm.Create;
+      end;
+
+end.

compiler/llvm/hlcgllvm.pas

@@ -0,0 +1,1614 @@
+{
+    Copyright (c) 2010, 2013 by Jonas Maebe
+    Member of the Free Pascal development team
+
+    This unit implements the LLVM high level code generator
+
+    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 hlcgllvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  globtype,cclasses,
+  aasmbase,aasmdata,
+  symbase,symconst,symtype,symdef,symsym,
+  cpubase, hlcgobj, cgbase, cgutils, parabase, tgobj;
+
+  type
+
+    { thlcgllvm }
+
+    thlcgllvm = class(thlcgobj)
+      constructor create;
+
+      procedure temp_to_ref(p: ptemprecord; out ref: treference); override;
+
+      procedure a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara); override;
+     protected
+       procedure a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
+     public
+      procedure getcpuregister(list: TAsmList; r: Tregister); override;
+      procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
+      procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
+      procedure deallocallcpuregisters(list: TAsmList); override;
+
+     protected
+      procedure a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
+     public
+      function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
+      function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
+
+      procedure a_load_const_reg(list : TAsmList;tosize : tdef;a : tcgint;register : tregister);override;
+      procedure a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);override;
+      procedure a_load_reg_ref(list : TAsmList;fromsize, tosize : tdef;register : tregister;const ref : treference);override;
+      procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tdef;reg1,reg2 : tregister);override;
+      procedure a_load_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;register : tregister);override;
+      procedure a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference); override;
+      procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
+
+      procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister); override;
+      procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister); override;
+
+      procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister); override;
+      procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister); override;
+      procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
+      procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); override;
+
+      procedure a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override;
+      procedure a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override;
+
+      procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
+
+      procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
+
+      procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
+      procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference); override;
+      procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister); override;
+
+      procedure gen_proc_symbol(list: TAsmList); override;
+      procedure gen_proc_symbol_end(list: TAsmList); override;
+      procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
+      procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
+
+      procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
+      procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
+
+      procedure g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister); override;
+      procedure g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference); override;
+
+      procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle); override;
+      procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle); override;
+      procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle); override;
+      procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle); override;
+      procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle); override;
+      procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle); override;
+
+      function get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara; override;
+     protected
+      procedure gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation); override;
+     public
+      procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); override;
+      procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override;
+{$ifdef cpuflags}
+      { llvm doesn't have flags, but cpuflags is defined in case the real cpu
+        has flags and we have to override the abstract methods to prevent
+        warnings }
+      procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
+      procedure g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister); override;
+      procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference); override;
+{$endif cpuflags}
+
+      { unimplemented or unnecessary routines }
+      procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister); override;
+      procedure g_stackpointer_alloc(list: TAsmList; size: longint); override;
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); override;
+      procedure g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint); override;
+      procedure g_local_unwind(list: TAsmList; l: TAsmLabel); override;
+
+      procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
+      procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
+    protected
+      { def is the type of the data stored in memory pointed to by ref, not
+        a pointer to this type }
+      function make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
+      procedure paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
+      procedure set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
+    end;
+
+  procedure create_hlcodegen;
+
+
+implementation
+
+  uses
+    verbose,cutils,globals,fmodule,constexp,systems,
+    defutil,llvmdef,llvmsym,
+    aasmtai,aasmcpu,
+    aasmllvm,llvmbase,tgllvm,
+    symtable,
+    paramgr,llvmpara,
+    procinfo,cpuinfo,cgobj,cgllvm,cghlcpu;
+
+  const
+    topcg2llvmop: array[topcg] of tllvmop =
+     { OP_NONE  OP_MOVE     OP_ADD  OP_AND  OP_DIV   OP_IDIV  OP_IMUL OP_MUL }
+      (la_none, la_none, la_add, la_and, la_udiv, la_sdiv, la_mul, la_mul,
+     { OP_NEG   OP_NOT   OP_OR  OP_SAR   OP_SHL  OP_SHR   OP_SUB  OP_XOR }
+       la_none, la_none, la_or, la_ashr, la_shl, la_lshr, la_sub, la_xor,
+     { OP_ROL   OP_ROR }
+       la_none, la_none);
+
+
+  constructor thlcgllvm.create;
+    begin
+      inherited
+    end;
+
+
+  procedure thlcgllvm.temp_to_ref(p: ptemprecord; out ref: treference);
+    begin
+      { on the LLVM target, every temp is independent and encoded via a
+        separate temp register whose superregister number is stored in p^.pos }
+      reference_reset_base(ref,voidstackpointertype,newreg(R_TEMPREGISTER,p^.pos,R_SUBWHOLE),0,p^.alignment);
+    end;
+
+
+  procedure thlcgllvm.a_load_ref_cgpara(list: TAsmList; size: tdef; const r: treference; const cgpara: TCGPara);
+    var
+      tmpref, initialref, ref: treference;
+      orgsize: tdef;
+      tmpreg: tregister;
+      hloc: tlocation;
+      location: pcgparalocation;
+      orgsizeleft,
+      sizeleft,
+      totaloffset: asizeint;
+      paralocidx: longint;
+      userecord,
+      reghasvalue: boolean;
+    begin
+      location:=cgpara.location;
+      sizeleft:=cgpara.intsize;
+      totaloffset:=0;
+      orgsize:=size;
+      a_load_ref_cgpara_init_src(list,cgpara,r,size,initialref);
+      userecord:=
+        (orgsize<>size) and
+        assigned(cgpara.location^.next);
+      paralocidx:=0;
+      while assigned(location) do
+        begin
+          if userecord then
+            begin
+              { llvmparadef is a record in this case, with every field corresponding
+                to a single paraloc }
+              paraloctoloc(location,hloc);
+              tmpreg:=getaddressregister(list,getpointerdef(location^.def));
+              list.concat(taillvm.getelementptr_reg_size_ref_size_const(tmpreg,getpointerdef(size),initialref,s32inttype,paralocidx,true));
+              reference_reset_base(tmpref,getpointerdef(location^.def),tmpreg,0,newalignment(initialref.alignment,totaloffset));
+            end
+          else
+            tmpref:=initialref;
+          paramanager.allocparaloc(list,location);
+          case location^.loc of
+            LOC_REGISTER,LOC_CREGISTER:
+              begin
+                 { byval parameter -> load the address rather than the value }
+                 if not location^.llvmvalueloc then
+                   a_loadaddr_ref_reg(list,tpointerdef(location^.def).pointeddef,location^.def,tmpref,location^.register)
+                 { if this parameter is split into multiple paralocs via
+                   record fields, load the current paraloc. The type of the
+                   paraloc and of the current record field will match by
+                   construction (the record is build from the paraloc
+                   types) }
+                 else if userecord then
+                   a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
+                 { if the parameter is passed in a single paraloc, the
+                   paraloc's type may be different from the declared type
+                   -> use the original complete parameter size as source so
+                   we can insert a type conversion if necessary }
+                 else
+                   a_load_ref_reg(list,size,location^.def,tmpref,location^.register)
+             end;
+            LOC_REFERENCE,LOC_CREFERENCE:
+              begin
+                 if assigned(location^.next) then
+                   internalerror(2010052906);
+                 reference_reset_base(ref,getpointerdef(size),location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft));
+                 if (def_cgsize(size)<>OS_NO) and
+                    (size.size=sizeleft) and
+                    (sizeleft<=sizeof(aint)) then
+                   a_load_ref_ref(list,size,location^.def,tmpref,ref)
+                 else
+                   { use concatcopy, because the parameter can be larger than }
+                   { what the OS_* constants can handle                       }
+                   g_concatcopy(list,location^.def,tmpref,ref);
+              end;
+            LOC_MMREGISTER,LOC_CMMREGISTER:
+              begin
+                 case location^.size of
+                   OS_F32,
+                   OS_F64,
+                   OS_F128:
+                     a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,mms_movescalar);
+                   OS_M8..OS_M128,
+                   OS_MS8..OS_MS128:
+                     a_loadmm_ref_reg(list,location^.def,location^.def,tmpref,location^.register,nil);
+                   else
+                     internalerror(2010053101);
+                 end;
+              end
+            else
+              internalerror(2010053111);
+          end;
+          inc(totaloffset,tcgsize2size[location^.size]);
+          dec(sizeleft,tcgsize2size[location^.size]);
+          location:=location^.next;
+          inc(paralocidx);
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_load_ref_cgpara_init_src(list: TAsmList; const para: tcgpara; const initialref: treference; var refsize: tdef; out newref: treference);
+    var
+      newrefsize: tdef;
+      reg: tregister;
+    begin
+      newrefsize:=llvmgetcgparadef(para,true);
+      if refsize<>newrefsize then
+        begin
+          reg:=getaddressregister(list,getpointerdef(newrefsize));
+          a_loadaddr_ref_reg(list,refsize,getpointerdef(newrefsize),initialref,reg);
+          reference_reset_base(newref,getpointerdef(newrefsize),reg,0,initialref.alignment);
+          refsize:=newrefsize;
+        end
+      else
+        newref:=initialref;
+    end;
+
+
+  procedure thlcgllvm.getcpuregister(list: TAsmList; r: Tregister);
+    begin
+      { don't do anything }
+    end;
+
+
+  procedure thlcgllvm.ungetcpuregister(list: TAsmList; r: Tregister);
+    begin
+      { don't do anything }
+    end;
+
+
+  procedure thlcgllvm.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
+    begin
+      { don't do anything }
+    end;
+
+
+  procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
+    begin
+      { don't do anything }
+    end;
+
+
+  procedure thlcgllvm.a_call_common(list: TAsmList; pd: tabstractprocdef; const paras: array of pcgpara; const forceresdef: tdef; out res: tregister; out calldef: tdef; out hlretdef: tdef; out llvmretdef: tdef; out callparas: tfplist);
+
+    procedure load_ref_anyreg(def: tdef; const ref: treference; reg: tregister; var callpara: pllvmcallpara);
+      begin
+        case getregtype(reg) of
+          R_INTREGISTER,
+          R_ADDRESSREGISTER:
+            begin
+              a_load_ref_reg(list,def,def,ref,reg);
+              callpara^.loc:=LOC_REGISTER;
+            end;
+          R_FPUREGISTER:
+            begin
+              a_loadfpu_ref_reg(list,def,def,ref,reg);
+              callpara^.loc:=LOC_FPUREGISTER;
+            end;
+          R_MMREGISTER:
+            begin
+              a_loadmm_ref_reg(list,def,def,ref,reg,mms_movescalar);
+              callpara^.loc:=LOC_MMREGISTER;
+            end;
+          else
+            internalerror(2014012213);
+        end;
+      end;
+
+  var
+    i: longint;
+    href: treference;
+    callpara: pllvmcallpara;
+    paraloc: pcgparalocation;
+  begin
+    callparas:=tfplist.Create;
+    for i:=0 to high(paras) do
+      begin
+        paraloc:=paras[i]^.location;
+        while assigned(paraloc) and
+              (paraloc^.loc<>LOC_VOID) do
+          begin
+            new(callpara);
+            callpara^.def:=paraloc^.def;
+            llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
+            callpara^.loc:=paraloc^.loc;
+            case callpara^.loc of
+              LOC_REFERENCE:
+                begin
+                  if paraloc^.llvmvalueloc then
+                    internalerror(2014012307)
+                  else
+                    begin
+                      reference_reset_base(href, getpointerdef(callpara^.def), paraloc^.reference.index, paraloc^.reference.offset, paraloc^.def.alignment);
+                      res:=getregisterfordef(list, paraloc^.def);
+                      load_ref_anyreg(callpara^.def, href, res, callpara);
+                    end;
+                  callpara^.reg:=res
+                end;
+              LOC_REGISTER,
+              LOC_FPUREGISTER,
+              LOC_MMREGISTER:
+                begin
+                  { undo explicit value extension }
+                  if callpara^.valueext<>lve_none then
+                    begin
+                      res:=getregisterfordef(list, callpara^.def);
+                      a_load_reg_reg(list, paraloc^.def, callpara^.def, paraloc^.register, res);
+                      paraloc^.register:=res;
+                    end;
+                    callpara^.reg:=paraloc^.register
+                end;
+              else
+                internalerror(2014010605);
+            end;
+            callparas.add(callpara);
+            paraloc:=paraloc^.next;
+          end;
+      end;
+    { the Pascal level may expect a different returndef compared to the
+      declared one }
+    if not assigned(forceresdef) then
+      hlretdef:=pd.returndef
+    else
+      hlretdef:=forceresdef;
+    { llvm will always expect the original return def }
+    if not paramanager.ret_in_param(hlretdef, pd) then
+      llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true)
+    else
+      llvmretdef:=voidtype;
+    if not is_void(llvmretdef) then
+      res:=getregisterfordef(list, llvmretdef)
+    else
+      res:=NR_NO;
+
+    { if this is a complex procvar, get the non-tmethod-like equivalent }
+    if (pd.typ=procvardef) and
+       not pd.is_addressonly then
+      pd:=tprocvardef(pd.getcopyas(procvardef,pc_address_only));
+    { if the function returns a function pointer type or is varargs, we
+      must specify the full function signature, otherwise we can only
+      specify the return type }
+    if (po_varargs in pd.procoptions) or
+       ((pd.proccalloption in cdecl_pocalls) and
+        (pd.paras.count>0) and
+        is_array_of_const(tparavarsym(pd.paras[pd.paras.count-1]).vardef)) then
+      if (pd.typ=procdef) or
+         not pd.is_addressonly then
+        calldef:=pd.getcopyas(procvardef,pc_address_only)
+      else
+        calldef:=pd
+    else
+      calldef:=llvmretdef;
+  end;
+
+
+  function thlcgllvm.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
+    var
+      callparas: tfplist;
+      asmsym: tasmsymbol;
+      llvmretdef,
+      hlretdef,
+      calldef: tdef;
+      res: tregister;
+    begin
+      if not pd.owner.iscurrentunit or
+         (s<>pd.mangledname) or
+         (po_external in pd.procoptions) then
+        begin
+          asmsym:=current_asmdata.RefAsmSymbol(tprocdef(pd).mangledname);
+          if not asmsym.declared then
+            current_asmdata.AsmLists[al_imports].Concat(taillvmdecl.create(asmsym,pd,nil,sec_code,pd.alignment));
+        end;
+      a_call_common(list,pd,paras,forceresdef,res,calldef,hlretdef,llvmretdef,callparas);
+      list.concat(taillvm.call_size_name_paras(res,calldef,current_asmdata.RefAsmSymbol(pd.mangledname),callparas));
+      result:=get_call_result_cgpara(pd,forceresdef);
+      set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
+    end;
+
+
+  function thlcgllvm.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
+    var
+      callparas: tfplist;
+      llvmretdef,
+      hlretdef,
+      calldef: tdef;
+      res: tregister;
+    begin
+      a_call_common(list,pd,paras,nil,res,calldef,hlretdef,llvmretdef,callparas);
+      list.concat(taillvm.call_size_reg_paras(res,calldef,reg,callparas));
+      result:=get_call_result_cgpara(pd,nil);
+      set_call_function_result(list,pd,llvmretdef,hlretdef,res,result);
+    end;
+
+
+  procedure thlcgllvm.a_load_const_reg(list: TAsmList; tosize: tdef; a: tcgint; register: tregister);
+    begin
+      list.concat(taillvm.op_reg_size_const_size(llvmconvop(ptrsinttype,tosize),register,ptrsinttype,a,tosize))
+    end;
+
+
+  procedure thlcgllvm.a_load_const_ref(list: TAsmList; tosize: tdef; a: tcgint; const ref: treference);
+    var
+      sref: treference;
+    begin
+      sref:=make_simple_ref(list,ref,tosize);
+      list.concat(taillvm.op_size_const_size_ref(la_store,tosize,a,getpointerdef(tosize),sref))
+    end;
+
+
+  function def2intdef(fromsize, tosize: tdef): tdef;
+    begin
+      { we cannot zero-extend from/to anything but ordinal/enum
+        types }
+      if not(tosize.typ in [orddef,enumdef]) then
+        internalerror(2014012305);
+      { will give an internalerror if def_cgsize() returns OS_NO, which is
+        what we want }
+      result:=cgsize_orddef(def_cgsize(fromsize));
+    end;
+
+
+  procedure thlcgllvm.a_load_reg_ref(list: TAsmList; fromsize, tosize: tdef; register: tregister; const ref: treference);
+    var
+      tmpref,
+      sref: treference;
+      hreg,
+      hreg2: tregister;
+      tmpsize: tdef;
+    begin
+      sref:=make_simple_ref(list,ref,tosize);
+      hreg:=register;
+      (* typecast the pointer to the value instead of the value itself if
+        they have the same size but are of different kinds, because we can't
+        e.g. typecast a loaded <{i32, i32}> to an i64 *)
+      if (llvmaggregatetype(fromsize) or
+          llvmaggregatetype(tosize)) and
+         (fromsize<>tosize) then
+        begin
+          if fromsize.size>tosize.size then
+            begin
+              { if source size is larger than the target size, we have to
+                truncate it before storing. Unfortunately, we cannot truncate
+                records (nor bitcast them to integers), so we first have to
+                store them to memory and then bitcast the pointer to them
+              }
+              if fromsize.typ in [arraydef,recorddef] then
+                begin
+                  { store struct/array-in-register to memory }
+                  tmpsize:=def2intdef(fromsize,tosize);
+                  tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
+                  a_load_reg_ref(list,fromsize,fromsize,register,tmpref);
+                  { typecast pointer to memory into pointer to integer type }
+                  hreg:=getaddressregister(list,getpointerdef(tmpsize));
+                  a_loadaddr_ref_reg(list,fromsize,getpointerdef(tmpsize),tmpref,hreg);
+                  reference_reset_base(sref,getpointerdef(tmpsize),hreg,0,tmpref.alignment);
+                  { load the integer from the temp into the destination }
+                  a_load_ref_ref(list,tmpsize,tosize,tmpref,sref);
+                  tg.ungettemp(list,tmpref);
+                end
+              else
+                begin
+                  tmpsize:=def2intdef(tosize,fromsize);
+                  hreg:=getintregister(list,tmpsize);
+                  { truncate the integer }
+                  a_load_reg_reg(list,fromsize,tmpsize,register,hreg);
+                  { store it to memory (it will now be of the same size as the
+                    struct, and hence another path will be followed in this
+                    method) }
+                  a_load_reg_ref(list,tmpsize,tosize,hreg,sref);
+                end;
+                exit;
+            end
+          else
+            begin
+              hreg2:=getaddressregister(list,getpointerdef(fromsize));
+              a_loadaddr_ref_reg(list,tosize,getpointerdef(fromsize),sref,hreg2);
+              reference_reset_base(sref,getpointerdef(fromsize),hreg2,0,sref.alignment);
+              tosize:=fromsize;
+            end;
+        end
+      else if fromsize<>tosize then
+        begin
+          hreg:=getregisterfordef(list,tosize);
+          a_load_reg_reg(list,fromsize,tosize,register,hreg);
+        end;
+      list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,hreg,getpointerdef(tosize),sref));
+    end;
+
+
+  procedure thlcgllvm.a_load_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
+    var
+      op: tllvmop;
+      tmpreg: tregister;
+      tmpintdef: tdef;
+    begin
+      op:=llvmconvop(fromsize,tosize);
+      { converting from pointer to something else and vice versa is only
+        possible via an intermediate pass to integer. Same for "something else"
+        to pointer. }
+      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(tosize));
+                op:=la_bitcast
+              end
+            else
+              begin
+                tmpintdef:=cgsize_orddef(def_cgsize(fromsize));
+                op:=la_inttoptr;
+              end;
+            tmpreg:=getintregister(list,tmpintdef);
+            a_load_reg_reg(list,fromsize,tmpintdef,reg1,tmpreg);
+            reg1:=tmpreg;
+            fromsize:=tmpintdef;
+          end;
+      end;
+      { reg2 = bitcast fromsize reg1 to tosize }
+      list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
+    end;
+
+
+  procedure thlcgllvm.a_load_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; register: tregister);
+    var
+      tmpref,
+      sref: treference;
+      hreg: tregister;
+      tmpsize: tdef;
+    begin
+      sref:=make_simple_ref(list,ref,fromsize);
+      { "named register"? }
+      if sref.refaddr=addr_full then
+        begin
+          { can't bitcast records/arrays }
+          if (llvmaggregatetype(fromsize) or
+              llvmaggregatetype(tosize)) and
+             (fromsize<>tosize) then
+            begin
+              tg.gethltemp(list,fromsize,fromsize.size,tt_normal,tmpref);
+              list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,getpointerdef(fromsize),tmpref));
+              a_load_ref_reg(list,fromsize,tosize,tmpref,register);
+              tg.ungettemp(list,tmpref);
+            end
+          else
+            list.concat(taillvm.op_reg_size_ref_size(la_bitcast,register,fromsize,sref,tosize))
+        end
+      else
+        begin
+          if ((fromsize.typ in [arraydef,recorddef]) or
+              (tosize.typ in [arraydef,recorddef])) and
+             (fromsize<>tosize) then
+            begin
+              if fromsize.size<tosize.size then
+                begin
+                  { if the target size is larger than the source size, we
+                    have to perform the zero-extension using an integer type
+                    (can't zero-extend a record/array) }
+                  if fromsize.typ in [arraydef,recorddef] then
+                    begin
+                      { typecast the pointer to the struct into a pointer to an
+                        integer of equal size }
+                      tmpsize:=def2intdef(fromsize,tosize);
+                      hreg:=getaddressregister(list,getpointerdef(tmpsize));
+                      a_loadaddr_ref_reg(list,fromsize,getpointerdef(tmpsize),sref,hreg);
+                      reference_reset_base(sref,getpointerdef(tmpsize),hreg,0,sref.alignment);
+                      { load that integer }
+                      a_load_ref_reg(list,tmpsize,tosize,sref,register);
+                    end
+                  else
+                    begin
+                      { load the integer into an integer memory location with
+                        the same size as the struct (the integer should be
+                        unsigned, we don't want sign extensions here) }
+                      if is_signed(fromsize) then
+                        internalerror(2014012309);
+                      tmpsize:=def2intdef(tosize,fromsize);
+                      tg.gethltemp(list,tmpsize,tmpsize.size,tt_normal,tmpref);
+                      { typecast the struct-sized integer location into the
+                        struct type }
+                      a_load_ref_ref(list,fromsize,tmpsize,sref,tmpref);
+                      { load the struct in the register }
+                      a_load_ref_reg(list,tmpsize,tosize,tmpref,register);
+                      tg.ungettemp(list,tmpref);
+                    end;
+                  exit;
+                end
+              else
+                begin
+                  (* typecast the pointer to the value instead of the value
+                     itself if they have the same size but are of different
+                     kinds, because we can't e.g. typecast a loaded <{i32, i32}>
+                     to an i64 *)
+                  hreg:=getaddressregister(list,getpointerdef(tosize));
+                  a_loadaddr_ref_reg(list,fromsize,getpointerdef(tosize),sref,hreg);
+                  reference_reset_base(sref,getpointerdef(tosize),hreg,0,sref.alignment);
+                  fromsize:=tosize;
+                end;
+            end;
+          hreg:=register;
+          if fromsize<>tosize then
+            hreg:=getregisterfordef(list,fromsize);
+          list.concat(taillvm.op_reg_size_ref(la_load,hreg,getpointerdef(fromsize),sref));
+          if hreg<>register then
+            a_load_reg_reg(list,fromsize,tosize,hreg,register);
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_load_ref_ref(list: TAsmList; fromsize, tosize: tdef; const sref: treference; const dref: treference);
+    var
+      sdref: treference;
+    begin
+      if (fromsize=tosize) and
+         (sref.refaddr=addr_full) then
+        begin
+          sdref:=make_simple_ref(list,dref,tosize);
+          list.concat(taillvm.op_size_ref_size_ref(la_store,fromsize,sref,getpointerdef(tosize),sdref));
+        end
+      else
+        inherited
+    end;
+
+
+  procedure thlcgllvm.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; r: tregister);
+    var
+      sref: treference;
+    begin
+      { can't take the address of a 'named register' }
+      if ref.refaddr=addr_full then
+        internalerror(2013102306);
+      sref:=make_simple_ref(list,ref,fromsize);
+      list.concat(taillvm.op_reg_size_ref_size(la_bitcast,r,getpointerdef(fromsize),sref,tosize));
+    end;
+
+
+  procedure thlcgllvm.a_op_const_reg(list: TAsmList; Op: TOpCG; size: tdef; a: tcgint; reg: TRegister);
+    begin
+      a_op_const_reg_reg(list,op,size,a,reg,reg);
+    end;
+
+
+  procedure thlcgllvm.a_op_const_reg_reg(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister);
+    var
+      tmpreg: tregister;
+    begin
+      if (def2regtyp(size)=R_INTREGISTER) and
+         (topcg2llvmop[op]<>la_none) then
+        list.concat(taillvm.op_reg_size_reg_const(topcg2llvmop[op],dst,size,src,a))
+      else
+        begin
+          { default implementation is not SSA-safe }
+          tmpreg:=getregisterfordef(list,size);
+          a_load_const_reg(list,size,a,tmpreg);
+          a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister);
+    var
+      orgdst,
+      tmpreg1,
+      tmpreg2,
+      tmpreg3: tregister;
+      opsize: tdef;
+    begin
+      orgdst:=dst;
+      opsize:=size;
+      { always perform using integer registers, because math operations on
+        pointers are not supported (except via getelementptr, possible future
+        optimization) }
+      if def2regtyp(size)=R_ADDRESSREGISTER then
+        begin
+          opsize:=ptruinttype;
+
+          tmpreg1:=getintregister(list,ptruinttype);
+          a_load_reg_reg(list,size,ptruinttype,src1,tmpreg1);
+          src1:=tmpreg1;
+
+          tmpreg1:=getintregister(list,ptruinttype);
+          a_load_reg_reg(list,size,ptruinttype,src2,tmpreg1);
+          src2:=tmpreg1;
+
+          dst:=getintregister(list,ptruinttype);
+        end;
+     if topcg2llvmop[op]<>la_none then
+       list.concat(taillvm.op_reg_size_reg_reg(topcg2llvmop[op],dst,opsize,src2,src1))
+     else
+       begin
+         case op of
+           OP_NEG:
+             { %dst = sub size 0, %src1 }
+             list.concat(taillvm.op_reg_size_const_reg(la_sub,dst,opsize,0,src1));
+           OP_NOT:
+             { %dst = xor size -1, %src1 }
+             list.concat(taillvm.op_reg_size_const_reg(la_xor,dst,opsize,-1,src1));
+           OP_ROL:
+             begin
+               tmpreg1:=getintregister(list,opsize);
+               tmpreg2:=getintregister(list,opsize);
+               tmpreg3:=getintregister(list,opsize);
+               { tmpreg1 := tcgsize2size[size] - src1 }
+               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
+               { tmpreg2 := src2 shr tmpreg1 }
+               a_op_reg_reg_reg(list,OP_SHR,opsize,tmpreg1,src2,tmpreg2);
+               { tmpreg3 := src2 shl src1 }
+               a_op_reg_reg_reg(list,OP_SHL,opsize,src1,src2,tmpreg3);
+               { dst := tmpreg2 or tmpreg3 }
+               a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
+             end;
+           OP_ROR:
+             begin
+               tmpreg1:=getintregister(list,size);
+               tmpreg2:=getintregister(list,size);
+               tmpreg3:=getintregister(list,size);
+               { tmpreg1 := tcgsize2size[size] - src1 }
+               list.concat(taillvm.op_reg_size_const_reg(la_sub,tmpreg1,opsize,opsize.size,src1));
+               { tmpreg2 := src2 shl tmpreg1 }
+               a_op_reg_reg_reg(list,OP_SHL,opsize,tmpreg1,src2,tmpreg2);
+               { tmpreg3 := src2 shr src1 }
+               a_op_reg_reg_reg(list,OP_SHR,opsize,src1,src2,tmpreg3);
+               { dst := tmpreg2 or tmpreg3 }
+               a_op_reg_reg_reg(list,OP_OR,opsize,tmpreg2,tmpreg3,dst);
+             end;
+           else
+             internalerror(2010081310);
+         end;
+       end;
+     if dst<>orgdst then
+       a_load_reg_reg(list,opsize,size,dst,orgdst);
+   end;
+
+
+  procedure thlcgllvm.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; reg1, reg2: TRegister);
+    begin
+       a_op_reg_reg_reg(list,op,size,reg1,reg2,reg2);
+    end;
+
+
+  procedure thlcgllvm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation);
+    begin
+      if not setflags then
+        begin
+          inherited;
+          exit;
+        end;
+      { use xxx.with.overflow intrinsics }
+      internalerror(2012111102);
+    end;
+
+
+  procedure thlcgllvm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tdef; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation);
+    begin
+      if not setflags then
+        begin
+          inherited;
+          exit;
+        end;
+      { use xxx.with.overflow intrinsics }
+      internalerror(2012111103);
+    end;
+
+
+  procedure thlcgllvm.a_cmp_const_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel);
+    var
+      tmpreg : tregister;
+      invert: boolean;
+      fallthroughlab, falselab, tmplab: tasmlabel;
+    begin
+      { since all comparisons return their results in a register, we'll often
+        get comparisons against true/false -> optimise }
+      if (size=pasbool8type) and
+         (cmp_op in [OC_EQ,OC_NE]) then
+        begin
+          case cmp_op of
+            OC_EQ:
+              invert:=a=0;
+            OC_NE:
+              invert:=a=1;
+            else
+              { avoid uninitialised warning }
+              internalerror(2015031504);
+            end;
+          current_asmdata.getjumplabel(falselab);
+          fallthroughlab:=falselab;
+          if invert then
+            begin
+              tmplab:=l;
+              l:=falselab;
+              falselab:=tmplab;
+            end;
+          list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab));
+          a_label(list,fallthroughlab);
+          exit;
+        end;
+      tmpreg:=getregisterfordef(list,size);
+      a_load_const_reg(list,size,a,tmpreg);
+      a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
+    end;
+
+
+  procedure thlcgllvm.a_cmp_reg_reg_label(list: TAsmList; size: tdef; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);
+    var
+      resreg: tregister;
+      falselab: tasmlabel;
+    begin
+      if getregtype(reg1)<>getregtype(reg2) then
+        internalerror(2012111105);
+      resreg:=getintregister(list,pasbool8type);
+      current_asmdata.getjumplabel(falselab);
+      { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
+        e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
+        OC_GT is true if op1>op2 }
+      list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
+      list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab));
+      a_label(list,falselab);
+    end;
+
+
+  procedure thlcgllvm.a_jmp_always(list: TAsmList; l: tasmlabel);
+    begin
+      { implement in tcg because required by the overridden a_label; doesn't use
+        any high level stuff anyway }
+      cg.a_jmp_always(list,l);
+    end;
+
+
+  procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
+    begin
+      a_load_ref_ref(list,size,size,source,dest);
+    end;
+
+
+  procedure thlcgllvm.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister);
+    var
+       tmpreg: tregister;
+       href: treference;
+       fromcompcurr,
+       tocompcurr: boolean;
+     begin
+       { comp and currency are handled by the x87 in this case. They cannot
+         be represented directly in llvm, and llvmdef translates them into i64
+         (since that's their storage size and internally they also are int64).
+         Solve this by changing the type to s80real once they are loaded into
+         a register. }
+       fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
+       tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
+       if tocompcurr then
+         tosize:=s80floattype;
+       href:=make_simple_ref(list,ref,fromsize);
+       { don't generate different code for loading e.g. extended into cextended,
+         but to take care of loading e.g. comp (=int64) into double }
+       if (fromsize.size<>tosize.size) then
+         tmpreg:=getfpuregister(list,fromsize)
+       else
+         tmpreg:=reg;
+       { %tmpreg = load size* %ref }
+       list.concat(taillvm.op_reg_size_ref(la_load,tmpreg,getpointerdef(fromsize),href));
+       if tmpreg<>reg then
+         if fromcompcurr then
+           { treat as extended as long as it's in a register }
+           list.concat(taillvm.op_reg_size_reg_size(la_sitofp,reg,fromsize,tmpreg,tosize))
+         else
+           a_loadfpu_reg_reg(list,fromsize,tosize,tmpreg,reg);
+     end;
+
+
+  procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
+    var
+       tmpreg: tregister;
+       href: treference;
+       fromcompcurr,
+       tocompcurr: boolean;
+     begin
+       { see comment in a_loadfpu_ref_reg }
+       fromcompcurr:=tfloatdef(fromsize).floattype in [s64comp,s64currency];
+       tocompcurr:=tfloatdef(tosize).floattype in [s64comp,s64currency];
+       if fromcompcurr then
+         fromsize:=s80floattype;
+       href:=make_simple_ref(list,ref,tosize);
+       { don't generate different code for loading e.g. extended into cextended,
+         but to take care of storing e.g. comp (=int64) into double  }
+       if (fromsize.size<>tosize.size) then
+         begin
+           tmpreg:=getfpuregister(list,tosize);
+           if tocompcurr then
+             { store back an int64 rather than an extended }
+             list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
+           else
+             a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
+         end
+       else
+         tmpreg:=reg;
+       { store tosize tmpreg, tosize* href }
+       list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,tmpreg,getpointerdef(tosize),href));
+     end;
+
+
+  procedure thlcgllvm.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister);
+    var
+      op: tllvmop;
+      intfromsize,
+      inttosize: longint;
+    begin
+      { treat comp and currency as extended in registers (see comment at start
+        of a_loadfpu_ref_reg) }
+      if tfloatdef(fromsize).floattype in [s64comp,s64currency] then
+        fromsize:=sc80floattype;
+      if tfloatdef(tosize).floattype in [s64comp,s64currency] then
+        tosize:=sc80floattype;
+      { at the value level, s80real and sc80real are the same }
+      if fromsize<>s80floattype then
+        intfromsize:=fromsize.size
+      else
+        intfromsize:=sc80floattype.size;
+      if tosize<>s80floattype then
+        inttosize:=tosize.size
+      else
+        inttosize:=sc80floattype.size;
+
+      if intfromsize<inttosize then
+        op:=la_fpext
+       else if intfromsize>inttosize then
+        op:=la_fptrunc
+      else
+        op:=la_bitcast;
+      { reg2 = bitcast fromllsize reg1 to tollsize }
+      list.concat(taillvm.op_reg_size_reg_size(op,reg2,fromsize,reg1,tosize));
+    end;
+
+
+  procedure thlcgllvm.gen_proc_symbol(list: TAsmList);
+    var
+      item: TCmdStrListItem;
+      mangledname: TSymStr;
+      asmsym: tasmsymbol;
+    begin
+      item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
+      mangledname:=current_procinfo.procdef.mangledname;
+      { predefine the real function name as local/global, so the aliases can
+        refer to the symbol and get the binding correct }
+      if (cs_profile in current_settings.moduleswitches) or
+         (po_global in current_procinfo.procdef.procoptions) then
+        asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_GLOBAL,AT_FUNCTION)
+      else
+        asmsym:=current_asmdata.DefineAsmSymbol(mangledname,AB_LOCAL,AT_FUNCTION);
+      while assigned(item) do
+        begin
+          if mangledname<>item.Str then
+            list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default));
+          item:=TCmdStrListItem(item.next);
+        end;
+      list.concat(taillvmdecl.create(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
+    end;
+
+
+  procedure thlcgllvm.gen_proc_symbol_end(list: TAsmList);
+    begin
+      list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
+      { todo: darwin main proc, or handle in other way? }
+    end;
+
+
+  procedure thlcgllvm.g_proc_entry(list: TAsmList; localsize: longint; nostackframe: boolean);
+    begin
+      list.concatlist(ttgllvm(tg).alloclist)
+      { rest: todo }
+    end;
+
+
+  procedure thlcgllvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
+    var
+      retdef: tdef;
+      retreg,
+      hreg: tregister;
+      retpara: tcgpara;
+    begin
+      { the function result type is the type of the first location, which can
+        differ from the real result type (e.g. int64 for a record consisting of
+        two longint fields on x86-64 -- we are responsible for lowering the
+        result types like that) }
+      retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
+      retpara.check_simple_location;
+      retdef:=retpara.location^.def;
+      if is_void(retdef) or
+         { don't check retdef here, it is e.g. a pshortstring in case it's
+           shortstring that's returned in a parameter }
+         paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
+        list.concat(taillvm.op_size(la_ret,voidtype))
+      else
+        begin
+          case retpara.location^.loc of
+            LOC_REGISTER,
+            LOC_FPUREGISTER,
+            LOC_MMREGISTER:
+              begin
+                { sign/zeroextension of function results is handled implicitly
+                  via the signext/zeroext modifiers of the result, rather than
+                  in the code generator -> remove any explicit extensions here }
+                retreg:=retpara.location^.register;
+                if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
+                   (retdef.typ in [orddef,enumdef]) then
+                  begin
+                    if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
+                      begin
+                        hreg:=getintregister(list,current_procinfo.procdef.returndef);
+                        a_load_reg_reg(list,retdef,current_procinfo.procdef.returndef,retreg,hreg);
+                        retreg:=hreg;
+                        retdef:=current_procinfo.procdef.returndef;
+                      end;
+                   end;
+                list.concat(taillvm.op_size_reg(la_ret,retdef,retreg))
+              end
+            else
+              { todo: complex returns }
+              internalerror(2012111106);
+          end;
+        end;
+      retpara.resetiftemp;
+    end;
+
+
+  procedure thlcgllvm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
+    begin
+      { not possible, need ovloc }
+      internalerror(2012111107);
+    end;
+
+
+  procedure thlcgllvm.g_overflowCheck_loc(List: TAsmList; const Loc: TLocation; def: TDef; var ovloc: tlocation);
+    begin
+      { todo }
+      internalerror(2012111108);
+    end;
+
+
+  procedure thlcgllvm.g_ptrtypecast_reg(list: TAsmList; fromdef, todef: tpointerdef; reg: tregister);
+    begin
+      { will insert a bitcast if necessary }
+      a_load_reg_reg(list,fromdef,todef,reg,reg);
+    end;
+
+
+  procedure thlcgllvm.g_ptrtypecast_ref(list: TAsmList; fromdef, todef: tpointerdef; var ref: treference);
+    var
+      hreg: tregister;
+    begin
+      hreg:=getaddressregister(list,todef);
+      a_loadaddr_ref_reg(list,fromdef.pointeddef,todef,ref,hreg);
+      reference_reset_base(ref,todef,hreg,0,ref.alignment);
+    end;
+
+
+  procedure thlcgllvm.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister; shuffle: pmmshuffle);
+    var
+      href: treference;
+    begin
+      if shuffle=mms_movescalar then
+        a_loadfpu_ref_reg(list,fromsize,tosize,ref,reg)
+      else
+        begin
+          { todo }
+          if fromsize<>tosize then
+            internalerror(2013060220);
+          href:=make_simple_ref(list,ref,fromsize);
+          { %reg = load size* %ref }
+          list.concat(taillvm.op_reg_size_ref(la_load,reg,getpointerdef(fromsize),href));
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference; shuffle: pmmshuffle);
+    var
+      href: treference;
+    begin
+      if shuffle=mms_movescalar then
+        a_loadfpu_reg_ref(list,fromsize,tosize,reg,ref)
+      else
+        begin
+          { todo }
+          if fromsize<>tosize then
+            internalerror(2013060220);
+          href:=make_simple_ref(list,ref,tosize);
+          { store tosize reg, tosize* href }
+          list.concat(taillvm.op_size_reg_size_ref(la_store,tosize,reg,getpointerdef(tosize),href))
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tdef; reg1, reg2: tregister; shuffle: pmmshuffle);
+    begin
+      if shuffle=mms_movescalar then
+        a_loadfpu_reg_reg(list,fromsize,tosize,reg1,reg2)
+      else
+        { reg2 = bitcast fromllsize reg1 to tollsize }
+        list.concat(taillvm.op_reg_size_reg_size(la_bitcast,reg2,fromsize,reg1,tosize));
+    end;
+
+
+  procedure thlcgllvm.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tdef; src, dst: tregister; shuffle: pmmshuffle);
+    begin
+      if (op=OP_XOR) and
+         (src=dst) then
+        a_load_const_reg(list,size,0,dst)
+      else
+        { todo }
+        internalerror(2013060221);
+    end;
+
+
+  procedure thlcgllvm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize: tdef; intreg, mmreg: tregister; shuffle: pmmshuffle);
+    begin
+      internalerror(2013060222);
+    end;
+
+
+  procedure thlcgllvm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize: tdef; mmreg, intreg: tregister; shuffle: pmmshuffle);
+    begin
+      internalerror(2013060223);
+    end;
+
+
+  function thlcgllvm.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
+    var
+      paraloc: pcgparalocation;
+    begin
+      result:=inherited;
+      { we'll change the paraloc, make sure we don't modify the original one }
+      if not result.temporary then
+        begin
+          result:=result.getcopy;
+          result.temporary:=true;
+        end;
+      { get the LLVM representation of the function result (e.g. a
+        struct with two i64 fields for a record with 4 i32 fields) }
+      result.def:=llvmgetcgparadef(result,false);
+      if assigned(result.location^.next) then
+        begin
+          { unify the result into a sinlge location; unlike for parameters,
+            we are not responsible for splitting up results into multiple
+            locations }
+          { set the first location to the type of the function result }
+          result.location^.def:=result.def;
+          result.location^.size:=result.size;
+          { free all extra paralocs }
+          while assigned(result.location^.next) do
+            begin
+              paraloc:=result.location^.next^.next;
+              freemem(result.location^.next);
+              result.location^.next:=paraloc;
+            end;
+        end;
+      paraloc:=result.location;
+      paraloc^.def:=result.def;
+      case paraloc^.loc of
+        LOC_VOID:
+          ;
+        LOC_REGISTER,
+        LOC_FPUREGISTER,
+        LOC_MMREGISTER:
+          begin
+            paraloc^.llvmloc.loc:=paraloc^.loc;
+            paraloc^.llvmloc.reg:=paraloc^.register;
+            paraloc^.llvmvalueloc:=true;
+          end;
+        LOC_REFERENCE:
+          if not paramanager.ret_in_param(pd.returndef,pd) then
+            { TODO, if this can happen at all }
+            internalerror(2014011901);
+        else
+          internalerror(2014011902);
+      end;
+    end;
+
+
+  procedure thlcgllvm.gen_load_loc_function_result(list: TAsmList; vardef: tdef; const l: tlocation);
+    begin
+      gen_load_loc_cgpara(list,vardef,l,get_call_result_cgpara(current_procinfo.procdef,nil));
+    end;
+
+
+  procedure thlcgllvm.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
+    var
+      memloc: tlocation;
+    begin
+      if not(cgpara.location^.llvmvalueloc) then
+        begin
+          memloc:=l;
+          location_force_mem(list,memloc,vardef);
+          a_loadaddr_ref_cgpara(list,vardef,memloc.reference,cgpara);
+        end
+      else
+        inherited;
+    end;
+
+
+  procedure thlcgllvm.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
+    var
+      ploc        : pcgparalocation;
+      hloc        : tlocation;
+      href, href2 : treference;
+      hreg        : tregister;
+      llvmparadef : tdef;
+      index       : longint;
+      offset      : pint;
+      userecord   : boolean;
+    begin
+      { ignore e.g. empty records }
+      if (para.location^.loc=LOC_VOID) then
+        exit;
+      { If the parameter location is reused we don't need to copy
+        anything }
+      if reusepara then
+        exit;
+      { get the equivalent llvm def used to pass the parameter (e.g. a record
+        with two int64 fields for passing a record consisiting of 8 bytes on
+        x86-64) }
+      llvmparadef:=llvmgetcgparadef(para,true);
+      userecord:=
+        (llvmparadef<>para.def) and
+        assigned(para.location^.next);
+      if userecord then
+        begin
+          { llvmparadef is a record in this case, with every field corresponding
+            to a single paraloc }
+          if destloc.loc<>LOC_REFERENCE then
+            tg.gethltemp(list,llvmparadef,llvmparadef.size,tt_normal,href)
+          else
+            begin
+              hreg:=getaddressregister(list,getpointerdef(llvmparadef));
+              a_loadaddr_ref_reg(list,vardef,getpointerdef(llvmparadef),destloc.reference,hreg);
+              reference_reset_base(href,getpointerdef(llvmparadef),hreg,0,destloc.reference.alignment);
+            end;
+          index:=0;
+          offset:=0;
+          ploc:=para.location;
+          repeat
+            paraloctoloc(ploc,hloc);
+            hreg:=getaddressregister(list,getpointerdef(ploc^.def));
+            list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,getpointerdef(llvmparadef),href,s32inttype,index,true));
+            reference_reset_base(href2,getpointerdef(ploc^.def),hreg,0,newalignment(href.alignment,offset));
+            a_load_loc_ref(list,ploc^.def,ploc^.def,hloc,href2);
+            inc(offset,ploc^.def.size);
+            inc(index);
+            ploc:=ploc^.next;
+          until not assigned(ploc);
+          if destloc.loc<>LOC_REFERENCE then
+            tg.ungettemp(list,href);
+        end
+      else
+        begin
+          para.check_simple_location;
+          paraloctoloc(para.location,hloc);
+          case destloc.loc of
+            LOC_REFERENCE :
+              begin
+                case def2regtyp(llvmparadef) of
+                  R_INTREGISTER,
+                  R_ADDRESSREGISTER:
+                    a_load_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference);
+                  R_FPUREGISTER:
+                    a_loadfpu_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference);
+                  R_MMREGISTER:
+                    a_loadmm_loc_ref(list,llvmparadef,para.def,hloc,destloc.reference,nil);
+                  else
+                    internalerror(2014080801);
+                  end;
+              end;
+            LOC_REGISTER:
+              begin
+                a_load_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
+              end;
+            LOC_FPUREGISTER:
+              begin
+                a_loadfpu_loc_reg(list,llvmparadef,para.def,hloc,destloc.register);
+              end;
+            LOC_MMREGISTER:
+              begin
+                a_loadmm_loc_reg(list,llvmparadef,para.def,hloc,destloc.register,nil);
+              end;
+            { TODO other possible locations }
+            else
+              internalerror(2013102304);
+          end;
+        end;
+    end;
+
+
+  procedure thlcgllvm.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel);
+    begin
+      internalerror(2013060224);
+    end;
+
+
+  procedure thlcgllvm.g_flags2reg(list: TAsmList; size: tdef; const f: tresflags; reg: TRegister);
+    begin
+      internalerror(2013060225);
+    end;
+
+
+  procedure thlcgllvm.g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref: TReference);
+    begin
+      internalerror(2013060226);
+    end;
+
+
+  procedure thlcgllvm.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tdef; src, dst: tregister);
+    begin
+      internalerror(2012090201);
+    end;
+
+
+  procedure thlcgllvm.g_stackpointer_alloc(list: TAsmList; size: longint);
+    begin
+      internalerror(2012090203);
+    end;
+
+
+  procedure thlcgllvm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    begin
+      internalerror(2012090204);
+    end;
+
+
+  procedure thlcgllvm.g_adjust_self_value(list: TAsmList; procdef: tprocdef; ioffset: aint);
+    begin
+      internalerror(2012090205);
+    end;
+
+
+  procedure thlcgllvm.g_local_unwind(list: TAsmList; l: TAsmLabel);
+    begin
+      internalerror(2012090206);
+    end;
+
+
+  function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
+    var
+      ptrindex: tcgint;
+      hreg1,
+      hreg2: tregister;
+      tmpref: treference;
+      defsize: asizeint;
+    begin
+      { already simple? }
+      if (not assigned(ref.symbol) or
+          (ref.base=NR_NO)) and
+         (ref.index=NR_NO) and
+         (ref.offset=0) then
+        begin
+          result:=ref;
+          exit;
+        end;
+
+      hreg2:=getaddressregister(list,getpointerdef(def));
+      defsize:=def.size;
+      { for voiddef/formaldef }
+      if defsize=0 then
+        defsize:=1;
+      { symbol+offset or base+offset with offset a multiple of the size ->
+        use getelementptr }
+      if (ref.index=NR_NO) and
+         (ref.offset mod defsize=0) then
+        begin
+          ptrindex:=ref.offset div defsize;
+          if assigned(ref.symbol) then
+            reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment)
+          else
+            reference_reset_base(tmpref,getpointerdef(def),ref.base,0,ref.alignment);
+          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg2,getpointerdef(def),tmpref,ptruinttype,ptrindex,assigned(ref.symbol)));
+          reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
+          exit;
+        end;
+      { for now, perform all calculations using plain pointer arithmetic. Later
+        we can look into optimizations based on getelementptr for structured
+        accesses (if only to prevent running out of virtual registers).
+
+        Assumptions:
+          * symbol/base register: always type "def*"
+          * index/offset: always type "ptruinttype" (llvm bitcode has no sign information, so sign doesn't matter) }
+      hreg1:=getintregister(list,ptruinttype);
+      if assigned(ref.symbol) then
+        begin
+          if ref.base<>NR_NO then
+            internalerror(2012111301);
+          reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment);
+          list.concat(taillvm.getelementptr_reg_size_ref_size_const(hreg1,getpointerdef(def),tmpref,ptruinttype,0,true));
+        end
+      else if ref.base<>NR_NO then
+        begin
+          a_load_reg_reg(list,getpointerdef(def),ptruinttype,ref.base,hreg1);
+        end
+      else
+        { todo: support for absolute addresses on embedded platforms }
+        internalerror(2012111302);
+      if ref.index<>NR_NO then
+        begin
+          { SSA... }
+          hreg2:=getintregister(list,ptruinttype);
+          a_op_reg_reg_reg(list,OP_ADD,ptruinttype,ref.index,hreg1,hreg2);
+          hreg1:=hreg2;
+        end;
+      if ref.offset<>0 then
+        begin
+          hreg2:=getintregister(list,ptruinttype);
+          a_op_const_reg_reg(list,OP_ADD,ptruinttype,ref.offset,hreg1,hreg2);
+          hreg1:=hreg2;
+        end;
+      a_load_reg_reg(list,ptruinttype,getpointerdef(def),hreg1,hreg2);
+      reference_reset_base(result,getpointerdef(def),hreg2,0,ref.alignment);
+    end;
+
+
+  procedure thlcgllvm.set_call_function_result(const list: TAsmList; const pd: tabstractprocdef; const llvmretdef, hlretdef: tdef; const resval: tregister; var retpara: tcgpara);
+    var
+      rettemp: treference;
+    begin
+      if not is_void(hlretdef) and
+         not paramanager.ret_in_param(hlretdef, pd) then
+        begin
+          { should already be a copy, because it currently describes the llvm
+            return location }
+          if not retpara.temporary then
+            internalerror(2014020101);
+          if llvmaggregatetype(hlretdef) then
+            begin
+              { to ease the handling of aggregate types here, we just store
+                everything to memory rather than potentially dealing with aggregates
+                in "registers" }
+              tg.gethltemp(list, hlretdef, hlretdef.size, tt_normal, rettemp);
+              a_load_reg_ref(list, llvmretdef, hlretdef, resval, rettemp);
+              { the return parameter now contains a value whose type matches the one
+                that the high level code generator expects instead of the llvm shim
+              }
+              retpara.def:=hlretdef;
+              retpara.location^.def:=hlretdef;
+              { for llvm-specific code:  }
+              retpara.location^.llvmvalueloc:=false;
+              retpara.location^.llvmloc.loc:=LOC_REGISTER;
+              retpara.location^.llvmloc.reg:=rettemp.base;
+              { for the rest (normally not used, but cleaner to set it correclty) }
+              retpara.location^.loc:=LOC_REFERENCE;
+              retpara.location^.reference.index:=rettemp.base;
+              retpara.location^.reference.offset:=0;
+            end
+          else
+            begin
+              retpara.Location^.llvmloc.loc:=retpara.location^.loc;
+              retpara.location^.llvmloc.reg:=resval;
+              retpara.Location^.llvmvalueloc:=true;
+            end;
+        end
+      else
+        retpara.location^.llvmloc.loc:=LOC_VOID;
+    end;
+
+
+  procedure thlcgllvm.paraloctoloc(const paraloc: pcgparalocation; out hloc: tlocation);
+    begin
+      case paraloc^.llvmloc.loc of
+        LOC_REFERENCE:
+          begin
+            location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
+            hloc.reference.symbol:=paraloc^.llvmloc.sym;
+            if paraloc^.llvmvalueloc then
+              hloc.reference.refaddr:=addr_full;
+          end;
+        LOC_REGISTER:
+          begin
+            if paraloc^.llvmvalueloc then
+              begin
+                location_reset(hloc,LOC_REGISTER,def_cgsize(paraloc^.def));
+                hloc.register:=paraloc^.llvmloc.reg;
+              end
+            else
+              begin
+                if getregtype(paraloc^.llvmloc.reg)<>R_TEMPREGISTER then
+                  internalerror(2014011903);
+                location_reset_ref(hloc,LOC_REFERENCE,def_cgsize(paraloc^.def),paraloc^.def.alignment);
+                hloc.reference.base:=paraloc^.llvmloc.reg;
+              end;
+          end;
+        LOC_FPUREGISTER,
+        LOC_MMREGISTER:
+          begin
+            if paraloc^.llvmvalueloc then
+              begin
+                location_reset(hloc,paraloc^.llvmloc.loc,def_cgsize(paraloc^.def));
+                hloc.register:=paraloc^.llvmloc.reg;
+              end
+            else
+              internalerror(2014012401);
+          end
+        else
+          internalerror(2014010706);
+      end;
+    end;
+
+
+  procedure thlcgllvm.varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym);
+    begin
+      if cs_asm_source in current_settings.globalswitches then
+        begin
+          case vs.initialloc.loc of
+            LOC_REFERENCE :
+              begin
+                if assigned(vs.initialloc.reference.symbol) then
+                  list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+
+                     vs.initialloc.reference.symbol.name)))
+                else
+                  list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at %tmp.'+
+                     tostr(getsupreg(vs.initialloc.reference.base)))));
+              end;
+          end;
+        end;
+      vs.localloc:=vs.initialloc;
+      FillChar(vs.currentregloc,sizeof(vs.currentregloc),0);
+    end;
+
+
+  procedure thlcgllvm.paravarsym_set_initialloc_to_paraloc(vs: tparavarsym);
+    var
+      parasym : tasmsymbol;
+    begin
+      if vs.paraloc[calleeside].location^.llvmloc.loc<>LOC_REFERENCE then
+        internalerror(2014010708);
+      parasym:=vs.paraloc[calleeside].location^.llvmloc.sym;
+      reference_reset_symbol(vs.initialloc.reference,parasym,0,vs.paraloc[calleeside].alignment);
+      if vs.paraloc[calleeside].location^.llvmvalueloc then
+        vs.initialloc.reference.refaddr:=addr_full;
+    end;
+
+
+  procedure create_hlcodegen;
+    begin
+      hlcg:=thlcgllvm.create;
+      cgllvm.create_codegen
+    end;
+
+begin
+  chlcgobj:=thlcgllvm;
+end.

compiler/llvm/itllvm.pas

@@ -0,0 +1,89 @@
+{
+    Copyright (c) 2013 by Jonas Maebe
+
+    This unit contains the LLVM instruction tables
+
+    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 itllvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      llvmbase, cgbase;
+
+    const
+      llvm_op2str : llvmop2strtable = ('',
+        { terminator instructions }
+        'ret', 'br', 'switch', 'indirectbr',
+        'invoke', 'resume',
+        'unreachable',
+        { binary operations }
+        'add', 'fadd', 'sub', 'fsub', 'mul', 'fmul',
+        'udiv','sdiv', 'fdiv', 'urem', 'srem', 'frem',
+        { bitwise binary operations }
+        'shl', 'lshr', 'ashr', 'and', 'or', 'xor',
+        { vector operations }
+        'extractelement', 'insertelement', 'shufflevector',
+        { aggregate operations }
+        'extractvalue', 'insertvalue',
+        { memory access and memory addressing operations }
+        'alloca',
+        'load', 'store',
+        'fence', 'cmpxchg', 'atomicrmw',
+        'getelementptr',
+        { conversion operations }
+        'trunc', 'zext', 'sext', 'fptrunc', 'fpext',
+        'fptoui', 'fptosi', 'uitofp', 'sitofp',
+        'ptrtoint', 'inttoptr',
+        'bitcast',
+        { other operations }
+        'icmp', 'fcmp',
+        'phi', 'select', 'call',
+        'va_arg', 'landingpad',
+        { fpc pseudo opcodes }
+        'type', { type definition }
+        'invalid1', { la_x_to_inttoptr }
+        'invalid2'  { la_ptrtoint_to_x }
+      );
+
+      llvm_cond2str : array[topcmp] of ansistring = ('',
+        'eq',
+        'sgt',
+        'slt',
+        'sge',
+        'sle',
+        'ne',
+        'ule',
+        'ult',
+        'uge',
+        'ugt'
+      );
+
+      llvm_fpcond2str: array[tllvmfpcmp] of ansistring = (
+      'invalid',
+      'false',
+      'oeq', 'ogt', 'oge', 'olt', 'ole', 'one', 'ord',
+      'ueq', 'ugt', 'uge', 'ult', 'ule', 'une', 'uno',
+      'true');
+
+
+implementation
+
+end.

compiler/llvm/llvmbase.pas

@@ -0,0 +1,188 @@
+{
+    Copyright (c) 2007-2008, 2013 by Jonas Maebe
+
+    Contains the base types for LLVM
+
+    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.
+
+ ****************************************************************************
+}
+{ This Unit contains the base types for LLVM
+}
+unit llvmbase;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    strings,globtype,
+    cutils,cclasses,aasmbase,cpubase,cpuinfo,cgbase;
+
+
+{*****************************************************************************
+                                Assembler Opcodes
+*****************************************************************************}
+
+  type
+    tllvmop = (la_none,
+      { terminator instructions }
+      la_ret, la_br, la_switch, la_indirectbr,
+      la_invoke, la_resume,
+      la_unreachable,
+      { binary operations }
+      la_add, la_fadd, la_sub, la_fsub, la_mul, la_fmul,
+      la_udiv,la_sdiv, la_fdiv, la_urem, la_srem, la_frem,
+      { bitwise binary operations }
+      la_shl, la_lshr, la_ashr, la_and, la_or, la_xor,
+      { vector operations }
+      la_extractelement, la_insertelement, la_shufflevector,
+      { aggregate operations }
+      la_extractvalue, la_insertvalue,
+      { memory access and memory addressing operations }
+      la_alloca,
+      la_load, la_store,
+      la_fence, la_cmpxchg, la_atomicrmw,
+      la_getelementptr,
+      { conversion operations }
+      la_trunc, la_zext, la_sext, la_fptrunc, la_fpext,
+      la_fptoui, la_fptosi, la_uitofp, la_sitofp,
+      la_ptrtoint, la_inttoptr,
+      la_bitcast,
+      { other operations }
+      la_icmp, la_fcmp,
+      la_phi, la_select, la_call,
+      la_va_arg, la_landingpad,
+      { fpc pseudo opcodes }
+      la_type, { type definition }
+      la_x_to_inttoptr, { have to convert something first to int before it can be converted to a pointer }
+      la_ptrtoint_to_x { have to convert a pointer first to int before it can be converted to something else }
+    );
+
+    tllvmvalueextension = (lve_none, lve_zeroext, lve_signext);
+
+  const
+    llvmterminatoropcodes = [la_ret, la_br, la_switch, la_indirectbr,
+      la_invoke, la_resume,
+      la_unreachable];
+
+    llvmvalueextension2str: array[tllvmvalueextension] of TSymStr = ('',
+      ' zeroext',' signext');
+
+
+  type
+    tllvmfpcmp = (
+      lfc_invalid,
+      lfc_false,
+      lfc_oeq, lfc_ogt, lfc_oge, lfc_olt, lfc_ole, lfc_one, lfc_ord,
+      lfc_ueq, lfc_ugt, lfc_uge, lfc_ult, lfc_ule, lfc_une, lfc_uno,
+      lfc_true);
+
+    {# This should define the array of instructions as string }
+    llvmop2strtable=array[tllvmop] of string[14];
+
+  const
+    { = max(cpubase.max_operands,7) }
+    max_operands = ((-ord(cpubase.max_operands<=7)) and 7) or ((-ord(cpubase.max_operands>7)) and cpubase.max_operands);
+
+  function llvm_target_name: ansistring;
+
+implementation
+
+  uses
+    globals,
+    systems;
+
+{$j-}
+  const
+    llvmsystemcpu: array[tsystemcpu] of ansistring =
+      ('unknown',
+       'i386',
+       'm68k',
+       'alpha',
+       'powerpc',
+       'sparc',
+       'unknown',
+       'ia64',
+       'x86_64',
+       'mips',
+       'arm',
+       'powerpc64',
+       'avr',
+       'mipsel',
+       'unknown',
+       'unknown',
+       'aarch64'
+      );
+
+  function llvm_target_name: ansistring;
+    begin
+      { architecture }
+{$ifdef arm}
+      llvm_target_name:=lower(cputypestr[current_settings.cputype]);
+{$else arm}
+      llvm_target_name:=llvmsystemcpu[target_info.cpu];
+{$endif}
+      { vendor and/or OS }
+      if target_info.system in systems_darwin then
+        begin
+          llvm_target_name:=llvm_target_name+'-apple';
+          if not(target_info.system in [system_arm_darwin,system_i386_iphonesim]) then
+            llvm_target_name:=llvm_target_name+'-macosx'+MacOSXVersionMin
+          else
+            llvm_target_name:=llvm_target_name+'-ios'+iPhoneOSVersionMin;
+        end
+      else if target_info.system in (systems_linux+systems_android) then
+        llvm_target_name:=llvm_target_name+'-linux'
+      else if target_info.system in systems_windows then
+        begin
+          { WinCE isn't supported (yet) by llvm, but if/when added this is
+            presumably how they will differentiate it }
+          if not(target_info.system in [system_i386_wince,system_arm_wince]) then
+            llvm_target_name:=llvm_target_name+'-pc';
+          llvm_target_name:=llvm_target_name+'-win32'
+        end
+      else if target_info.system in systems_freebsd then
+        llvm_target_name:=llvm_target_name+'-freebsd'
+      else if target_info.system in systems_openbsd then
+        llvm_target_name:=llvm_target_name+'-openbsd'
+      else if target_info.system in systems_netbsd then
+        llvm_target_name:=llvm_target_name+'-netbsd'
+      else if target_info.system in systems_aix then
+        llvm_target_name:=llvm_target_name+'-ibm-aix'
+      else if target_info.system in [system_i386_haiku] then
+        llvm_target_name:=llvm_target_name+'-haiku'
+      else if target_info.system in systems_embedded then
+        llvm_target_name:=llvm_target_name+'-none'
+      else
+        llvm_target_name:=llvm_target_name+'-unknown';
+
+      { environment/ABI }
+      if target_info.system in systems_android then
+        llvm_target_name:=llvm_target_name+'-android';
+{$if defined(FPC_ARMHF)}
+      llvm_target_name:=llvm_target_name+'-gnueabihf';
+{$elseif defined(FPC_ARMEL)}
+      if target_info.system in systems_embedded then
+        llvm_target_name:=llvm_target_name+'-eabi'
+      else if target_info.system=system_arm_android then
+        { handled above already
+        llvm_target_name:=llvm_target_name+'-android' }
+      else
+        llvm_target_name:=llvm_target_name+'-gnueabi';
+{$endif FPC_ARM_HF}
+    end;
+
+end.

compiler/llvm/llvmdef.pas

@@ -0,0 +1,723 @@
+{
+    Copyright (c) 2013 by Jonas Maebe
+
+    This unit implements some LLVM type helper routines.
+
+    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.
+
+ ****************************************************************************
+}
+
+{$i fpcdefs.inc}
+
+unit llvmdef;
+
+interface
+
+    uses
+      cclasses,globtype,
+      aasmbase,
+      parabase,
+      symbase,symtype,symdef,
+      llvmbase;
+
+   type
+     { there are three different circumstances in which procdefs are used:
+        a) definition of a procdef that's implemented in the current module or
+           declaration of an external routine that's called in the current one
+        b) alias declaration of a procdef implemented in the current module
+        c) defining a procvar type
+       The main differences between the contexts are:
+        a) information about sign extension of result type, proc name, parameter names & types
+        b) no information about sign extension of result type, proc name, no parameter names, parameter types
+        c) information about sign extension of result type, no proc name, no parameter names, parameter types
+      }
+     tllvmprocdefdecltype = (lpd_decl,lpd_alias,lpd_procvar);
+
+    { Encode a type into the internal format used by LLVM. }
+    function llvmencodetype(def: tdef): TSymStr;
+
+    { incremental version of llvmencodetype(). "inaggregate" indicates whether
+      this was a recursive call to get the type of an entity part of an
+      aggregate type (array, record, ...) }
+    procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr);
+
+    { encode a procdef/procvardef into the internal format used by LLVM }
+    function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr;
+    { incremental version of the above }
+    procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
+
+    { function result types may have to be represented differently, e.g. a
+      record consisting of 4 longints must be returned as a record consisting of
+      two int64's on x86-64. This function is used to create (and reuse)
+      temporary recorddefs for such purposes.}
+    function llvmgettemprecorddef(fieldtypes: tfplist; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+
+    { get the llvm type corresponding to a parameter, e.g. a record containing
+      two integer int64 for an arbitrary record split over two individual int64
+      parameters, or an int32 for an int16 parameter on a platform that requires
+      such parameters to be zero/sign extended. The second parameter can be used
+      to get the type before zero/sign extension, as e.g. required to generate
+      function declarations. }
+    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;
+
+    { can be used to extract the value extension info from acgpara. Pass in
+      the def of the cgpara as first parameter and a local variable holding
+      a copy of the def of the location (value extension only makes sense for
+      ordinal parameters that are smaller than a single location). The routine
+      will return the def of the location without sign extension (if applicable)
+      and the kind of sign extension that was originally performed in the
+      signext parameter }
+    procedure llvmextractvalueextinfo(paradef: tdef; var paralocdef: tdef; out signext: tllvmvalueextension);
+
+    { returns whether a paraloc should be translated into an llvm "byval"
+      parameter. These are declared as pointers to a particular type, but
+      usually turned into copies onto the stack. The exact behaviour for
+      parameters that should be passed in registers is undefined and depends on
+      the platform, and furthermore this modifier sometimes inhibits
+      optimizations.  As a result,we only use it for aggregate parameters of
+      which we know that they should be passed on the stack }
+    function llvmbyvalparaloc(paraloc: pcgparalocation): boolean;
+
+    { returns whether a def is representated by an aggregate type in llvm
+      (struct, array) }
+    function llvmaggregatetype(def: tdef): boolean;
+
+    function llvmconvop(fromsize, tosize: tdef): tllvmop;
+
+    { mangle a global identifier so that it's recognised by LLVM as a global
+      (in the sense of module-global) label and so that it won't mangle the
+      name further according to platform conventions (we already did that) }
+    function llvmmangledname(const s: TSymStr): TSymStr;
+
+    function llvmasmsymname(const sym: TAsmSymbol): TSymStr;
+
+
+implementation
+
+  uses
+    cutils,constexp,
+    verbose,systems,
+    fmodule,
+    symtable,symconst,symsym,
+    llvmsym,hlcgobj,
+    defutil,cgbase,paramgr;
+
+
+{******************************************************************
+                          Type encoding
+*******************************************************************}
+
+  function llvmaggregatetype(def: tdef): boolean;
+    begin
+      result:=
+        (def.typ in [recorddef,filedef,variantdef]) or
+        ((def.typ=arraydef) and
+         not is_dynamic_array(def)) or
+        ((def.typ=setdef) and
+         not is_smallset(def)) or
+        is_shortstring(def) or
+        is_object(def) or
+        ((def.typ=procvardef) and
+         not tprocvardef(def).is_addressonly)
+    end;
+
+
+  function llvmconvop(fromsize, tosize: tdef): tllvmop;
+    var
+      fromregtyp,
+      toregtyp: tregistertype;
+      frombytesize,
+      tobytesize: asizeint;
+    begin
+      fromregtyp:=chlcgobj.def2regtyp(fromsize);
+      toregtyp:=chlcgobj.def2regtyp(tosize);
+      { int to pointer or vice versa }
+      if fromregtyp=R_ADDRESSREGISTER then
+        begin
+          case toregtyp of
+            R_INTREGISTER:
+              result:=la_ptrtoint;
+            R_ADDRESSREGISTER:
+              result:=la_bitcast;
+            else
+              result:=la_ptrtoint_to_x;
+            end;
+        end
+      else if toregtyp=R_ADDRESSREGISTER then
+        begin
+          case fromregtyp of
+            R_INTREGISTER:
+              result:=la_inttoptr;
+            R_ADDRESSREGISTER:
+              result:=la_bitcast;
+            else
+              result:=la_x_to_inttoptr;
+            end;
+        end
+      else
+        begin
+          frombytesize:=fromsize.size;
+          tobytesize:=tosize.size;
+          { need zero/sign extension, float truncation or plain bitcast? }
+          if tobytesize<>frombytesize then
+            begin
+              case fromregtyp of
+                R_FPUREGISTER,
+                R_MMREGISTER:
+                  begin
+                    { todo: update once we support vectors }
+                    if not(toregtyp in [R_FPUREGISTER,R_MMREGISTER]) then
+                      internalerror(2014062203);
+                    if tobytesize<frombytesize then
+                      result:=la_fptrunc
+                    else
+                      result:=la_fpext
+                  end;
+                else
+                  begin
+                    if tobytesize<frombytesize then
+                      result:=la_trunc
+                    else if is_signed(fromsize) then
+                      { fromsize is signed -> sign extension }
+                      result:=la_sext
+                    else
+                      result:=la_zext;
+                  end;
+              end;
+            end
+          else
+            result:=la_bitcast;
+        end;
+    end;
+
+
+  function llvmmangledname(const s: TSymStr): TSymStr;
+    begin
+      result:='@"\01'+s+'"';
+    end;
+
+  function llvmasmsymname(const sym: TAsmSymbol): TSymStr;
+    begin
+      { AT_ADDR and AT_LABEL represent labels in the code, which have
+        a different type in llvm compared to (global) data labels }
+      if sym.bind=AB_TEMP then
+        result:='%'+sym.name
+      else if not(sym.typ in [AT_LABEL,AT_ADDR]) then
+        result:=llvmmangledname(sym.name)
+      else
+        result:='label %'+sym.name;
+    end;
+
+
+  function llvmbyvalparaloc(paraloc: pcgparalocation): boolean;
+    begin
+      { "byval" is broken for register paras on several platforms in llvm
+        (search for "byval" in llvm's bug tracker). Additionally, it should only
+        be used to pass aggregate parameters on the stack, because it reportedly
+        inhibits llvm's midlevel optimizers.
+
+        Exception (for now?): parameters that have special shifting
+          requirements, because modelling those in llvm is not easy (and clang
+          nor llvm-gcc seem to do so either) }
+      result:=
+        ((paraloc^.loc=LOC_REFERENCE) and
+         llvmaggregatetype(paraloc^.def)) or
+        (paraloc^.shiftval<>0)
+    end;
+
+
+    procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward;
+
+    procedure llvmaddencodedtype_intern(def: tdef; inaggregate, noimplicitderef: boolean; var encodedstr: TSymStr);
+      begin
+        case def.typ of
+          stringdef :
+            begin
+              case tstringdef(def).stringtype of
+                st_widestring,
+                st_unicodestring:
+                  { the variable does not point to the header, but to a
+                    null-terminated string/array with undefined bounds }
+                  encodedstr:=encodedstr+'i16*';
+                st_ansistring:
+                  encodedstr:=encodedstr+'i8*';
+                st_shortstring:
+                  { length byte followed by string bytes }
+                  if tstringdef(def).len>0 then
+                    encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+' x i8]'
+                  else
+                    encodedstr:=encodedstr+'[0 x i8]';
+                else
+                  internalerror(2013100201);
+              end;
+            end;
+          enumdef:
+            begin
+              encodedstr:=encodedstr+'i'+tostr(def.size*8);
+            end;
+          orddef :
+            begin
+              if is_void(def) then
+                encodedstr:=encodedstr+'void'
+              { mainly required because comparison operations return i1, and
+                otherwise we always have to immediatel extend them to i8 for
+                no good reason; besides, Pascal booleans can only contain 0
+                or 1 in valid code anyway (famous last words...) }
+              else if torddef(def).ordtype=pasbool8 then
+                encodedstr:=encodedstr+'i1'
+              else
+                encodedstr:=encodedstr+'i'+tostr(def.size*8);
+            end;
+          pointerdef :
+            begin
+              if is_voidpointer(def) then
+                encodedstr:=encodedstr+'i8*'
+              else
+                begin
+                  llvmaddencodedtype_intern(tpointerdef(def).pointeddef,inaggregate,false,encodedstr);
+                  encodedstr:=encodedstr+'*';
+                end;
+            end;
+          floatdef :
+            begin
+              case tfloatdef(def).floattype of
+                s32real:
+                  encodedstr:=encodedstr+'float';
+                s64real:
+                  encodedstr:=encodedstr+'double';
+                { necessary to be able to force our own size/alignment }
+                s80real:
+                  { prevent llvm from allocating the standard ABI size for
+                    extended }
+                  if inaggregate then
+                    encodedstr:=encodedstr+'[10 x i8]'
+                  else
+                    encodedstr:=encodedstr+'x86_fp80';
+                sc80real:
+                  encodedstr:=encodedstr+'x86_fp80';
+                s64comp,
+                s64currency:
+                  encodedstr:=encodedstr+'i64';
+                s128real:
+{$if defined(powerpc) or defined(powerpc128)}
+                  encodedstr:=encodedstr+'ppc_fp128';
+{$else}
+                  encodedstr:=encodedstr+'fp128';
+{$endif}
+                else
+                  internalerror(2013100202);
+              end;
+            end;
+          filedef :
+            begin
+              case tfiledef(def).filetyp of
+                ft_text    :
+                  llvmaddencodedtype_intern(search_system_type('TEXTREC').typedef,inaggregate,false,encodedstr);
+                ft_typed,
+                ft_untyped :
+                  llvmaddencodedtype_intern(search_system_type('FILEREC').typedef,inaggregate,false,encodedstr);
+                else
+                  internalerror(2013100203);
+              end;
+            end;
+          recorddef :
+            begin
+              llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr);
+            end;
+          variantdef :
+            begin
+              llvmaddencodedtype_intern(search_system_type('TVARDATA').typedef,inaggregate,false,encodedstr);
+            end;
+          classrefdef :
+            begin
+              { todo: define proper type for VMT and use that  }
+              encodedstr:=encodedstr+'i8*';
+            end;
+          setdef :
+            begin
+              { just an array as far as llvm is concerned; don't use a "packed
+                array of i1" or so, this requires special support in backends
+                and guarantees nothing about the internal format }
+              if is_smallset(def) then
+                llvmaddencodedtype_intern(cgsize_orddef(def_cgsize(def)),inaggregate,false,encodedstr)
+              else
+                encodedstr:=encodedstr+'['+tostr(tsetdef(def).size)+' x i8]';
+            end;
+          formaldef :
+            begin
+              { var/const/out x }
+              encodedstr:=encodedstr+'i8*';
+            end;
+          arraydef :
+            begin
+              if is_array_of_const(def) then
+                begin
+                  encodedstr:=encodedstr+'[0 x ';
+                  llvmaddencodedtype_intern(search_system_type('TVARREC').typedef,true,false,encodedstr);
+                  encodedstr:=encodedstr+']';
+                end
+              else if is_open_array(def) then
+                begin
+                  encodedstr:=encodedstr+'[0 x ';
+                  llvmaddencodedtype_intern(tarraydef(def).elementdef,true,false,encodedstr);
+                  encodedstr:=encodedstr+']';
+                end
+              else if is_dynamic_array(def) then
+                begin
+                  llvmaddencodedtype_intern(tarraydef(def).elementdef,inaggregate,false,encodedstr);
+                  encodedstr:=encodedstr+'*';
+                end
+              else if is_packed_array(def) then
+                begin
+                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div tarraydef(def).elementdef.packedbitsize)+' x ';
+                  { encode as an array of integers with the size on which we
+                    perform the packedbits operations }
+                  llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(packedbitsloadsize(tarraydef(def).elementdef.packedbitsize))),true,false,encodedstr);
+                  encodedstr:=encodedstr+']';
+                end
+              else
+                begin
+                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).elecount)+' x ';
+                  llvmaddencodedtype_intern(tarraydef(def).elementdef,true,false,encodedstr);
+                  encodedstr:=encodedstr+']';
+                end;
+            end;
+          procdef,
+          procvardef :
+            begin
+              if (def.typ=procdef) or
+                 tprocvardef(def).is_addressonly then
+                begin
+                  llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
+                  if def.typ=procvardef then
+                    encodedstr:=encodedstr+'*';
+                end
+              else
+                begin
+                  encodedstr:=encodedstr+'{';
+                  { code pointer }
+                  llvmaddencodedproctype(tabstractprocdef(def),'',lpd_procvar,encodedstr);
+                  { data pointer (maybe todo: generate actual layout if
+                    available) }
+                  encodedstr:=encodedstr+'*, i8*}';
+                end;
+            end;
+          objectdef :
+            case tobjectdef(def).objecttype of
+              odt_class,
+              odt_objcclass,
+              odt_object,
+              odt_cppclass:
+                begin
+                  { for now don't handle fields yet }
+                  encodedstr:=encodedstr+'{[i8 x '+tostr(def.size)+']}';
+                  if not noimplicitderef and
+                     is_implicit_pointer_object_type(def) then
+                    encodedstr:=encodedstr+'*'
+                end;
+              odt_interfacecom,
+              odt_interfacecom_function,
+              odt_interfacecom_property,
+              odt_interfacecorba,
+              odt_dispinterface,
+              odt_objcprotocol:
+                begin
+                  { opaque for now }
+                  encodedstr:=encodedstr+'i8*'
+                end;
+              else
+                internalerror(2013100601);
+            end;
+          undefineddef,
+          errordef :
+            internalerror(2013100604);
+        else
+          internalerror(2013100603);
+        end;
+      end;
+
+
+    procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr);
+      begin
+        llvmaddencodedtype_intern(def,inaggregate,false,encodedstr);
+      end;
+
+
+    procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr);
+      var
+        st: tllvmshadowsymtable;
+        symdeflist: tfpobjectlist;
+        i: longint;
+      begin
+        st:=tabstractrecordsymtable(def.symtable).llvmst;
+        symdeflist:=st.symdeflist;
+
+        if tabstractrecordsymtable(def.symtable).usefieldalignment<>C_alignment then
+          encodedstr:=encodedstr+'<';
+        encodedstr:=encodedstr+'{ ';
+        if symdeflist.count>0 then
+          begin
+            i:=0;
+            if (def.typ=objectdef) and
+               assigned(tobjectdef(def).childof) and
+               is_class_or_interface_or_dispinterface(tllvmshadowsymtableentry(symdeflist[0]).def) then
+              begin
+                { insert the struct for the class rather than a pointer to the struct }
+                if (tllvmshadowsymtableentry(symdeflist[0]).def.typ<>objectdef) then
+                  internalerror(2008070601);
+                llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[0]).def,true,true,encodedstr);
+                inc(i);
+              end;
+            while i<symdeflist.count do
+              begin
+                if i<>0 then
+                  encodedstr:=encodedstr+', ';
+                llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[i]).def,true,false,encodedstr);
+                inc(i);
+              end;
+          end;
+        encodedstr:=encodedstr+' }';
+        if tabstractrecordsymtable(def.symtable).usefieldalignment<>C_alignment then
+          encodedstr:=encodedstr+'>';
+      end;
+
+
+    procedure llvmextractvalueextinfo(paradef: tdef; var paralocdef: tdef; out signext: tllvmvalueextension);
+      begin
+        { implicit zero/sign extension for ABI compliance? (yes, if the size
+          of a paraloc is larger than the size of the entire parameter) }
+        if is_ordinal(paradef) and
+           is_ordinal(paralocdef) and
+           (paradef.size<paralocdef.size) then
+          begin
+            paralocdef:=paradef;
+            if is_signed(paradef) then
+              signext:=lve_signext
+            else
+              signext:=lve_zeroext
+          end
+        else
+          signext:=lve_none;
+      end;
+
+
+    procedure llvmaddencodedparaloctype(hp: tparavarsym; proccalloption: tproccalloption; withparaname: boolean; var first: boolean; var encodedstr: TSymStr);
+      var
+        paraloc: PCGParaLocation;
+        signext: tllvmvalueextension;
+        usedef: tdef;
+      begin
+        if (proccalloption in cdecl_pocalls) and
+           is_array_of_const(hp.vardef) then
+          begin
+            if not first then
+               encodedstr:=encodedstr+', '
+            else
+              first:=false;
+            encodedstr:=encodedstr+'...';
+            exit
+          end;
+        paraloc:=hp.paraloc[calleeside].location;
+        repeat
+          usedef:=paraloc^.def;
+          llvmextractvalueextinfo(hp.vardef,usedef,signext);
+          { implicit zero/sign extension for ABI compliance? }
+          if not first then
+             encodedstr:=encodedstr+', '
+          else
+            first:=false;
+          llvmaddencodedtype(usedef,false,encodedstr);
+          { in case signextstr<>'', there should be only one paraloc -> no need
+            to clear (reason: it means that the paraloc is larger than the
+            original parameter) }
+          encodedstr:=encodedstr+llvmvalueextension2str[signext];
+          { sret: hidden pointer for structured function result }
+          if vo_is_funcret in hp.varoptions then
+            encodedstr:=encodedstr+' sret'
+          else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and
+             llvmbyvalparaloc(paraloc) then
+            encodedstr:=encodedstr+'* byval';
+          if withparaname then
+            begin
+              if paraloc^.llvmloc.loc<>LOC_REFERENCE then
+                internalerror(2014010803);
+              encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
+            end;
+          paraloc:=paraloc^.next;
+        until not assigned(paraloc);
+      end;
+
+
+    function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr;
+      begin
+        result:='';
+        llvmaddencodedproctype(def,customname,pddecltype,result);
+      end;
+
+
+    procedure llvmaddencodedproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype; var encodedstr: TSymStr);
+      var
+        usedef: tdef;
+        paranr: longint;
+        hp: tparavarsym;
+        signext: tllvmvalueextension;
+        first: boolean;
+      begin
+        def.init_paraloc_info(calleeside);
+        first:=true;
+        { function result (return-by-ref is handled explicitly) }
+        if not paramanager.ret_in_param(def.returndef,def) then
+          begin
+            usedef:=llvmgetcgparadef(def.funcretloc[calleeside],false);
+            llvmextractvalueextinfo(def.returndef,usedef,signext);
+            { specifying result sign extention information for an alias causes
+              an error for some reason }
+            if pddecltype in [lpd_decl,lpd_procvar] then
+              encodedstr:=encodedstr+llvmvalueextension2str[signext];
+            encodedstr:=encodedstr+' ';
+            llvmaddencodedtype_intern(usedef,false,false,encodedstr);
+          end
+        else
+          begin
+            encodedstr:=encodedstr+' ';
+            llvmaddencodedtype(voidtype,false,encodedstr);
+          end;
+        encodedstr:=encodedstr+' ';
+        { add procname? }
+        if (pddecltype in [lpd_decl]) and
+           (def.typ=procdef) then
+          if customname='' then
+            encodedstr:=encodedstr+llvmmangledname(tprocdef(def).mangledname)
+          else
+            encodedstr:=encodedstr+llvmmangledname(customname);
+        encodedstr:=encodedstr+'(';
+        { parameters }
+        first:=true;
+        for paranr:=0 to def.paras.count-1 do
+          begin
+            hp:=tparavarsym(def.paras[paranr]);
+            llvmaddencodedparaloctype(hp,def.proccalloption,pddecltype in [lpd_decl],first,encodedstr);
+          end;
+        if po_varargs in def.procoptions then
+          begin
+            if not first then
+              encodedstr:=encodedstr+', ';
+            encodedstr:=encodedstr+'...';
+          end;
+        encodedstr:=encodedstr+')'
+      end;
+
+
+    function llvmgettemprecorddef(fieldtypes: tfplist; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
+      var
+        i: longint;
+        res: PHashSetItem;
+        oldsymtablestack: tsymtablestack;
+        hrecst: trecordsymtable;
+        hdef: tdef;
+        hrecdef: trecorddef;
+        sym: tfieldvarsym;
+        typename: string;
+      begin
+        typename:='$llvmstruct_';
+        for i:=0 to fieldtypes.count-1 do
+          begin
+            hdef:=tdef(fieldtypes[i]);
+            case hdef.typ of
+              orddef:
+                case torddef(hdef).ordtype of
+                  s8bit,
+                  u8bit:
+                    typename:=typename+'i8';
+                  s16bit,
+                  u16bit:
+                    typename:=typename+'i16';
+                  s32bit,
+                  u32bit:
+                    typename:=typename+'i32';
+                  s64bit,
+                  u64bit:
+                    typename:=typename+'i64';
+                  else
+                    { other types should not appear currently, add as needed }
+                    internalerror(2014012001);
+                end;
+              floatdef:
+                case tfloatdef(hdef).floattype of
+                  s32real:
+                    typename:=typename+'f32';
+                  s64real:
+                    typename:=typename+'f64';
+                  else
+                    { other types should not appear currently, add as needed }
+                    internalerror(2014012008);
+                  end;
+              else
+                { other types should not appear currently, add as needed }
+                internalerror(2014012009);
+            end;
+          end;
+        if not assigned(current_module) then
+          internalerror(2014012002);
+        res:=current_module.llvmdefs.FindOrAdd(@typename[1],length(typename));
+        if not assigned(res^.Data) then
+          begin
+            res^.Data:=crecorddef.create_global_internal(typename,packrecords,
+              recordalignmin,maxcrecordalign);
+            trecorddef(res^.Data).add_fields_from_deflist(fieldtypes);
+          end;
+        result:=trecorddef(res^.Data);
+      end;
+
+
+    function llvmgetcgparadef(const cgpara: tcgpara; beforevalueext: boolean): tdef;
+      var
+        retdeflist: tfplist;
+        retloc: pcgparalocation;
+        usedef: tdef;
+        valueext: tllvmvalueextension;
+      begin
+        { single location }
+        if not assigned(cgpara.location^.next) then
+          begin
+            { def of the location, except in case of zero/sign-extension }
+            usedef:=cgpara.location^.def;
+            if beforevalueext then
+              llvmextractvalueextinfo(cgpara.def,usedef,valueext);
+            result:=usedef;
+            exit
+          end;
+        { multiple locations -> create temp record }
+        retdeflist:=tfplist.create;
+        retloc:=cgpara.location;
+        repeat
+          retdeflist.add(retloc^.def);
+          retloc:=retloc^.next;
+        until not assigned(retloc);
+        result:=llvmgettemprecorddef(retdeflist,C_alignment,
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+      end;
+
+
+    function llvmencodetype(def: tdef): TSymStr;
+      begin
+        result:='';
+        llvmaddencodedtype(def,false,result);
+      end;
+
+
+end.

compiler/llvm/llvminfo.pas

@@ -0,0 +1,52 @@
+{
+    Copyright (c) 2010, 2013 by Jonas Maebe
+
+    Basic Processor information for LLVM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+Unit llvminfo;
+
+Interface
+
+  uses
+    globtype, cpubase;
+
+Type
+   { possible supported processors for this target }
+   tllvmcputype =
+      (llvmcpu_none,
+       { may add older/newer versions if required/appropriate }
+       llvmcpu_33
+      );
+
+
+Const
+
+   llvmcputypestr : array[tllvmcputype] of string[9] = ('',
+     'LLVM-3.3'
+   );
+
+   { Supported optimizations, only used for information }
+   supported_optimizerswitches = genericlevel1optimizerswitches+
+                                 genericlevel2optimizerswitches+
+                                 genericlevel3optimizerswitches-
+                                 { no need to write info about those }
+                                 [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
+                                 [cs_opt_loopunroll,cs_opt_nodecse];
+
+   level1optimizerswitches = genericlevel1optimizerswitches;
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_nodecse];
+   level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
+   level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
+
+Implementation
+
+end.

compiler/llvm/llvmnode.pas

@@ -0,0 +1,44 @@
+{******************************************************************************
+    Copyright (c) 2000-2010 by Florian Klaempfl and Jonas Maebe
+
+    Includes the LLVM code generator
+
+    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 llvmnode;
+
+{$I fpcdefs.inc}
+
+interface
+{ This unit is used to define the specific CPU implementations. All needed
+actions are included in the INITALIZATION part of these units. This explains
+the behaviour of such a unit having just a USES clause! }
+
+implementation
+
+    { always first include the target-specific unit, then the llvm one
+      to ensure that the llvm one is initialized later (-> overrides
+      settings)
+    }
+  uses
+    ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
+    ncgadd,ncgcal,ncgmat,ncginl,
+    tgllvm,hlcgllvm,
+    nllvmadd,nllvmcal,nllvmcnv,nllvmcon,nllvminl,nllvmld,nllvmmat,nllvmmem,
+    nllvmtcon,nllvmutil,
+    llvmpara;
+
+end.

compiler/llvm/llvmpara.pas

@@ -0,0 +1,220 @@
+{
+    Copyright (c) 2013 by Jonas Maebe
+
+    Includes the llvm parameter manager
+
+    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 llvmpara;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      globtype,aasmdata,
+      symconst,symtype,symdef,symsym,
+      parabase,
+      cpupara;
+
+    type
+      { LLVM stands for "low level code generator", and regarding parameter
+        handling it is indeed very low level. We are responsible for decomposing
+        aggregate parameters into multiple simple parameters in case they have
+        to be passed in special registers (such as floating point or SSE), and
+        also for indicating whether e.g. 8 bit parameters need to be sign or
+        zero exntended. This corresponds to pretty much what we do when creating
+        parameter locations, so we reuse the original parameter manager and then
+        process its output.
+
+        The future will tell whether we can do this without
+        architecture-specific code, or whether we will have to integrate parts
+        into the various tcpuparamanager classes }
+      tllvmparamanager = class(tcpuparamanager)
+        function param_use_paraloc(const cgpara: tcgpara): boolean; override;
+        procedure createtempparaloc(list: TAsmList; calloption: tproccalloption; parasym: tparavarsym; can_use_final_stack_loc: boolean; var cgpara: TCGPara); override;
+        function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
+        function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara; override;
+       private
+        procedure set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
+        procedure add_llvm_callee_paraloc_names(p: tabstractprocdef);
+      end;
+
+
+  implementation
+
+    uses
+      verbose,
+      aasmbase,
+      llvmsym,
+      paramgr,defutil,llvmdef,
+      cgbase,cgutils,tgobj,hlcgobj;
+
+  { tllvmparamanager }
+
+  function tllvmparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
+    begin
+      { we can use the paraloc on the callee side if the SSA property is
+        guaranteed, i.e., if it is a constant location (and if it's not been
+        split up into multiple locations for ABI reasons). We can't deduce that
+        from the paraloc though, we need the parasym for that. Potential
+        future optimisation, although llvm will probably optimise away the
+        temps we create anyway }
+      result:=false;
+    end;
+
+
+  procedure tllvmparamanager.createtempparaloc(list: TAsmList; calloption: tproccalloption; parasym: tparavarsym; can_use_final_stack_loc: boolean; var cgpara: TCGPara);
+    var
+      paraloc,
+      nextloc: pcgparalocation;
+    begin
+      inherited;
+      paraloc:=cgpara.location;
+      { No need to set paraloc^.llvmloc.*, these are not used/needed for temp
+        paralocs }
+      while assigned(paraloc) do
+        begin
+          { varargs parameters do not have a parasym.owner, but they're always
+            by value }
+          if (assigned(parasym.owner) and
+              paramanager.push_addr_param(parasym.varspez,parasym.vardef,tabstractprocdef(parasym.owner.defowner).proccalloption)) or
+             not llvmbyvalparaloc(paraloc) then
+            begin
+              case paraloc^.loc of
+                LOC_REFERENCE:
+                  begin
+                    case hlcg.def2regtyp(paraloc^.def) of
+                      R_INTREGISTER,
+                      R_ADDRESSREGISTER:
+                        paraloc^.loc:=LOC_REGISTER;
+                      R_FPUREGISTER:
+                        paraloc^.loc:=LOC_FPUREGISTER;
+                      R_MMREGISTER:
+                        paraloc^.Loc:=LOC_MMREGISTER;
+                      else
+                        internalerror(2013012308);
+                    end;
+                    paraloc^.register:=hlcg.getregisterfordef(list,paraloc^.def);
+                    paraloc^.llvmvalueloc:=true;
+                  end;
+                LOC_REGISTER,
+                LOC_FPUREGISTER,
+                LOC_MMREGISTER:
+                  begin
+                    paraloc^.llvmvalueloc:=true;
+                  end;
+                LOC_VOID:
+                  ;
+                else
+                  internalerror(2014012302);
+              end;
+            end
+          else
+            begin
+              { turn this paraloc into the "byval" parameter: at the llvm level,
+                a pointer to the value that it should place on the stack (or
+                passed in registers, in some cases) }
+              paraloc^.llvmvalueloc:=false;
+              paraloc^.def:=getpointerdef(paraloc^.def);
+              paraloc^.size:=def_cgsize(paraloc^.def);
+              paraloc^.loc:=LOC_REGISTER;
+              paraloc^.register:=hlcg.getaddressregister(list,paraloc^.def);
+              { remove all other paralocs }
+              nextloc:=paraloc^.next;
+              while assigned(nextloc) do
+                begin
+                  dispose(nextloc);
+                  nextloc:=paraloc^.next;
+                end;
+            end;
+          paraloc^.llvmloc.loc:=paraloc^.loc;
+          paraloc^.llvmloc.reg:=paraloc^.register;
+          paraloc:=paraloc^.next;
+        end;
+    end;
+
+
+  function tllvmparamanager.create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint;
+    begin
+      result:=inherited create_paraloc_info(p, side);
+      { on the calleeside, llvm declares the parameters similar to Pascal or C
+        (a list of parameters and their types), but they correspond more
+        closely to parameter locations than to parameters -> add names to the
+        locations }
+      if side=calleeside then
+        add_llvm_callee_paraloc_names(p)
+    end;
+
+
+  function tllvmparamanager.get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    var
+      paraloc: pcgparalocation;
+    begin
+      result:=inherited;
+      paraloc:=result.location;
+      repeat
+        paraloc^.llvmvalueloc:=true;
+        paraloc:=paraloc^.next;
+      until not assigned(paraloc);
+    end;
+
+
+  { hp non-nil: parasym to check
+    hp nil: function result
+  }
+  procedure tllvmparamanager.set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
+    var
+      paraloc: PCGParaLocation;
+      paralocnr: longint;
+    begin
+      paraloc:=hp.paraloc[calleeside].location;
+      paralocnr:=0;
+      repeat
+        paraloc^.llvmloc.loc:=LOC_REFERENCE;
+        paraloc^.llvmloc.sym:=current_asmdata.DefineAsmSymbol(llvmparaname(hp,paralocnr),AB_TEMP,AT_DATA);
+        { byval: a pointer to a type that should actually be passed by
+            value (e.g. a record that should be passed on the stack) }
+        paraloc^.llvmvalueloc:=
+          paramanager.push_addr_param(hp.varspez,hp.vardef,p.proccalloption) or
+          not llvmbyvalparaloc(paraloc);
+        paraloc:=paraloc^.next;
+        inc(paralocnr);
+      until not assigned(paraloc);
+    end;
+
+
+  procedure tllvmparamanager.add_llvm_callee_paraloc_names(p: tabstractprocdef);
+    var
+      paranr: longint;
+      hp: tparavarsym;
+    begin
+      for paranr:=0 to p.paras.count-1 do
+        begin
+          hp:=tparavarsym(p.paras[paranr]);
+          set_llvm_paraloc_name(p,hp,hp.paraloc[calleeside]);
+        end;
+    end;
+
+begin
+  { replace the native parameter manager. Maybe this has to be moved to a
+    procedure like the creations of the code generators, but possibly not since
+    we still call the original paramanager }
+  paramanager.free;
+  paramanager:=tllvmparamanager.create;
+end.
+

compiler/llvm/llvmsym.pas

@@ -0,0 +1,54 @@
+{
+    Copyright (c) 2013 by Jonas Maebe
+
+    This unit implements some LLVM symbol helper routines.
+
+    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.
+
+ ****************************************************************************
+}
+
+{$i fpcdefs.inc}
+
+unit llvmsym;
+
+interface
+
+  uses
+    globtype,
+    symbase,symtype,symsym;
+
+  function llvmparaname(sym: tparavarsym; paralocnr: longint): TSymStr;
+
+
+implementation
+
+  uses
+      cutils,
+      symconst;
+
+  function llvmparaname(sym: tparavarsym; paralocnr: longint): TSymStr;
+    begin
+      result:='p.'+sym.realname;
+      { use the same convention as llvm-gcc and clang: if an aggregate parameter
+        is split into multiple locations, suffix each part with '.coerce#' }
+      if assigned(sym.paraloc[calleeside].location^.next) then
+        result:=result+'.coerce'+tostr(paralocnr);
+    end;
+
+
+
+end.
+

compiler/llvm/llvmtarg.pas

@@ -0,0 +1,58 @@
+{
+    Copyright (c) 2001-2010, 2013 by Peter Vreman and Jonas Maebe
+
+    Includes the LLVM-dependent target units
+
+    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 llvmtarg;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+    uses
+      systems { prevent a syntax error when nothing is included }
+
+{$ifndef NOOPT}
+//      ,aoptcpu
+{$endif NOOPT}
+
+{**************************************
+             Targets
+**************************************}
+
+{**************************************
+             Assemblers
+**************************************}
+
+      ,agllvm
+
+{**************************************
+        Assembler Readers
+**************************************}
+
+{**************************************
+             Debuginfo
+**************************************}
+
+      ;
+
+end.

compiler/llvm/nllvmadd.pas

@@ -0,0 +1,298 @@
+{
+    Copyright (c) 2013 by Jonas Maebe
+
+    Generate LLVM bytecode for add nodes
+
+    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 nllvmadd;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,
+      ncgadd;
+
+    type
+      tllvmaddnode = class(tcgaddnode)
+       public
+        function pass_1: tnode; override;
+        procedure force_reg_left_right(allow_swap, allow_constant: boolean); override;
+       protected
+        procedure second_cmpsmallset; override;
+        procedure second_cmpordinal; override;
+        procedure second_add64bit; override;
+        procedure second_cmp64bit; override;
+        procedure second_addfloat; override;
+        procedure second_cmpfloat; override;
+      end;
+
+
+implementation
+
+     uses
+       verbose,globtype,
+       aasmdata,
+       symconst,symtype,symdef,defutil,
+       llvmbase,aasmllvm,
+       cgbase,cgutils,
+       hlcgobj,
+       nadd
+       ;
+
+{ tllvmaddnode }
+
+  function tllvmaddnode.pass_1: tnode;
+    begin
+      result:=inherited pass_1;
+      { there are no flags in LLVM }
+      if expectloc=LOC_FLAGS then
+        expectloc:=LOC_REGISTER;
+    end;
+
+
+  procedure tllvmaddnode.force_reg_left_right(allow_swap, allow_constant: boolean);
+    begin
+      inherited;
+      { pointer +/- integer -> make defs the same since a_op_* only gets a
+        single type as argument }
+      if (left.resultdef.typ=pointerdef)<>(right.resultdef.typ=pointerdef) then
+        begin
+          { the result is a pointerdef -> typecast both arguments to pointer;
+            a_op_*_reg will convert them back to integer as needed }
+          if left.resultdef.typ<>pointerdef then
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
+          if right.resultdef.typ<>pointerdef then
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,resultdef,true);
+        end;
+    end;
+
+
+  procedure tllvmaddnode.second_cmpsmallset;
+    var
+      tmpreg,
+      tmpreg2: tregister;
+      cmpop : topcmp;
+    begin
+      pass_left_right;
+
+      location_reset(location,LOC_REGISTER,OS_8);
+      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type);
+
+      force_reg_left_right(false,false);
+
+      case nodetype of
+        equaln,
+        unequaln:
+          begin
+            if nodetype=equaln then
+              cmpop:=OC_EQ
+            else
+              cmpop:=OC_NE;
+            current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,
+              location.register,cmpop,left.resultdef,left.location.register,right.location.register));
+          end;
+        lten,
+        gten:
+          begin
+            if (not(nf_swapped in flags) and
+                (nodetype = lten)) or
+               ((nf_swapped in flags) and
+                (nodetype = gten)) then
+              swapleftright;
+            { set1<=set2 <-> set2 and not(set1) = 0 }
+            tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
+            hlcg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,left.resultdef,left.location.register,tmpreg);
+            tmpreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
+            hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,left.resultdef,right.location.register,tmpreg,tmpreg2);
+            current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,
+              location.register,OC_EQ,left.resultdef,tmpreg2,0));
+          end;
+        else
+          internalerror(2012042701);
+      end;
+    end;
+
+
+  procedure tllvmaddnode.second_cmpordinal;
+    var
+      cmpop: topcmp;
+      unsigned : boolean;
+    begin
+      pass_left_right;
+      force_reg_left_right(true,true);
+
+      unsigned:=not(is_signed(left.resultdef)) or
+                not(is_signed(right.resultdef));
+
+      case nodetype of
+        ltn:
+          if unsigned then
+            cmpop:=OC_B
+          else
+            cmpop:=OC_LT;
+        lten:
+          if unsigned then
+            cmpop:=OC_BE
+          else
+            cmpop:=OC_LTE;
+        gtn:
+          if unsigned then
+            cmpop:=OC_A
+          else
+            cmpop:=OC_GT;
+        gten:
+          if unsigned then
+            cmpop:=OC_AE
+          else
+            cmpop:=OC_GTE;
+        equaln:
+          cmpop:=OC_EQ;
+        unequaln:
+          cmpop:=OC_NE;
+        else
+          internalerror(2015031505);
+      end;
+      if nf_swapped in flags then
+        cmpop:=swap_opcmp(cmpop);
+
+      location_reset(location,LOC_REGISTER,OS_8);
+      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+
+      if right.location.loc=LOC_CONSTANT then
+        current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,
+          location.register,cmpop,left.resultdef,left.location.register,right.location.value64))
+      else
+        current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,
+          location.register,cmpop,left.resultdef,left.location.register,right.location.register));
+    end;
+
+
+  procedure tllvmaddnode.second_add64bit;
+    begin
+      second_addordinal;
+    end;
+
+
+  procedure tllvmaddnode.second_cmp64bit;
+    begin
+      second_cmpordinal;
+    end;
+
+
+  procedure tllvmaddnode.second_addfloat;
+    var
+      op    : tllvmop;
+      llvmfpcmp : tllvmfpcmp;
+      size : tdef;
+      cmpop,
+      singleprec : boolean;
+    begin
+      pass_left_right;
+
+      cmpop:=false;
+      singleprec:=tfloatdef(left.resultdef).floattype=s32real;
+      { avoid uninitialised warning }
+      llvmfpcmp:=lfc_invalid;
+      case nodetype of
+        addn :
+          op:=la_fadd;
+        muln :
+          op:=la_fmul;
+        subn :
+          op:=la_fsub;
+        slashn :
+          op:=la_fdiv;
+        ltn,lten,gtn,gten,
+        equaln,unequaln :
+          begin
+            op:=la_fcmp;
+            cmpop:=true;
+            case nodetype of
+              ltn:
+                llvmfpcmp:=lfc_olt;
+              lten:
+                llvmfpcmp:=lfc_ole;
+              gtn:
+                llvmfpcmp:=lfc_ogt;
+              gten:
+                llvmfpcmp:=lfc_oge;
+              equaln:
+                llvmfpcmp:=lfc_oeq;
+              unequaln:
+                llvmfpcmp:=lfc_one;
+              else
+                internalerror(2015031506);
+            end;
+          end;
+        else
+          internalerror(2013102401);
+      end;
+
+      { get the operands in the correct order; there are no special cases here,
+        everything is register-based }
+      if nf_swapped in flags then
+        swapleftright;
+
+      { put both operands in a register }
+      hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
+      hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+
+      { initialize the result location }
+      if not cmpop then
+        begin
+          location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+          location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
+        end
+      else
+        begin
+          location_reset(location,LOC_REGISTER,OS_8);
+          location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+        end;
+
+      { see comment in thlcgllvm.a_loadfpu_ref_reg }
+      if tfloatdef(left.resultdef).floattype in [s64comp,s64currency] then
+        size:=sc80floattype
+      else
+        size:=left.resultdef;
+
+      { emit the actual operation }
+      if not cmpop then
+        begin
+          current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_reg_reg(op,location.register,size,
+            left.location.register,right.location.register))
+        end
+      else
+        begin
+          current_asmdata.CurrAsmList.concat(taillvm.op_reg_fpcond_size_reg_reg(op,
+            location.register,llvmfpcmp,size,left.location.register,right.location.register))
+        end;
+    end;
+
+
+  procedure tllvmaddnode.second_cmpfloat;
+    begin
+      second_addfloat;
+    end;
+
+
+begin
+  caddnode:=tllvmaddnode;
+end.
+

compiler/llvm/nllvmcal.pas

@@ -0,0 +1,84 @@
+{
+    Copyright (c) 2014 by Jonas Maebe
+
+    Generate LLVM bytecode for call nodes
+
+    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 nllvmcal;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      parabase,
+      ncgcal,
+      cgutils;
+
+    type
+      tllvmcallnode = class(tcgcallnode)
+       protected
+        function can_call_ref(var ref: treference): boolean; override;
+        procedure pushparas; override;
+      end;
+
+
+implementation
+
+     uses
+       verbose,
+       ncal;
+
+
+    function tllvmcallnode.can_call_ref(var ref: treference): boolean;
+      begin
+        result:=false;
+      end;
+
+
+    procedure tllvmcallnode.pushparas;
+      var
+        n: tcgcallparanode;
+        paraindex: longint;
+      begin
+        { we just pass the temp paralocs here }
+        if not assigned(varargsparas) then
+          setlength(paralocs,procdefinition.paras.count)
+        else
+          setlength(paralocs,procdefinition.paras.count+varargsparas.count);
+        n:=tcgcallparanode(left);
+        while assigned(n) do
+          begin
+            { TODO: check whether this is correct for left-to-right calling
+              conventions, may also depend on whether or not llvm knows about
+              the calling convention }
+            if not(cpf_varargs_para in n.callparaflags) then
+              paraindex:=procdefinition.paras.indexof(n.parasym)
+            else
+              paraindex:=procdefinition.paras.count+varargsparas.indexof(n.parasym);
+            if paraindex=-1 then
+             internalerror(2014010602);
+            paralocs[paraindex]:[email protected];
+            n:=tcgcallparanode(n.right);
+         end;
+      end;
+
+begin
+  ccallnode:=tllvmcallnode;
+end.
+

compiler/llvm/nllvmcnv.pas

@@ -0,0 +1,202 @@
+{
+    Copyright (c) 2014 by Jonas Maebe
+
+    Generate LLVM IR for type converting nodes
+
+    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 nllvmcnv;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,ncnv,ncgcnv,defcmp;
+
+    type
+       tllvmtypeconvnode = class(tcgtypeconvnode)
+         protected
+          function first_int_to_real: tnode; override;
+          function first_int_to_bool: tnode; override;
+          procedure second_int_to_int;override;
+         { procedure second_string_to_string;override; }
+         { procedure second_cstring_to_pchar;override; }
+         { procedure second_string_to_chararray;override; }
+         { procedure second_array_to_pointer;override; }
+         procedure second_pointer_to_array;override;
+         { procedure second_chararray_to_string;override; }
+         { procedure second_char_to_string;override; }
+         procedure second_int_to_real;override;
+         { procedure second_real_to_real;override; }
+         { procedure second_cord_to_pointer;override; }
+         { procedure second_proc_to_procvar;override; }
+         { procedure second_bool_to_int;override; }
+         procedure second_int_to_bool;override;
+         { procedure second_load_smallset;override;  }
+         { procedure second_ansistring_to_pchar;override; }
+         { procedure second_pchar_to_string;override; }
+         { procedure second_class_to_intf;override; }
+         { procedure second_char_to_char;override; }
+          procedure second_nothing; override;
+       end;
+
+implementation
+
+uses
+  globtype,globals,verbose,
+  aasmbase,aasmdata,
+  llvmbase,aasmllvm,
+  procinfo,
+  symconst,symdef,defutil,
+  cgbase,cgutils,hlcgobj,pass_2;
+
+{ tllvmtypeconvnode }
+
+function tllvmtypeconvnode.first_int_to_real: tnode;
+  begin
+    expectloc:=LOC_FPUREGISTER;
+    result:=nil;
+  end;
+
+
+function tllvmtypeconvnode.first_int_to_bool: tnode;
+  begin
+    result:=inherited;
+    if not assigned(result) then
+      expectloc:=LOC_JUMP;
+  end;
+
+
+procedure tllvmtypeconvnode.second_int_to_int;
+  var
+    fromsize, tosize: tcgint;
+    hreg: tregister;
+  begin
+    if not(nf_explicit in flags) then
+      hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);
+    fromsize:=left.resultdef.size;
+    tosize:=resultdef.size;
+    location_copy(location,left.location);
+    if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) or
+       (fromsize<>tosize) then
+      begin
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,left.location.loc=LOC_CREGISTER);
+      end
+    else if left.resultdef<>resultdef then
+      begin
+        { just typecast the pointer type }
+        hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+        hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,getpointerdef(resultdef),left.location.reference,hreg);
+        hlcg.reference_reset_base(location.reference,getpointerdef(resultdef),hreg,0,location.reference.alignment);
+      end;
+  end;
+
+
+procedure tllvmtypeconvnode.second_pointer_to_array;
+  var
+    hreg: tregister;
+  begin
+    inherited;
+    { insert type conversion }
+    hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+    hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,tpointerdef(left.resultdef).pointeddef,getpointerdef(resultdef),location.reference,hreg);
+    reference_reset_base(location.reference,hreg,0,location.reference.alignment);
+  end;
+
+
+procedure tllvmtypeconvnode.second_int_to_real;
+  var
+    op: tllvmop;
+  begin
+    if is_signed(left.resultdef) then
+      op:=la_sitofp
+    else
+      op:=la_uitofp;
+    location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+    location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
+    hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+    current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_reg_size(op,location.register,left.resultdef,left.location.register,resultdef));
+  end;
+
+
+procedure tllvmtypeconvnode.second_int_to_bool;
+  var
+    newsize  : tcgsize;
+  begin
+    secondpass(left);
+    if codegenerror then
+      exit;
+
+    { Explicit typecasts from any ordinal type to a boolean type }
+    { must not change the ordinal value                          }
+    if (nf_explicit in flags) and
+       not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
+      begin
+         location_copy(location,left.location);
+         newsize:=def_cgsize(resultdef);
+         { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
+         if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
+            ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
+           hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
+         else
+           location.size:=newsize;
+         exit;
+      end;
+
+    location_reset(location,LOC_JUMP,OS_NO);
+    case left.location.loc of
+      LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF,
+      LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
+        begin
+          hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,current_procinfo.CurrFalseLabel);
+          hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
+        end;
+      LOC_JUMP :
+        begin
+          { nothing to do, jumps already go to the right labels }
+        end;
+      else
+        internalerror(10062);
+    end;
+  end;
+
+
+procedure tllvmtypeconvnode.second_nothing;
+  var
+    hreg: tregister;
+  begin
+    if left.resultdef<>resultdef then
+      begin
+        { handle sometype(voidptr^) }
+        if not is_void(left.resultdef) and
+           (left.resultdef.typ<>formaldef) and
+          (left.resultdef.size<>resultdef.size) then
+          internalerror(2014012216);
+        hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
+        hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+        hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,getpointerdef(resultdef),left.location.reference,hreg);
+        location_reset_ref(location,left.location.loc,left.location.size,left.location.reference.alignment);
+        reference_reset_base(location.reference,hreg,0,location.reference.alignment);
+      end
+    else
+      location_copy(location,left.location);
+  end;
+
+begin
+  ctypeconvnode:=tllvmtypeconvnode;
+end.

compiler/llvm/nllvmcon.pas

@@ -0,0 +1,173 @@
+{
+    Copyright (c) 2013 by Jonas Maebe, member of the Free Pascal Compiler
+    development team
+
+    Generate llvm bitcode for constants
+
+    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 nllvmcon;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      symtype,
+      node,ncgcon;
+
+    type
+       tllvmrealconstnode = class(tcgrealconstnode)
+          function pass_1 : tnode;override;
+          procedure pass_generate_code;override;
+       end;
+
+       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,globals,verbose,cutils,
+      symbase,symtable,symconst,symdef,symsym,defutil,
+      aasmdata,aasmcnst,
+      ncon,
+      llvmbase,aasmllvm,hlcgobj,
+      cgbase,cgutils;
+
+{*****************************************************************************
+                           tllvmstringconstnode
+*****************************************************************************}
+
+    procedure tllvmstringconstnode.pass_generate_code;
+      var
+        datadef, resptrdef: tdef;
+        hreg: tregister;
+      begin
+        inherited pass_generate_code;
+        if cst_type in [cst_conststring,cst_shortstring] then
+          begin
+            if location.loc<>LOC_CREFERENCE then
+              internalerror(2014071202);
+            case cst_type of
+              cst_conststring:
+                { this kind of string const is used both for array of char
+                  constants (-> excludes terminating #0) and pchars (-> includes
+                  terminating #0). The resultdef excludes the #0 while the data
+                  includes it -> insert typecast from datadef to resultdef }
+                datadef:=getarraydef(cansichartype,len+1);
+              cst_shortstring:
+                { the resultdef of the string constant is the type of the
+                  string to which it is assigned, which can be longer or shorter
+                  than the length of the string itself -> typecast it to the
+                  correct string type }
+                datadef:=getarraydef(cansichartype,min(len,255)+1);
+              else
+                internalerror(2014071203);
+            end;
+            { get address of array as pchar }
+            resptrdef:=getpointerdef(resultdef);
+            hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resptrdef);
+            hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,datadef,resptrdef,location.reference,hreg);
+            hlcg.reference_reset_base(location.reference,resptrdef,hreg,0,location.reference.alignment);
+          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
+*****************************************************************************}
+
+    function tllvmrealconstnode.pass_1 : tnode;
+      begin
+         result:=nil;
+         expectloc:=LOC_FPUREGISTER;
+      end;
+
+
+    procedure tllvmrealconstnode.pass_generate_code;
+      begin
+         { llvm supports floating point constants directly }
+         location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+         location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);
+         case tfloatdef(resultdef).floattype of
+           s32real,s64real:
+             current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_fpconst_size(la_bitcast,location.register,resultdef,value_real,resultdef));
+           { comp and currency are handled as int64 at the llvm level }
+           s64comp,
+           s64currency:
+             { sc80floattype instead of resultdef, see comment in thlcgllvm.a_loadfpu_ref_reg }
+             current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_const_size(la_sitofp,location.register,s64inttype,trunc(value_real),sc80floattype));
+{$ifdef cpuextended}
+           s80real,sc80real:
+             current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_fpconst80_size(la_bitcast,location.register,resultdef,value_real,resultdef));
+{$endif cpuextended}
+           else
+             internalerror(2013102501);
+         end;
+      end;
+
+
+begin
+   cstringconstnode:=tllvmstringconstnode;
+   crealconstnode:=tllvmrealconstnode;
+end.

compiler/llvm/nllvminl.pas

@@ -0,0 +1,107 @@
+{
+    Copyright (c) 2014 by Jonas Maebe
+
+    Generate LLVM bytecode for inline nodes
+
+    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 nllvminl;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      ncginl;
+
+    type
+      tllvminlinenode = class(tcginlinenode)
+        procedure second_length; override;
+      end;
+
+
+implementation
+
+     uses
+       verbose,globtype,
+       aasmbase, aasmdata,
+       symtype,symdef,defutil,
+       ninl,
+       pass_2,
+       cgbase,cgutils,tgobj,hlcgobj;
+
+
+    procedure tllvminlinenode.second_length;
+      var
+        lengthlab, nillab: tasmlabel;
+        hregister: tregister;
+        href, tempref: treference;
+        lendef: tdef;
+      begin
+        secondpass(left);
+        if is_shortstring(left.resultdef) then
+         begin
+            if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+              internalerror(2014080806);
+           { typecast the shortstring reference into a length byte reference }
+           location_reset_ref(location,left.location.loc,def_cgsize(resultdef),left.location.reference.alignment);
+           hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+           hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,getpointerdef(resultdef),left.location.reference,hregister);
+           hlcg.reference_reset_base(location.reference,getpointerdef(resultdef),hregister,0,left.location.reference.alignment);
+         end
+        else
+         begin
+           tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,tempref);
+           { length in ansi/wide strings and high in dynamic arrays is at offset
+             -sizeof(sizeint), for widestrings it's at -4 }
+           if is_widestring(left.resultdef) then
+             lendef:=u32inttype
+           else
+             lendef:=ossinttype;
+           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,
+             left.resultdef,getpointerdef(lendef),true);
+           current_asmdata.getjumplabel(nillab);
+           current_asmdata.getjumplabel(lengthlab);
+           hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,getpointerdef(lendef),OC_EQ,0,left.location.register,nillab);
+           hlcg.reference_reset_base(href,getpointerdef(lendef),left.location.register,-lendef.size,lendef.alignment);
+           hregister:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+           hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,lendef,resultdef,href,hregister);
+           if is_widestring(left.resultdef) then
+             hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,resultdef,1,hregister);
+
+           { Dynamic arrays do not have their length attached but their maximum index }
+           if is_dynamic_array(left.resultdef) then
+             hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,1,hregister);
+           hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,resultdef,resultdef,hregister,tempref);
+           hlcg.a_jmp_always(current_asmdata.CurrAsmList,lengthlab);
+
+           hlcg.a_label(current_asmdata.CurrAsmList,nillab);
+           hlcg.a_load_const_ref(current_asmdata.CurrAsmList,resultdef,0,tempref);
+
+           hlcg.a_label(current_asmdata.CurrAsmList,lengthlab);
+           hregister:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+           hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,tempref,hregister);
+           tg.ungettemp(current_asmdata.CurrAsmList,tempref);
+           location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+           location.register:=hregister;
+         end;
+      end;
+
+begin
+  cinlinenode:=tllvminlinenode;
+end.
+

compiler/llvm/nllvmld.pas

@@ -0,0 +1,44 @@
+{
+    Copyright (c) 2012 by Jonas Maebe
+
+    Generate LLVM bytecode for nodes that handle loads and assignments
+
+    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 nllvmld;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      ncgnstld;
+
+    type
+      tllvmloadnode = class(tcgnestloadnode)
+      end;
+
+
+implementation
+
+     uses
+       nld;
+
+begin
+  cloadnode:=tllvmloadnode;
+end.
+

compiler/llvm/nllvmmat.pas

@@ -0,0 +1,123 @@
+{
+    Copyright (c) 2014 Jonas Maebe
+
+    Generate LLVM IR for math nodes
+
+    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 nllvmmat;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,
+  node, nmat, ncgmat, ncghlmat, cgbase;
+
+type
+  tllvmmoddivnode = class(tcgmoddivnode)
+    procedure pass_generate_code; override;
+  end;
+
+  Tllvmunaryminusnode = class(tcgunaryminusnode)
+    procedure emit_float_sign_change(r: tregister; _size : tdef);override;
+  end;
+
+  tllvmnotnode = class(tcghlnotnode)
+  end;
+
+implementation
+
+uses
+  globtype, systems,
+  cutils, verbose, globals,
+  symconst, symdef,
+  aasmbase, aasmllvm, aasmtai, aasmdata,
+  defutil,
+  procinfo,
+  hlcgobj, pass_2,
+  ncon,
+  llvmbase,
+  ncgutil, cgutils;
+
+{*****************************************************************************
+                               tllvmmoddivnode
+*****************************************************************************}
+
+procedure tllvmmoddivnode.pass_generate_code;
+  var
+    op: tllvmop;
+  begin
+    secondpass(left);
+    secondpass(right);
+    if is_signed(left.resultdef) then
+      if nodetype=divn then
+        op:=la_sdiv
+      else
+        op:=la_srem
+    else if nodetype=divn then
+      op:=la_udiv
+    else
+      op:=la_urem;
+    hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
+    if right.location.loc<>LOC_CONSTANT then
+      hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,resultdef,true);
+    location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+    location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+    if right.location.loc=LOC_CONSTANT then
+      current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_reg_const(op,location.register,resultdef,left.location.register,right.location.value))
+    else
+      current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_reg_reg(op,location.register,resultdef,left.location.register,right.location.register))
+  end;
+
+{*****************************************************************************
+                               Tllvmunaryminusnode
+*****************************************************************************}
+
+procedure Tllvmunaryminusnode.emit_float_sign_change(r: tregister; _size : tdef);
+var
+  zeroreg: tregister;
+begin
+  if _size.typ<>floatdef then
+    internalerror(2014012212);
+  zeroreg:=hlcg.getfpuregister(current_asmdata.CurrAsmList,_size);
+  case tfloatdef(_size).floattype of
+    s32real,s64real:
+      current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_fpconst_size(la_bitcast,zeroreg,_size,0,_size));
+    { comp and currency are handled as int64 at the llvm level }
+    s64comp,
+    s64currency:
+      { sc80floattype instead of _size, see comment in thlcgllvm.a_loadfpu_ref_reg }
+      current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_const_size(la_sitofp,zeroreg,s64inttype,0,sc80floattype));
+{$ifdef cpuextended}
+    s80real,sc80real:
+      current_asmdata.CurrAsmList.concat(taillvm.op_reg_size_fpconst80_size(la_bitcast,zeroreg,_size,0.0,_size));
+{$endif cpuextended}
+  end;
+  current_asmdata.CurrAsmList.Concat(taillvm.op_reg_size_reg_reg(la_fsub,r,_size,zeroreg,r));
+end;
+
+
+begin
+  cmoddivnode := tllvmmoddivnode;
+(*
+  cshlshrnode := tllvmshlshrnode;
+*)
+  cnotnode    := tllvmnotnode;
+  cunaryminusnode := Tllvmunaryminusnode;
+end.

compiler/llvm/nllvmmem.pas

@@ -0,0 +1,273 @@
+{
+    Copyright (c) 2012 by Jonas Maebe
+
+    Generate LLVM byetcode for in memory related nodes
+
+    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 nllvmmem;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,
+      cgbase,cgutils,
+      symtype,
+      node,ncgnstmm, ncgmem;
+
+    type
+      tllvmloadparentfpnode = class(tcgnestloadparentfpnode)
+      end;
+
+      tllvmsubscriptnode = class(tcgsubscriptnode)
+       protected
+        function handle_platform_subscript: boolean; override;
+      end;
+
+      tllvmvecnode= class(tcgvecnode)
+       private
+        constarrayoffset: aint;
+        arraytopointerconverted: boolean;
+       public
+        procedure pass_generate_code; override;
+        procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); override;
+        procedure update_reference_reg_packed(maybe_const_reg: tregister; regsize: tdef; l: aint); override;
+        procedure update_reference_offset(var ref: treference; index, mulsize: aint); override;
+      end;
+
+
+implementation
+
+    uses
+      verbose,cutils,
+      aasmdata,aasmllvm,
+      symtable,symconst,symdef,defutil,
+      nmem,
+      cpubase,llvmbase,hlcgobj;
+
+  { tllvmsubscriptnode }
+
+    function tllvmsubscriptnode.handle_platform_subscript: boolean;
+      var
+        llvmfielddef: tdef;
+        newbase: tregister;
+      begin
+        if not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+          internalerror(2014011905);
+        if is_packed_record_or_object(left.resultdef) then
+          begin
+            { typecast the result to the expected type, but don't actually index
+              (that still has to be done by the generic code, so return false) }
+            newbase:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+            hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,getpointerdef(resultdef),location.reference,newbase);
+            reference_reset_base(location.reference,newbase,0,location.reference.alignment);
+            result:=false;
+          end
+        else
+          begin
+            { get the type of the corresponding field in the llvm shadow
+              definition }
+            llvmfielddef:=tabstractrecordsymtable(tabstractrecorddef(left.resultdef).symtable).llvmst[vs.llvmfieldnr].def;
+            { load the address of that shadow field }
+            newbase:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(llvmfielddef));
+            current_asmdata.CurrAsmList.concat(taillvm.getelementptr_reg_size_ref_size_const(newbase,getpointerdef(left.resultdef),location.reference,s32inttype,vs.llvmfieldnr,true));
+            reference_reset_base(location.reference,newbase,vs.offsetfromllvmfield,newalignment(location.reference.alignment,vs.fieldoffset));
+            { if it doesn't match the requested field exactly (variant record),
+              adjust the type of the pointer }
+            if (vs.offsetfromllvmfield<>0) or
+               (llvmfielddef<>resultdef) then
+              begin
+                newbase:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+                hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,getpointerdef(llvmfielddef),getpointerdef(resultdef),location.reference.base,newbase);
+                location.reference.base:=newbase;
+              end;
+            location.size:=def_cgsize(resultdef);
+            result:=true;
+          end;
+      end;
+
+  { tllvmvecnode }
+
+  procedure tllvmvecnode.pass_generate_code;
+    var
+      locref: preference;
+      hreg: tregister;
+      arrptrelementdef: tdef;
+
+    procedure getarrelementptrdef;
+      begin
+        if assigned(locref) then
+          exit;
+        case location.loc of
+          LOC_SUBSETREF,LOC_CSUBSETREF:
+            locref:[email protected];
+          LOC_REFERENCE,LOC_CREFERENCE:
+            locref:[email protected];
+          else
+            internalerror(2013111001);
+        end;
+        { special handling for s80real: inside aggregates (such as arrays) it's
+          declared as an array of 10 bytes in order to force the allocation of
+          the right size (llvm only supports s80real according to the ABI size/
+          alignment) -> convert the pointer to this array into a pointer to the
+          s80real type (loads from and stores to this type will always only store
+          10 bytes) }
+        if (resultdef.typ=floatdef) and
+           (tfloatdef(resultdef).floattype=s80real) then
+          arrptrelementdef:=getpointerdef(getarraydef(u8inttype,10))
+        else
+          arrptrelementdef:=getpointerdef(resultdef);
+      end;
+
+    begin
+      inherited;
+      locref:=nil;
+      if not arraytopointerconverted then
+        begin
+          { avoid uninitialised warning }
+          arrptrelementdef:=nil;
+          { the result is currently a pointer to left.resultdef (the array type)
+             -> convert it into a pointer to an element inside this array }
+          getarrelementptrdef;
+          hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,arrptrelementdef);
+          current_asmdata.CurrAsmList.Concat(taillvm.getelementptr_reg_size_ref_size_const(hreg,getpointerdef(left.resultdef),
+            locref^,ptruinttype,constarrayoffset,true));
+          reference_reset_base(locref^,hreg,0,locref^.alignment);
+        end;
+
+      { see comment in getarrelementptrdef }
+      if (resultdef.typ=floatdef) and
+         (tfloatdef(resultdef).floattype=s80real) then
+       begin
+         if not assigned(locref) then
+           begin
+             { avoid uninitialised warning }
+             arrptrelementdef:=nil;
+             getarrelementptrdef;
+           end;
+         hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+         hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,arrptrelementdef,getpointerdef(resultdef),locref^.base,hreg);
+         locref^.base:=hreg;
+       end;
+    end;
+
+
+  procedure tllvmvecnode.update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint);
+    var
+      hreg: tregister;
+    begin
+      if l<>resultdef.size then
+        internalerror(2013102602);
+      if constarrayoffset<>0 then
+        begin
+          hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+          hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_ADD,ptruinttype,constarrayoffset,maybe_const_reg,hreg);
+          maybe_const_reg:=hreg;
+        end;
+      hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(resultdef));
+      { get address of indexed array element and convert pointer to array into
+        pointer to the elementdef in the process }
+      current_asmdata.CurrAsmList.Concat(taillvm.getelementptr_reg_size_ref_size_reg(hreg,getpointerdef(left.resultdef),
+        location.reference,ptruinttype,maybe_const_reg,true));
+      arraytopointerconverted:=true;
+      reference_reset_base(location.reference,hreg,0,location.reference.alignment);
+      location.reference.alignment:=newalignment(location.reference.alignment,l);
+    end;
+
+
+  procedure tllvmvecnode.update_reference_reg_packed(maybe_const_reg: tregister; regsize: tdef; l: aint);
+    var
+      sref: tsubsetreference;
+      offsetreg, basereg, hreg, hreg2: tregister;
+      alignpower: aint;
+      temp, intloadsize : longint;
+      defloadsize: tdef;
+    begin
+      { only orddefs are bitpacked. Even then we only need special code in }
+      { case the bitpacked *byte size* is not a power of two, otherwise    }
+      { everything can be handled using the the regular array code.        }
+      if ((l mod 8) = 0) and
+         (ispowerof2(l div 8,temp) or
+          not is_ordinal(resultdef)
+{$ifndef cpu64bitalu}
+          or is_64bitint(resultdef)
+{$endif not cpu64bitalu}
+          ) then
+        begin
+          update_reference_reg_mul(maybe_const_reg,regsize,l div 8);
+          exit;
+        end;
+      if (l>8*sizeof(aint)) then
+        internalerror(200608051);
+
+      { adjust the index by subtracting the lower bound of the array and adding
+        any constant adjustments }
+      sref.ref:=location.reference;
+      hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,ptruinttype,tarraydef(left.resultdef).lowrange-constarrayoffset,maybe_const_reg,hreg);
+
+      { keep alignment for index }
+      sref.ref.alignment:=left.resultdef.alignment;
+      intloadsize:=packedbitsloadsize(l);
+      if not ispowerof2(intloadsize,temp) then
+        internalerror(2006081201);
+      defloadsize:=cgsize_orddef(int_cgsize(intloadsize));
+      alignpower:=temp;
+      { determine start of the 8/16/32/64 bits chunk that contains the wanted
+        value: divide the index by 8 (we're working with a bitpacked array here,
+        all quantities are expressed in bits), and then by the size of the
+        chunks (alignpower) }
+      offsetreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,ptruinttype,3+alignpower,hreg,offsetreg);
+      { index the array using this chunk index }
+      basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,getpointerdef(defloadsize));
+      current_asmdata.CurrAsmList.Concat(taillvm.getelementptr_reg_size_ref_size_reg(basereg,getpointerdef(left.resultdef),
+        sref.ref,ptruinttype,offsetreg,true));
+      arraytopointerconverted:=true;
+      reference_reset_base(sref.ref,basereg,0,sref.ref.alignment);
+      { calculate the bit index inside that chunk }
+      hreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+      { multiple index with bitsize of every element }
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_MUL,ptruinttype,l,hreg,hreg2);
+      hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+      { mask out the chunk index part }
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_AND,ptruinttype,(1 shl (3+alignpower))-1,hreg2,hreg);
+      sref.bitindexreg:=hreg;
+      sref.startbit:=0;
+      sref.bitlen:=resultdef.packedbitsize;
+      if (left.location.loc=LOC_REFERENCE) then
+        location.loc:=LOC_SUBSETREF
+      else
+        location.loc:=LOC_CSUBSETREF;
+      location.sref:=sref;
+    end;
+
+
+  procedure tllvmvecnode.update_reference_offset(var ref: treference; index, mulsize: aint);
+    begin
+      inc(constarrayoffset,index);
+    end;
+
+
+begin
+  cloadparentfpnode:=tllvmloadparentfpnode;
+  csubscriptnode:=tllvmsubscriptnode;
+  cvecnode:=tllvmvecnode;
+end.
+

compiler/llvm/nllvmtcon.pas

@@ -0,0 +1,520 @@
+{
+    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,
+    symconst,symtype,symdef,symsym,
+    ngtcon;
+
+  type
+    tllvmaggregateinformation = class(taggregateinformation)
+     private
+      faggai: tai_aggregatetypedconst;
+      fanonrecalignpos: longint;
+     public
+      constructor create(_def: tdef; _typ: ttypedconstkind); override;
+
+      property aggai: tai_aggregatetypedconst read faggai write faggai;
+      property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
+    end;
+
+    tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
+     protected type
+      public
+       { set the default value for caggregateinformation (= tllvmaggregateinformation) }
+       class constructor classcreate;
+     protected
+      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; const options: ttcasmlistoptions); 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);
+      function wrap_with_type(p: tai; def: tdef): tai;
+      procedure do_emit_tai(p: tai; def: tdef); override;
+      procedure mark_anon_aggregate_alignment; override;
+      procedure insert_marked_aggregate_alignment(def: tdef); override;
+      procedure begin_aggregate_internal(def: tdef; anonymous: boolean); override;
+      procedure end_aggregate_internal(def: tdef; anonymous: boolean); override;
+
+      function get_internal_data_section_start_label: tasmlabel; override;
+      function get_internal_data_section_internal_label: tasmlabel; override;
+     public
+      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;
+      procedure queue_typeconvn(fromdef, todef: tdef); override;
+      procedure queue_emit_staticvar(vs: tstaticvarsym); override;
+      procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
+      procedure queue_emit_ordconst(value: int64; def: tdef); override;
+
+      class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
+    end;
+
+
+implementation
+
+  uses
+    verbose,
+    aasmdata,
+    cpubase,llvmbase,
+    symbase,symtable,llvmdef,defutil;
+
+  { tllvmaggregateinformation }
+
+   constructor tllvmaggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
+     begin
+       inherited;
+       fanonrecalignpos:=-1;
+     end;
+
+
+  class constructor tllvmtai_typedconstbuilder.classcreate;
+    begin
+      caggregateinformation:=tllvmaggregateinformation;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
+    var
+      newasmlist: tasmlist;
+    begin
+      { todo }
+      if section = sec_user then
+        internalerror(2014052904);
+      newasmlist:=tasmlist.create;
+      { llvm declaration with as initialisation data all the elements from the
+        original asmlist }
+      newasmlist.concat(taillvmdecl.create(sym,def,fasmlist,section,alignment));
+      fasmlist:=newasmlist;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
+    begin
+      { the outer tai must always be a typed constant (possibly a wrapper
+        around a taillvm or so), in order for result type information to be
+        available }
+      if outerai.typ<>ait_typedconst then
+        internalerror(2014060401);
+      { is the result of the outermost expression different from the type of
+        this typed const? -> insert type conversion }
+      if not assigned(fqueued_tai) and
+         (resdef<>fqueued_def) and
+         (llvmencodetype(resdef)<>llvmencodetype(fqueued_def)) then
+        queue_typeconvn(resdef,fqueued_def);
+      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;
+
+
+  function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
+    begin
+      result:=tai_simpletypedconst.create(tck_simple,def,p);
+    end;
+
+
+  destructor tllvmtai_typedconstbuilder.destroy;
+    begin
+      inherited destroy;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
+    var
+      ai: tai;
+      stc: tai_abstracttypedconst;
+      kind: ttypedconstkind;
+      info: tllvmaggregateinformation;
+    begin
+      if assigned(fqueued_tai) then
+        begin
+          kind:=tck_simple;
+          { 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 }
+          stc:=tai_abstracttypedconst(fqueued_tai);
+          def:=fqueued_def;
+          { ensure we don't try to emit this one again }
+          fqueued_tai:=nil;
+        end
+      else
+        stc:=tai_simpletypedconst.create(tck_simple,def,p);
+      info:=tllvmaggregateinformation(curagginfo);
+      { these elements can be aggregates themselves, e.g. a shortstring can
+        be emitted as a series of bytes and string data arrays }
+      kind:=aggregate_kind(def);
+      if (kind<>tck_simple) then
+        begin
+          if not assigned(info) or
+             (info.aggai.adetyp<>kind) then
+           internalerror(2014052906);
+        end;
+      if assigned(info) then
+        info.aggai.addvalue(stc)
+      else
+        inherited do_emit_tai(stc,def);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.mark_anon_aggregate_alignment;
+    var
+      info: tllvmaggregateinformation;
+    begin
+      info:=tllvmaggregateinformation(curagginfo);
+      info.anonrecalignpos:=info.aggai.valuecount;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.insert_marked_aggregate_alignment(def: tdef);
+    var
+      info: tllvmaggregateinformation;
+      fillbytes: asizeint;
+    begin
+      info:=tllvmaggregateinformation(curagginfo);
+      if info.anonrecalignpos=-1 then
+        internalerror(2014091501);
+      fillbytes:=info.prepare_next_field(def);
+      while fillbytes>0 do
+        begin
+          info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(tck_simple,u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
+          dec(fillbytes);
+        end;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
+    begin
+      if not pvdef.is_addressonly then
+        pvdef:=tprocvardef(pvdef.getcopyas(procvardef,pc_address_only));
+      emit_tai(p,pvdef);
+    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
+      { nil pointer? }
+      if not assigned(ll.lab) then
+        begin
+          if ll.ofs<>0 then
+            internalerror(2015030701);
+          inherited;
+          exit;
+        end;
+      { 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;
+      tck: ttypedconstkind;
+      curagg: tllvmaggregateinformation;
+    begin
+      tck:=aggregate_kind(def);
+      if tck<>tck_simple then
+        begin
+          { create new typed const aggregate }
+          agg:=tai_aggregatetypedconst.create(tck,def);
+          { either add to the current typed const aggregate (if nested), or
+            emit to the asmlist (if top level) }
+          curagg:=tllvmaggregateinformation(curagginfo);
+          if assigned(curagg) then
+            curagg.aggai.addvalue(agg)
+          else
+            fasmlist.concat(agg);
+          { create aggregate information for this new aggregate }
+          inherited;
+          { set new current typed const aggregate }
+          tllvmaggregateinformation(curagginfo).aggai:=agg
+        end
+      else
+       inherited;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
+    var
+      info: tllvmaggregateinformation;
+    begin
+      if aggregate_kind(def)<>tck_simple then
+        begin
+          info:=tllvmaggregateinformation(curagginfo);
+          if not assigned(info) then
+            internalerror(2014060101);
+          info.aggai.finish;
+        end;
+      inherited;
+    end;
+
+
+  function tllvmtai_typedconstbuilder.get_internal_data_section_start_label: tasmlabel;
+    begin
+      { let llvm take care of everything by creating internal nameless
+        constants }
+      current_asmdata.getlocaldatalabel(result);
+    end;
+
+
+  function tllvmtai_typedconstbuilder.get_internal_data_section_internal_label: tasmlabel;
+    begin
+      current_asmdata.getlocaldatalabel(result);
+    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;
+      aityped: tai;
+      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;
+      aityped:=wrap_with_type(ai,getpointerdef(eledef));
+      update_queued_tai(getpointerdef(eledef),aityped,ai,1);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym);
+    var
+      getllvmfieldaddr,
+      getpascalfieldaddr,
+      getllvmfieldaddrtyped: tai;
+      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);
+      { getelementptr doesn't contain its own resultdef, so encode it via a
+        tai_simpletypedconst tai }
+      getllvmfieldaddrtyped:=wrap_with_type(getllvmfieldaddr,getpointerdef(llvmfielddef));
+      { if it doesn't match the requested field exactly (variant record),
+        fixup the result }
+      getpascalfieldaddr:=getllvmfieldaddrtyped;
+      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_tai_size(la_bitcast,NR_NO,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);
+              { ... and set the result type of the getelementptr }
+              getpascalfieldaddr:=wrap_with_type(getpascalfieldaddr,getpointerdef(u8inttype));
+              llvmfielddef:=u8inttype;
+            end;
+          { bitcast the data at the final offset to the right type }
+          if llvmfielddef<>vs.vardef then
+            getpascalfieldaddr:=wrap_with_type(taillvm.op_reg_tai_size(la_bitcast,NR_NO,getpascalfieldaddr,getpointerdef(vs.vardef)),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;
+      typedai: tai;
+      tmpintdef: tdef;
+      op,
+      firstop,
+      secondop: tllvmop;
+    begin
+      inherited;
+      { special case: procdef -> procvardef/pointerdef: must take address of
+        the procdef }
+      if (fromdef.typ=procdef) and
+         (todef.typ<>procdef) then
+        fromdef:=tprocdef(fromdef).getcopyas(procvardef,pc_address_only);
+      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_tai_size(secondop,NR_NO,nil,todef);
+            typedai:=wrap_with_type(ai,todef);
+            update_queued_tai(todef,typedai,ai,1);
+            todef:=tmpintdef;
+            op:=firstop
+          end;
+      end;
+      ai:=taillvm.op_reg_tai_size(op,NR_NO,nil,todef);
+      typedai:=wrap_with_type(ai,todef);
+      update_queued_tai(todef,typedai,ai,1);
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_emit_staticvar(vs: tstaticvarsym);
+    begin
+      { we've already incorporated the offset via the inserted operations above,
+        make sure it doesn't get emitted again as part of the tai_const for
+        the tasmsymbol }
+      fqueue_offset:=0;
+      inherited;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
+    begin
+      { we've already incorporated the offset via the inserted operations above,
+        make sure it doesn't get emitted again as part of the tai_const for
+        the tasmsymbol }
+      fqueue_offset:=0;
+      inherited;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.queue_emit_ordconst(value: int64; def: tdef);
+    begin
+      { no offset into an ordinal constant }
+      if fqueue_offset<>0 then
+        internalerror(2015030702);
+      inherited;
+    end;
+
+
+  class function tllvmtai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
+    begin
+      { LLVM does not support labels in the middle of a declaration }
+      result:=get_string_header_size(typ,winlikewidestring);
+    end;
+
+
+begin
+  ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
+end.
+

compiler/llvm/nllvmutil.pas

@@ -0,0 +1,109 @@
+{
+    Copyright (c) 20011 by Jonas Maebe
+
+    LLVM version of some node tree helper routines
+
+    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 nllvmutil;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    globtype,
+    aasmdata,ngenutil,
+    symtype,symconst,symsym,symdef;
+
+
+  type
+    tllvmnodeutils = class(tnodeutils)
+     strict protected
+      class procedure insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); override;
+     public
+      class procedure InsertInitFinalTable; override;
+      class procedure InsertWideInitsTablesTable; override;
+      class procedure InsertWideInits; override;
+      class procedure InsertResourceTablesTable; override;
+      class procedure InsertResourceInfo(ResourcesUsed : boolean); override;
+      class procedure InsertMemorySizes; override;
+    end;
+
+
+implementation
+
+    uses
+      verbose,cutils,globals,fmodule,
+      aasmbase,aasmtai,cpubase,llvmbase,aasmllvm,
+      symbase,symtable,defutil;
+
+  class procedure tllvmnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint);
+    var
+      asmsym: tasmsymbol;
+    begin
+      if sym.globalasmsym then
+        asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_GLOBAL,AT_DATA)
+      else
+        asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_LOCAL,AT_DATA);
+      if not(vo_is_thread_var in sym.varoptions) then
+        list.concat(taillvmdecl.create(asmsym,sym.vardef,nil,sec_data,varalign))
+      else
+        list.concat(taillvmdecl.createtls(asmsym,sym.vardef,varalign))
+    end;
+
+
+  class procedure tllvmnodeutils.InsertInitFinalTable;
+    begin
+      { todo }
+    end;
+
+
+  class procedure tllvmnodeutils.InsertWideInitsTablesTable;
+    begin
+      { not required }
+    end;
+
+
+  class procedure tllvmnodeutils.InsertWideInits;
+    begin
+      { not required }
+    end;
+
+
+  class procedure tllvmnodeutils.InsertResourceTablesTable;
+    begin
+      { not supported }
+    end;
+
+
+  class procedure tllvmnodeutils.InsertResourceInfo(ResourcesUsed: boolean);
+    begin
+      { not supported }
+    end;
+
+
+  class procedure tllvmnodeutils.InsertMemorySizes;
+    begin
+      { not required }
+    end;
+
+
+begin
+  cnodeutils:=tllvmnodeutils;
+end.
+

compiler/llvm/rgllvm.pas

@@ -0,0 +1,190 @@
+{
+    Copyright (c) 2013 by Jonas Maebe, member of the Free Pascal development
+    team
+
+    This unit implements the LLVM-specific class for the register
+    allocator
+
+    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 rgllvm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aasmcpu,aasmtai,aasmdata,
+      symtype,
+      cgbase,cgutils,
+      cpubase,llvmbase,
+      rgobj;
+
+    type
+      { trgllvm }
+      trgllvm=class(trgobj)
+        constructor create(Aregtype: Tregistertype; Adefaultsub: Tsubregister; const Ausable: array of tsuperregister; Afirst_imaginary: Tsuperregister; Apreserved_by_proc: Tcpuregisterset); reintroduce;
+        procedure do_register_allocation(list: TAsmList; headertai: tai); override;
+        procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+       protected
+        procedure determine_spill_registers(list: TasmList; headertai: tai); override;
+        procedure get_spill_temp(list:TAsmlist;spill_temps: Pspill_temp_list; supreg: tsuperregister);override;
+       strict protected
+       type
+         tregwrites = (rw_none, rw_one, rw_multiple);
+         pwrittenregs = ^twrittenregs;
+         twrittenregs = bitpacked array[tsuperregister] of tregwrites;
+       var
+        spillcounter: longint;
+        writtenregs: pwrittenregs;
+      end;
+
+
+implementation
+
+    uses
+      verbose,cutils,
+      globtype,globals,
+      symdef,
+      aasmllvm,
+      tgobj;
+
+    { trgllvm }
+
+     constructor trgllvm.create(Aregtype: Tregistertype; Adefaultsub: Tsubregister; const Ausable: array of tsuperregister; Afirst_imaginary: Tsuperregister; Apreserved_by_proc: Tcpuregisterset);
+       begin
+         inherited;
+         { tell the generic register allocator to generate SSA spilling code }
+         ssa_safe:=true;
+       end;
+
+     procedure trgllvm.do_register_allocation(list: TAsmList; headertai: tai);
+      begin
+        { these are SSA by design, they're only assigned by alloca
+          instructions }
+        if regtype=R_TEMPREGISTER then
+          exit;
+        inherited;
+      end;
+
+
+    procedure trgllvm.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
+      var
+        ins: taillvm;
+        def: tdef;
+      begin
+        def:=tdef(reginfo[orgsupreg].def);
+        if not assigned(def) then
+          internalerror(2013110803);
+        ins:=taillvm.op_reg_size_ref(la_load,tempreg,getpointerdef(def),spilltemp);
+        list.insertafter(ins,pos);
+        {$ifdef DEBUG_SPILLING}
+        list.Insertbefore(tai_comment.Create(strpnew('Spilling: Spill Read')),ins);
+        {$endif}
+      end;
+
+
+    procedure trgllvm.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
+      var
+        ins: taillvm;
+        def: tdef;
+      begin
+        def:=tdef(reginfo[orgsupreg].def);
+        if not assigned(def) then
+          internalerror(2013110802);
+        ins:=taillvm.op_size_reg_size_ref(la_store,def,tempreg,getpointerdef(def),spilltemp);
+        list.insertafter(ins,pos);
+        {$ifdef DEBUG_SPILLING}
+        list.Insertbefore(tai_comment.Create(strpnew('Spilling: Spill Write')),ins);
+        {$endif}
+      end;
+
+
+     procedure trgllvm.determine_spill_registers(list: TasmList; headertai: tai);
+       var
+         hp: tai;
+         reg: tregister;
+         sr: tsuperregister;
+         i: longint;
+       begin
+         spillednodes.clear;
+         { there should be only one round of spilling per register type, we
+           shouldn't generate multiple writes to a single register here }
+         if spillcounter<>0 then
+           exit;
+         { registers must be in SSA form -> determine all registers that are
+           written to more than once }
+         hp:=headertai;
+         { 2 bits per superregister, rounded up to a byte }
+         writtenregs:=allocmem((maxreg*bitsizeof(twrittenregs[low(tsuperregister)])+7) shr 3);
+         while assigned(hp) do
+           begin
+             case hp.typ of
+               ait_llvmins:
+                 begin
+                   for i:=0 to taillvm(hp).ops-1 do
+                     if (taillvm(hp).oper[i]^.typ=top_reg) and
+                        (getregtype(taillvm(hp).oper[i]^.reg)=regtype)  and
+                        (taillvm(hp).spilling_get_operation_type(i)=operand_write) then
+                       begin
+                         reg:=taillvm(hp).oper[i]^.reg;
+                         sr:=getsupreg(reg);
+                         if writtenregs^[sr]<rw_multiple then
+                           writtenregs^[sr]:=succ(writtenregs^[sr]);
+                       end;
+                 end;
+             end;
+             hp:=tai(hp.next);
+           end;
+         { add all registers with multiple writes to the spilled nodes }
+         for sr:=0 to maxreg-1 do
+           if writtenregs^[sr]=rw_multiple then
+             spillednodes.add(sr);
+         freemem(writtenregs);
+       end;
+
+
+    procedure trgllvm.get_spill_temp(list: TAsmlist; spill_temps: Pspill_temp_list; supreg: tsuperregister);
+      var
+        supstart: tai;
+        i: longint;
+        def: tdef;
+      begin
+        supstart:=live_start[supreg];
+        if supstart.typ<>ait_llvmins then
+          internalerror(2013110701);
+        { determine type of register so we can allocate a temp of the right
+          type }
+        def:=nil;
+        for i:=0 to taillvm(supstart).ops-1 do
+          begin
+            if (taillvm(supstart).oper[i]^.typ=top_reg) and
+               (getregtype(taillvm(supstart).oper[i]^.reg)=regtype) and
+               (getsupreg(taillvm(supstart).oper[i]^.reg)=supreg) then
+              begin
+                def:=taillvm(supstart).spilling_get_reg_type(i);
+                break
+              end;
+          end;
+        if not assigned(def) then
+          internalerror(2013110702);
+        tg.gethltemp(list,def,def.size,tt_noreuse,spill_temps^[supreg]);
+        { record for use in spill instructions }
+        reginfo[supreg].def:=def;
+      end;
+
+end.

compiler/llvm/tgllvm.pas

@@ -0,0 +1,170 @@
+{
+    Copyright (c) 1998-2002,2012 by Florian Klaempfl, Jonas Maebe
+
+    This unit implements the LLVM-specific temp. generator
+
+    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 tgllvm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cclasses,
+      globals,globtype,
+      symtype,
+      cpubase,cpuinfo,cgbase,cgutils,
+      aasmbase,aasmtai,aasmdata,
+      tgobj;
+
+    type
+
+      { LLVM temp manager: in LLVM, you allocate every temp separately using
+        the "alloca" instrinsic. Every such temp is a separate stack slot, but
+        can be turned into a regvar (or be decomposed) by LLVM. To avoid
+        problems with turning stack slots into regvars, we don't allocate one
+        big blob of memory that we manage ourselves using the regular temp
+        manager. Instead, we just allocate a new "stack pointer register"
+        (R_TEMPREGISTER) every time we need a new temp. This allows for having
+        the generic code generator modify the offset without interfering with
+        our ability to determine which temp the reference points to.
+
+        Temps are currently not reused, but that should probably be added in
+        the future (except if adding liveness information for the temps enables
+        llvm to do so by itself and we don't run out of temp registers).
+      }
+
+      { ttgllvm }
+
+      ttgllvm = class(ttgobj)
+       protected
+        procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); override;
+       public
+        alloclist: tasmlist;
+
+        constructor create; override;
+        destructor destroy; override;
+        procedure setfirsttemp(l: asizeint); override;
+        function istemp(const ref: treference): boolean; override;
+        procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference); override;
+        procedure gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference); override;
+        procedure ungetiftemp(list: TAsmList; const ref: treference); override;
+      end;
+
+implementation
+
+    uses
+       cutils,
+       systems,verbose,
+       procinfo,
+       llvmbase,aasmllvm,
+       symconst,
+       cgobj
+       ;
+
+
+    { ttgllvm }
+
+    procedure ttgllvm.alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference);
+      var
+        tl: ptemprecord;
+        oldfileinfo: tfileposinfo;
+      begin
+        reference_reset_base(ref,cg.gettempregister(list),0,alignment);
+        new(tl);
+
+        tl^.temptype:=temptype;
+        tl^.def:=def;
+        tl^.fini:=fini;
+        tl^.alignment:=alignment;
+        tl^.pos:=getsupreg(ref.base);
+        tl^.size:=size;
+        tl^.next:=templist;
+        tl^.nextfree:=nil;
+        templist:=tl;
+        list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
+        { TODO: add llvm.lifetime.start() for this allocation and afterwards
+            llvm.lifetime.end() for freetemp (if the llvm version supports it) }
+        inc(lasttemp);
+        { allocation for the temp -- should have lineinfo of the start of the
+          routine }
+        if assigned(current_procinfo) then
+          begin
+            oldfileinfo:=current_filepos;
+            current_filepos:=current_procinfo.procdef.fileinfo;
+          end
+        else
+          { avoid uninitialised warning later }
+          oldfileinfo.line:=0;
+        alloclist.concat(taillvm.op_ref_size(la_alloca,ref,def));
+        if assigned(current_procinfo) then
+          current_filepos:=oldfileinfo;
+      end;
+
+
+    function ttgllvm.istemp(const ref: treference): boolean;
+      begin
+        result:=getregtype(ref.base)=R_TEMPREGISTER;
+      end;
+
+
+    constructor ttgllvm.create;
+      begin
+        inherited create;
+        direction:=1;
+        alloclist:=TAsmList.create;
+      end;
+
+
+    destructor ttgllvm.destroy;
+      begin
+        alloclist.free;
+        inherited destroy;
+      end;
+
+
+    procedure ttgllvm.setfirsttemp(l: asizeint);
+      begin
+        firsttemp:=l;
+        lasttemp:=l;
+      end;
+
+
+    procedure ttgllvm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref: treference);
+      begin
+        gethltemp(list,def,size,tt_persistent,ref);
+      end;
+
+
+    procedure ttgllvm.gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference);
+      begin
+        alloctemp(list,def.size,def.alignment,temptype,def,false,ref);
+      end;
+
+
+    procedure ttgllvm.ungetiftemp(list: TAsmList; const ref: treference);
+      begin
+        if istemp(ref) then
+          FreeTemp(list,getsupreg(ref.base),[tt_normal]);
+      end;
+
+begin
+  tgobjclass:=ttgllvm;
+end.

compiler/m68k/cgcpu.pas

@@ -85,7 +85,6 @@ unit cgcpu;
         procedure g_restore_registers(list:TAsmList);override;
 
         procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
 
         { # Sign or zero extend the register to a full 32-bit value.
             The new value is left in the same register.
@@ -2163,87 +2162,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-
-        procedure getselftoa0(offs:longint);
-          var
-            href : treference;
-            selfoffsetfromsp : longint;
-          begin
-            { move.l offset(%sp),%a0 }
-
-            { framepointer is pushed for nested procs }
-            if procdef.parast.symtablelevel>normal_function_level then
-              selfoffsetfromsp:=sizeof(aint)
-            else
-              selfoffsetfromsp:=0;
-            reference_reset_base(href,NR_SP,selfoffsetfromsp+offs,4);
-            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
-          end;
-
-        procedure loadvmttoa0;
-        var
-          href : treference;
-        begin
-          { move.l  (%a0),%a0 ; load vmt}
-          reference_reset_base(href,NR_A0,0,4);
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
-        end;
-
-        procedure op_ona0methodaddr;
-        var
-          href : treference;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(2013100701);
-          reference_reset_base(href,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
-          list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_A0));
-          reference_reset_base(href,NR_A0,0,4);
-          list.concat(taicpu.op_ref(A_JMP,S_NO,href));
-        end;
-
-      var
-        make_global : boolean;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef.struct) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>ObjectSymtable then
-          Internalerror(200109191);
-
-        make_global:=false;
-        if (not current_module.is_unit) or
-           create_smartlink or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { set param1 interface to self  }
-        g_adjust_self_value(list,procdef,ioffset);
-
-        { case 4 }
-        if (po_virtualmethod in procdef.procoptions) and
-            not is_objectpascal_helper(procdef.struct) then
-          begin
-            getselftoa0(4);
-            loadvmttoa0;
-            op_ona0methodaddr;
-          end
-        { case 0 }
-        else
-          list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(procdef.mangledname)));
-
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
     procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint);
       begin
         list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG));

compiler/m68k/cpupara.pas

@@ -38,7 +38,7 @@ unit cpupara;
          and if the calling conventions for the helper routines of the
          rtl are used.
        }
-       tm68kparamanager = class(tparamanager)
+       tcpuparamanager = class(tparamanager)
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           function param_use_paraloc(const cgpara:tcgpara):boolean;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
@@ -67,26 +67,26 @@ unit cpupara;
        defutil;
 
 
-    function tm68kparamanager.get_volatile_registers_int(calloption:tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_int(calloption:tproccalloption):tcpuregisterset;
       begin
         { d0 and d1 are considered volatile }
         Result:=VOLATILE_INTREGISTERS;
       end;
 
 
-    function tm68kparamanager.get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;
       begin
         { a0 and a1 are considered volatile }
         Result:=VOLATILE_ADDRESSREGISTERS;
       end;
 
-    function tm68kparamanager.get_volatile_registers_fpu(calloption:tproccalloption):tcpuregisterset;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption:tproccalloption):tcpuregisterset;
       begin
         { fp0 and fp1 are considered volatile }
         Result:=VOLATILE_FPUREGISTERS;
       end;
 
-    function tm68kparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
+    function tcpuparamanager.param_use_paraloc(const cgpara:tcgpara):boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -108,7 +108,7 @@ unit cpupara;
 
 
 { TODO: copied from ppc cg, needs work}
-    function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         { var,out,constref always require address }
@@ -140,8 +140,7 @@ unit cpupara;
         end;
       end;
 
-
-    function tm68kparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
       begin
         if handle_common_ret_in_param(def,pd,result) then
           exit;
@@ -158,7 +157,7 @@ unit cpupara;
       end;
 
 
-    function tm68kparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
@@ -223,7 +222,7 @@ unit cpupara;
           end;
       end;
 
-    function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         cur_stack_offset: aword;
       begin
@@ -233,7 +232,7 @@ unit cpupara;
         create_funcretloc_info(p,side);
       end;
 
-    function tm68kparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+    function tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                var cur_stack_offset: aword):longint;
       var
         paraloc      : pcgparalocation;
@@ -343,13 +342,13 @@ unit cpupara;
       end;
 
 
-    function tm68kparamanager.parse_loc_string_to_register(var locreg: tregister; const s : string): boolean;
+    function tcpuparamanager.parse_loc_string_to_register(var locreg: tregister; const s : string): boolean;
       begin
         locreg:=std_regnum_search(lowercase(s));
         result:=(locreg <> NR_NO) and (locreg <> NR_SP);
       end;
 
-    function tm68kparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;
+    function tcpuparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;
       begin
         case target_info.system of
           system_m68k_amiga:
@@ -359,7 +358,7 @@ unit cpupara;
         end;
       end;
 
-    function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
+    function tcpuparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
       var
         paraloc : pcgparalocation;
       begin
@@ -386,7 +385,7 @@ unit cpupara;
       end;
 
 
-    procedure tm68kparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
+    procedure tcpuparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
       begin
         { Never a need for temps when value is pushed (calls inside parameters
           will simply allocate even more stack space for their parameters) }
@@ -395,7 +394,7 @@ unit cpupara;
         inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
-    function tm68kparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
       begin
@@ -411,5 +410,5 @@ unit cpupara;
 
 
 begin
-  paramanager:=tm68kparamanager.create;
+  paramanager:=tcpuparamanager.create;
 end.

compiler/m68k/hlcgcpu.pas

@@ -28,42 +28,41 @@ unit hlcgcpu;
 
 interface
 
-uses
-  globtype,
-  aasmbase, aasmdata,
-  cgbase, cgutils,
-  symconst,symtype,symdef,
-  parabase, hlcgobj, hlcg2ll;
+
+  uses
+    globtype,
+    aasmbase, aasmdata,
+    cgbase, cgutils,
+    symconst,symtype,symdef,
+    hlcg2ll;
 
   type
-    thlcgm68k = class(thlcg2ll)
+    thlcgcpu = class(thlcg2ll)
       procedure a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister); override;
       procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister); override;
       procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference); override;
       procedure a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const ref: treference); override;
+      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     end;
 
-
   procedure create_hlcodegen;
 
 implementation
 
   uses
-    verbose, systems,
-    aasmtai,
-    aasmcpu,
-    cutils,
-    globals,
+    globals, verbose, systems, cutils,
+    fmodule,
+    aasmtai, aasmcpu,
     defutil,
-    cgobj,
-    cpubase,
-    cpuinfo,
-    cgcpu;
+    hlcgobj,
+    cpuinfo, cgobj, cpubase, cgcpu;
+
+
 
   const
     bit_set_clr_instr: array[boolean] of tasmop = (A_BCLR,A_BSET);
 
-  procedure thlcgm68k.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister);
+  procedure thlcgcpu.a_bit_set_reg_reg(list: TAsmList; doset: boolean; bitnumbersize, destsize: tdef; bitnumber, dest: tregister);
     var
       tmpvalue: tregister;
     begin
@@ -74,13 +73,15 @@ implementation
       list.concat(taicpu.op_reg_reg(bit_set_clr_instr[doset],S_NO,tmpvalue,dest));
     end;
 
-  procedure thlcgm68k.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister);
+
+  procedure thlcgcpu.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; destreg: tregister);
     begin
       //list.concat(tai_comment.create(strpnew('a_bit_set_const_reg: called!')));
       list.concat(taicpu.op_const_reg(bit_set_clr_instr[doset],S_NO,(destsize.size*8)-bitnumber-1,destreg));
     end;
 
-  procedure thlcgm68k.a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference);
+
+  procedure thlcgcpu.a_bit_set_reg_ref(list: TAsmList; doset: boolean; fromsize, tosize: tdef; bitnumber: tregister; const ref: treference);
     var
       tmpvalue: tregister;
       sref: tsubsetreference;
@@ -97,7 +98,8 @@ implementation
       list.concat(taicpu.op_reg_ref(bit_set_clr_instr[doset],S_NO,tmpvalue,sref.ref));
     end;
 
-  procedure thlcgm68k.a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const ref: treference);
+
+  procedure thlcgcpu.a_bit_set_const_ref(list: TAsmList; doset: boolean; destsize: tdef; bitnumber: tcgint; const ref: treference);
     var
       sref: tsubsetreference;
     begin
@@ -109,10 +111,94 @@ implementation
       list.concat(taicpu.op_const_ref(bit_set_clr_instr[doset],S_NO,8-sref.startbit-1,sref.ref));
     end;
 
+
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+
+    procedure getselftoa0(offs:longint);
+      var
+        href : treference;
+        selfoffsetfromsp : longint;
+      begin
+        { move.l offset(%sp),%a0 }
+
+        { framepointer is pushed for nested procs }
+        if procdef.parast.symtablelevel>normal_function_level then
+          selfoffsetfromsp:=sizeof(aint)
+        else
+          selfoffsetfromsp:=0;
+        reference_reset_base(href, voidstackpointertype, NR_SP,selfoffsetfromsp+offs,4);
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
+      end;
+
+    procedure loadvmttoa0;
+      var
+        href : treference;
+      begin
+        { move.l  (%a0),%a0 ; load vmt}
+        reference_reset_base(href, voidpointertype, NR_A0,0,4);
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
+      end;
+
+    procedure op_ona0methodaddr;
+      var
+        href : treference;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(2013100701);
+        reference_reset_base(href,voidpointertype,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
+        list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_A0));
+        reference_reset_base(href,voidpointertype,NR_A0,0,4);
+        list.concat(taicpu.op_ref(A_JMP,S_NO,href));
+      end;
+
+    var
+      make_global : boolean;
+    begin
+      if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+        Internalerror(200006137);
+      if not assigned(procdef.struct) or
+         (procdef.procoptions*[po_classmethod, po_staticmethod,
+           po_methodpointer, po_interrupt, po_iocheck]<>[]) then
+        Internalerror(200006138);
+      if procdef.owner.symtabletype<>ObjectSymtable then
+        Internalerror(200109191);
+
+      make_global:=false;
+      if (not current_module.is_unit) or
+         create_smartlink or
+         (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
+        make_global:=true;
+
+      if make_global then
+        List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
+      else
+        List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
+
+      { set param1 interface to self  }
+      g_adjust_self_value(list,procdef,ioffset);
+
+      { case 4 }
+      if (po_virtualmethod in procdef.procoptions) and
+          not is_objectpascal_helper(procdef.struct) then
+        begin
+          getselftoa0(4);
+          loadvmttoa0;
+          op_ona0methodaddr;
+        end
+      { case 0 }
+      else
+        list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(procdef.mangledname)));
+
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcgm68k.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
+begin
+  chlcgobj:=thlcgcpu;
 end.

compiler/m68k/rgcpu.pas

@@ -27,15 +27,15 @@ unit rgcpu;
   interface
 
      uses
-       aasmbase,aasmtai,aasmdata,aasmcpu,
+       aasmbase,aasmtai,aasmdata,aasmsym,aasmcpu,
        cgbase,cgutils,cpubase,
        rgobj;
 
      type
        trgcpu = class(trgobj)
-         procedure do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         procedure do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;override;
+         procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+         function do_spill_replace(list : TAsmList;instr : tai_cpu_abstract_sym; orgreg : tsuperregister;const spilltemp : treference) : boolean; override;
        end;
 
   implementation
@@ -53,7 +53,7 @@ unit rgcpu;
       end;
 
 
-    procedure trgcpu.do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         helpins  : tai;
         tmpref   : treference;
@@ -82,11 +82,11 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    procedure trgcpu.do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         tmpref   : treference;
         helplist : tasmlist;
@@ -116,11 +116,11 @@ unit rgcpu;
             helplist.free;
           end
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
+          inherited;
     end;
 
 
-    function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+    function trgcpu.do_spill_replace(list : TAsmList;instr : tai_cpu_abstract_sym; orgreg : tsuperregister;const spilltemp : treference) : boolean;
       var
         opidx: longint;
       begin
@@ -167,7 +167,7 @@ unit rgcpu;
         instr.oper[opidx]^.typ:=top_ref;
         new(instr.oper[opidx]^.ref);
         instr.oper[opidx]^.ref^:=spilltemp;
-        case instr.opsize of
+        case taicpu(instr).opsize of
           S_B: inc(instr.oper[opidx]^.ref^.offset,3);
           S_W: inc(instr.oper[opidx]^.ref^.offset,2);
         end;

compiler/mips/cgcpu.pas

@@ -85,8 +85,6 @@ type
     procedure g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); override;
     procedure g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
     procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); override;
-    procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override;
-    procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
     procedure g_profilecode(list: TAsmList);override;
   end;
 
@@ -1661,133 +1659,6 @@ begin
 end;
 
 
-procedure TCGMIPS.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint);
-var
-  make_global: boolean;
-  hsym: tsym;
-  href: treference;
-  paraloc: Pcgparalocation;
-  IsVirtual: boolean;
-begin
-  if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-    Internalerror(200006137);
-  if not assigned(procdef.struct) or
-    (procdef.procoptions * [po_classmethod, po_staticmethod,
-    po_methodpointer, po_interrupt, po_iocheck] <> []) then
-    Internalerror(200006138);
-  if procdef.owner.symtabletype <> objectsymtable then
-    Internalerror(200109191);
-
-  make_global := False;
-  if (not current_module.is_unit) or create_smartlink or
-    (procdef.owner.defowner.owner.symtabletype = globalsymtable) then
-    make_global := True;
-
-  if make_global then
-    List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
-  else
-    List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
-
-  IsVirtual:=(po_virtualmethod in procdef.procoptions) and
-      not is_objectpascal_helper(procdef.struct);
-
-  if (cs_create_pic in current_settings.moduleswitches) and
-    (not IsVirtual) then
-    begin
-      list.concat(Taicpu.op_none(A_P_SET_NOREORDER));
-      list.concat(Taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
-      list.concat(Taicpu.op_none(A_P_SET_REORDER));
-    end;
-
-  { set param1 interface to self  }
-  procdef.init_paraloc_info(callerside);
-  hsym:=tsym(procdef.parast.Find('self'));
-  if not(assigned(hsym) and
-    (hsym.typ=paravarsym)) then
-    internalerror(2010103101);
-  paraloc:=tparavarsym(hsym).paraloc[callerside].location;
-  if assigned(paraloc^.next) then
-    InternalError(2013020101);
-
-  case paraloc^.loc of
-    LOC_REGISTER:
-      begin
-        if ((ioffset>=simm16lo) and (ioffset<=simm16hi)) then
-          a_op_const_reg(list,OP_SUB, paraloc^.size,ioffset,paraloc^.register)
-        else
-          begin
-            a_load_const_reg(list, paraloc^.size, ioffset, NR_R1);
-            a_op_reg_reg(list, OP_SUB, paraloc^.size, NR_R1, paraloc^.register);
-          end;
-      end;
-  else
-    internalerror(2010103102);
-  end;
-
-  if IsVirtual then
-  begin
-    { load VMT pointer }
-    reference_reset_base(href,paraloc^.register,0,sizeof(aint));
-    list.concat(taicpu.op_reg_ref(A_LW,NR_VMT,href));
-
-    if (procdef.extnumber=$ffff) then
-      Internalerror(200006139);
-
-    { TODO: case of large VMT is not handled }
-    { We have no reason not to use $t9 even in non-PIC mode. }
-    reference_reset_base(href, NR_VMT, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint));
-    list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
-    list.concat(taicpu.op_reg(A_JR, NR_PIC_FUNC));
-  end
-  else if not (cs_create_pic in current_settings.moduleswitches) then
-    list.concat(taicpu.op_sym(A_J,current_asmdata.RefAsmSymbol(procdef.mangledname)))
-  else
-    begin
-      { GAS does not expand "J symbol" into PIC sequence }
-      reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
-      href.base:=NR_GP;
-      href.refaddr:=addr_pic_call16;
-      list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
-      list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
-    end;
-  { Delay slot }
-  list.Concat(TAiCpu.Op_none(A_NOP));
-
-  List.concat(Tai_symbol_end.Createname(labelname));
-end;
-
-
-procedure TCGMIPS.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
-  var
-    href: treference;
-  begin
-    reference_reset_symbol(href,current_asmdata.RefAsmSymbol(externalname),0,sizeof(aint));
-    { Always do indirect jump using $t9, it won't harm in non-PIC mode }
-    if (cs_create_pic in current_settings.moduleswitches) then
-      begin
-        list.concat(taicpu.op_none(A_P_SET_NOREORDER));
-        list.concat(taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
-        href.base:=NR_GP;
-        href.refaddr:=addr_pic_call16;
-        list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
-        list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
-        { Delay slot }
-        list.Concat(taicpu.op_none(A_NOP));
-        list.Concat(taicpu.op_none(A_P_SET_REORDER));
-      end
-    else
-      begin
-        href.refaddr:=addr_high;
-        list.concat(taicpu.op_reg_ref(A_LUI,NR_PIC_FUNC,href));
-        href.refaddr:=addr_low;
-        list.concat(taicpu.op_reg_ref(A_ADDIU,NR_PIC_FUNC,href));
-        list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
-        { Delay slot }
-        list.Concat(taicpu.op_none(A_NOP));
-      end;
-  end;
-
-
 procedure TCGMIPS.g_profilecode(list:TAsmList);
   var
     href: treference;

compiler/mips/cpupara.pas

@@ -67,7 +67,7 @@ interface
       parasupregs : tparasupregs = (RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, RS_R9);
 
     type
-      TMIPSParaManager=class(TParaManager)
+      tcpuparamanager=class(TParaManager)
         function  push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
         function  get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override;
         function  get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
@@ -92,14 +92,14 @@ implementation
 
 
 
-    function TMIPSParaManager.get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;
+    function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;
       begin
         { O32 ABI values }
         result:=[RS_R1..RS_R15,RS_R24..RS_R25,RS_R31];
       end;
 
 
-    function TMIPSParaManager.get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;
+    function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;
       begin
         { O32 ABI values }
         result:=[RS_F0..RS_F19];
@@ -108,14 +108,14 @@ implementation
 
     { whether "def" must be treated as record when used as function result,
       i.e. its address passed in a0 }
-    function TMIPSParaManager.is_abi_record(def: tdef): boolean;
+    function tcpuparamanager.is_abi_record(def: tdef): boolean;
       begin
         result:=(def.typ=recorddef) or
           ((def.typ=procvardef) and not tprocvardef(def).is_addressonly);
       end;
 
 
-    function TMIPSParaManager.param_use_paraloc(const cgpara: tcgpara): boolean;
+    function tcpuparamanager.param_use_paraloc(const cgpara: tcgpara): boolean;
       var
         paraloc: pcgparalocation;
       begin
@@ -127,7 +127,7 @@ implementation
 
 
     { true if a parameter is too large to copy and only the address is pushed }
-    function TMIPSParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+    function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
         result:=false;
         { var,out,constref always require address }
@@ -161,7 +161,7 @@ implementation
       end;
 
 
-    function TMIPSParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+    function tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
         paraloc : pcgparalocation;
         retcgsize  : tcgsize;
@@ -234,7 +234,7 @@ implementation
       end;
 
 
-    procedure TMIPSParaManager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist);
+    procedure tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist);
       var
         paraloc      : pcgparalocation;
         i,j          : integer;
@@ -373,7 +373,7 @@ implementation
                   begin
                     { This should be the first parameter }
                     //if (intparareg<>1) then
-                    //  Comment(V_Warning,'intparareg should be one for funcret in TMipsParaManager.create_paraloc_info_intern');
+                    //  Comment(V_Warning,'intparareg should be one for funcret in tcpuparamanager.create_paraloc_info_intern');
                     paraloc^.loc:=LOC_REGISTER;
                     paraloc^.register:=newreg(R_INTREGISTER,parasupregs[0],R_SUBWHOLE);
                     inc(intparasize,align(tcgsize2size[paraloc^.size],sizeof(aint)));
@@ -480,7 +480,7 @@ implementation
       end;
 
 
-    function TMIPSParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
       begin
         intparareg:=0;
         intparasize:=0;
@@ -501,7 +501,7 @@ implementation
 
 
 
-    function TMIPSParaManager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+    function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       begin
         intparareg:=0;
         intparasize:=0;
@@ -515,5 +515,5 @@ implementation
 
 
 begin
-   ParaManager:=TMIPSParaManager.create;
+   ParaManager:=tcpuparamanager.create;
 end.

compiler/mips/hlcgcpu.pas

@@ -32,15 +32,18 @@ uses
   globtype,
   aasmbase, aasmdata,
   cgbase, cgutils,
-  symconst,symtype,symdef,
+  symtype,symdef,
   parabase, hlcgobj, hlcg2ll;
 
   type
     thlcgmips = class(thlcg2ll)
-      function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara; override;
+      function a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara; override;
       procedure a_load_subsetreg_reg(list: TAsmList; subsetsize, tosize: tdef; const sreg: tsubsetregister; destreg: tregister);override;
     protected
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
+    public
+      procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override;
+      procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
   end;
 
   procedure create_hlcodegen;
@@ -48,18 +51,17 @@ uses
 implementation
 
   uses
-    verbose,
-    aasmtai,
-    aasmcpu,
+    verbose,globals,
+    fmodule,
+    aasmtai,aasmcpu,
     cutils,
-    globals,
-    defutil,
+    symconst,symsym,defutil,
     cgobj,
     cpubase,
     cpuinfo,
     cgcpu;
 
-  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef; weak: boolean): tcgpara;
+  function thlcgmips.a_call_name(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;
     var
       ref: treference;
       sym: tasmsymbol;
@@ -146,10 +148,139 @@ implementation
     end;
 
 
+  procedure thlcgmips.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+    var
+      href: treference;
+    begin
+      reference_reset_symbol(href,current_asmdata.RefAsmSymbol(externalname),0,sizeof(aint));
+      { Always do indirect jump using $t9, it won't harm in non-PIC mode }
+      if (cs_create_pic in current_settings.moduleswitches) then
+        begin
+          list.concat(taicpu.op_none(A_P_SET_NOREORDER));
+          list.concat(taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
+          href.base:=NR_GP;
+          href.refaddr:=addr_pic_call16;
+          list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
+          list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
+          { Delay slot }
+          list.Concat(taicpu.op_none(A_NOP));
+          list.Concat(taicpu.op_none(A_P_SET_REORDER));
+        end
+      else
+        begin
+          href.refaddr:=addr_high;
+          list.concat(taicpu.op_reg_ref(A_LUI,NR_PIC_FUNC,href));
+          href.refaddr:=addr_low;
+          list.concat(taicpu.op_reg_ref(A_ADDIU,NR_PIC_FUNC,href));
+          list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
+          { Delay slot }
+          list.Concat(taicpu.op_none(A_NOP));
+        end;
+    end;
+
+
+  procedure thlcgmips.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint);
+  var
+    make_global: boolean;
+    hsym: tsym;
+    href: treference;
+    paraloc: Pcgparalocation;
+    IsVirtual: boolean;
+  begin
+    if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
+      Internalerror(200006137);
+    if not assigned(procdef.struct) or
+      (procdef.procoptions * [po_classmethod, po_staticmethod,
+      po_methodpointer, po_interrupt, po_iocheck] <> []) then
+      Internalerror(200006138);
+    if procdef.owner.symtabletype <> objectsymtable then
+      Internalerror(200109191);
+
+    make_global := False;
+    if (not current_module.is_unit) or create_smartlink or
+      (procdef.owner.defowner.owner.symtabletype = globalsymtable) then
+      make_global := True;
+
+    if make_global then
+      List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
+    else
+      List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
+
+    IsVirtual:=(po_virtualmethod in procdef.procoptions) and
+        not is_objectpascal_helper(procdef.struct);
+
+    if (cs_create_pic in current_settings.moduleswitches) and
+      (not IsVirtual) then
+      begin
+        list.concat(Taicpu.op_none(A_P_SET_NOREORDER));
+        list.concat(Taicpu.op_reg(A_P_CPLOAD,NR_PIC_FUNC));
+        list.concat(Taicpu.op_none(A_P_SET_REORDER));
+      end;
+
+    { set param1 interface to self  }
+    procdef.init_paraloc_info(callerside);
+    hsym:=tsym(procdef.parast.Find('self'));
+    if not(assigned(hsym) and
+      (hsym.typ=paravarsym)) then
+      internalerror(2010103101);
+    paraloc:=tparavarsym(hsym).paraloc[callerside].location;
+    if assigned(paraloc^.next) then
+      InternalError(2013020101);
+
+    case paraloc^.loc of
+      LOC_REGISTER:
+        begin
+          if ((ioffset>=simm16lo) and (ioffset<=simm16hi)) then
+            cg.a_op_const_reg(list,OP_SUB, paraloc^.size,ioffset,paraloc^.register)
+          else
+            begin
+              cg.a_load_const_reg(list, paraloc^.size, ioffset, NR_R1);
+              cg.a_op_reg_reg(list, OP_SUB, paraloc^.size, NR_R1, paraloc^.register);
+            end;
+        end;
+    else
+      internalerror(2010103102);
+    end;
+
+    if IsVirtual then
+    begin
+      { load VMT pointer }
+      reference_reset_base(href,voidpointertype,paraloc^.register,0,sizeof(aint));
+      list.concat(taicpu.op_reg_ref(A_LW,NR_VMT,href));
+
+      if (procdef.extnumber=$ffff) then
+        Internalerror(200006139);
+
+      { TODO: case of large VMT is not handled }
+      { We have no reason not to use $t9 even in non-PIC mode. }
+      reference_reset_base(href, voidpointertype, NR_VMT, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint));
+      list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
+      list.concat(taicpu.op_reg(A_JR, NR_PIC_FUNC));
+    end
+    else if not (cs_create_pic in current_settings.moduleswitches) then
+      list.concat(taicpu.op_sym(A_J,current_asmdata.RefAsmSymbol(procdef.mangledname)))
+    else
+      begin
+        { GAS does not expand "J symbol" into PIC sequence }
+        reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint));
+        href.base:=NR_GP;
+        href.refaddr:=addr_pic_call16;
+        list.concat(taicpu.op_reg_ref(A_LW,NR_PIC_FUNC,href));
+        list.concat(taicpu.op_reg(A_JR,NR_PIC_FUNC));
+      end;
+    { Delay slot }
+    list.Concat(TAiCpu.Op_none(A_NOP));
+
+    List.concat(Tai_symbol_end.Createname(labelname));
+  end;
+
+
   procedure create_hlcodegen;
     begin
       hlcg:=thlcgmips.create;
       create_codegen;
     end;
 
+begin
+  chlcgobj:=thlcgmips;
 end.

compiler/mips/ncpucnv.pas

@@ -153,7 +153,7 @@ begin
     loadsigned(tfloatdef(resultdef).floattype)
   else
   begin
-    current_asmdata.getdatalabel(l1);
+    current_asmdata.getglobaldatalabel(l1);
     current_asmdata.getjumplabel(l2);
     reference_reset_symbol(href, l1, 0, sizeof(aint));
     hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
@@ -170,7 +170,7 @@ begin
         hregister := cg.getfpuregister(current_asmdata.CurrAsmList, OS_F64);
         new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(8));
         current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1));
-        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(4294967296.0));
+        current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s64real(4294967296.0));
 
         cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, OS_F64, OS_F64, href, hregister);
         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD_D, location.Register, hregister, location.Register));

compiler/mips/ncpumat.pas

@@ -28,6 +28,7 @@ unit ncpumat;
 interface
 
 uses
+  symtype,
   node, nmat, ncgmat, cgbase;
 
 type

compiler/mips/rgcpu.pas

@@ -27,7 +27,7 @@ unit rgcpu;
   interface
 
     uses
-      aasmbase,aasmcpu,aasmtai,aasmdata,
+      aasmbase,aasmsym,aasmcpu,aasmtai,aasmdata,
       cgbase,cgutils,
       cpubase,
       rgobj;
@@ -35,9 +35,9 @@ unit rgcpu;
     type
       trgcpu=class(trgobj)
         function get_spill_subreg(r : tregister) : tsubregister;override;
-        procedure do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-        procedure do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-        function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;override;
+        procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override;
+        function do_spill_replace(list: TAsmList; instr: tai_cpu_abstract_sym; orgreg: tsuperregister; const spilltemp: treference): boolean; override;
       end;
 
       trgintcpu=class(trgcpu)
@@ -61,7 +61,7 @@ implementation
       end;
 
 
-    procedure trgcpu.do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         helpins  : tai;
         tmpref   : treference;
@@ -89,11 +89,11 @@ implementation
             helplist.free;
           end
         else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
+          inherited;
       end;
 
 
-    procedure trgcpu.do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+    procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister);
       var
         tmpref   : treference;
         helplist : tasmlist;
@@ -122,11 +122,11 @@ implementation
             helplist.free;
           end
         else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
+          inherited;
     end;
 
 
-    function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+    function trgcpu.do_spill_replace(list: TAsmList; instr: tai_cpu_abstract_sym; orgreg: tsuperregister; const spilltemp: treference): boolean;
       begin
         result:=false;
         { Replace 'move  orgreg,src' with 'sw  src,spilltemp'

compiler/ncgadd.pas

@@ -38,7 +38,7 @@ interface
           { set the register of the result location }
           procedure set_result_location_reg;
           { load left and right nodes into registers }
-          procedure force_reg_left_right(allow_swap,allow_constant:boolean);
+          procedure force_reg_left_right(allow_swap,allow_constant:boolean); virtual;
 
           function cmpnode2topcmp(unsigned: boolean): TOpCmp;
 

compiler/ncgbas.pas

@@ -424,7 +424,7 @@ interface
               not(ti_const in tempinfo^.flags) then
               begin
                 location_reset_ref(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef),0);
-                tg.gethltemptyped(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.temptype,tempinfo^.location.reference);
+                tg.gethltempmanaged(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.temptype,tempinfo^.location.reference);
                 if not(ti_nofini in tempinfo^.flags) then
                   hlcg.g_finalize(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.location.reference);
               end

compiler/ncgcal.pas

@@ -35,12 +35,13 @@ interface
     type
        tcgcallparanode = class(tcallparanode)
        protected
-          tempcgpara : tcgpara;
           procedure push_addr_para;
           procedure push_value_para;virtual;
           procedure push_formal_para;virtual;
           procedure push_copyout_para;virtual;abstract;
        public
+          tempcgpara : tcgpara;
+
           constructor create(expr,next : tnode);override;
           destructor destroy;override;
           procedure secondcallparan;override;
@@ -56,10 +57,10 @@ interface
           procedure copy_back_paras;
           procedure release_para_temps;
           procedure reorder_parameters;
-          procedure pushparas;
           procedure freeparas;
        protected
           retloc: tcgpara;
+          paralocs: array of pcgpara;
 
           framepointer_paraloc : tcgpara;
           {# This routine is used to push the current frame pointer
@@ -95,7 +96,18 @@ interface
             on ref. }
           function can_call_ref(var ref: treference):boolean;virtual;
           procedure extra_call_ref_code(var ref: treference);virtual;
-          procedure do_call_ref(ref: treference);virtual;
+          function do_call_ref(ref: treference): tcgpara;virtual;
+
+          { store all the parameters in the temporary paralocs in their final
+            location, and create the paralocs array that will be passed to
+            hlcg.a_call_* }
+          procedure pushparas;virtual;
+
+          { loads the code pointer of a complex procvar (one with a self/
+            parentfp/... and a procedure address) into a register and returns it }
+          function load_complex_procvar_codeptr: tregister; virtual;
+          { loads the procvar code pointer into a register }
+          function load_procvar_codeptr: tregister;
 
           procedure load_block_invoke(toreg: tregister);virtual;
 
@@ -152,7 +164,6 @@ implementation
     procedure tcgcallnode.reorder_parameters;
       var
         hpcurr,hpprev,hpnext,hpreversestart : tcgcallparanode;
-        currloc : tcgloc;
       begin
         { All parameters are now in temporary locations. If we move them to
           their regular locations in the same order, then we get the
@@ -449,9 +460,11 @@ implementation
       end;
 
 
-    procedure tcgcallnode.do_call_ref(ref: treference);
+    function tcgcallnode.do_call_ref(ref: treference): tcgpara;
       begin
         InternalError(2014012901);
+        { silence warning }
+        result.init;
       end;
 
 
@@ -676,6 +689,7 @@ implementation
                end;
              ppn:=tcallparanode(ppn.right);
           end;
+        setlength(paralocs,0);
       end;
 
 
@@ -688,7 +702,7 @@ implementation
          htempref,
          href : treference;
          calleralignment,
-         tmpalignment: longint;
+         tmpalignment, i: longint;
          skipiffinalloc: boolean;
        begin
          { copy all resources to the allocated registers }
@@ -790,6 +804,60 @@ implementation
                end;
              ppn:=tcgcallparanode(ppn.right);
            end;
+         setlength(paralocs,procdefinition.paras.count);
+         for i:=0 to procdefinition.paras.count-1 do
+           paralocs[i]:=@tparavarsym(procdefinition.paras[i]).paraloc[callerside];
+       end;
+
+
+     function tcgcallnode.load_complex_procvar_codeptr: tregister;
+       var
+         srcreg: tregister;
+         codeprocdef: tabstractprocdef;
+       begin
+         { this is safe even on i8086, because procvardef code pointers are
+           always far there (so the current state of far calls vs the state
+           of far calls where the procvardef was defined does not matter,
+           even though the procvardef constructor called by getcopyas looks at
+           it) }
+         codeprocdef:=tabstractprocdef(procdefinition.getcopyas(procvardef,pc_address_only));
+         result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,codeprocdef);
+         { in case we have a method pointer on a big endian target in registers,
+           the method address is stored in registerhi (it's the first field
+           in the tmethod record) }
+         if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+           begin
+             if not(right.location.size in [OS_PAIR,OS_SPAIR]) then
+               internalerror(2014081401);
+             if (target_info.endian=endian_big) then
+               srcreg:=right.location.registerhi
+             else
+               srcreg:=right.location.register;
+             hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,codeprocdef,codeprocdef,srcreg,result)
+           end
+         else
+           begin
+             hlcg.location_force_mem(current_asmdata.CurrAsmList,right.location,procdefinition);
+             hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,getpointerdef(procdefinition),getpointerdef(codeprocdef),right.location.reference);
+             hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,codeprocdef,codeprocdef,right.location.reference,result);
+           end;
+       end;
+
+
+     function tcgcallnode.load_procvar_codeptr: tregister;
+       begin
+         if po_is_block in procdefinition.procoptions then
+           begin
+             result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition);
+             load_block_invoke(result);
+           end
+         else if not(procdefinition.is_addressonly) then
+           result:=load_complex_procvar_codeptr
+         else
+           begin
+             result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition);
+             hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,procdefinition,procdefinition,right.location,result);
+           end;
        end;
 
 
@@ -859,17 +927,22 @@ implementation
           begin
             { The forced returntype may have a different size than the one
               declared for the procdef }
-            if not assigned(typedef) then
-              retloc:=procdefinition.funcretloc[callerside]
-            else
-              retloc:=paramanager.get_funcretloc(procdefinition,callerside,typedef);
+            retloc:=hlcg.get_call_result_cgpara(procdefinition,typedef);
             retlocitem:=retloc.location;
             while assigned(retlocitem) do
               begin
                 case retlocitem^.loc of
                   LOC_REGISTER:
-
-                    include(regs_to_save_int,getsupreg(retlocitem^.register));
+                    case getregtype(retlocitem^.register) of
+                      R_INTREGISTER:
+                        include(regs_to_save_int,getsupreg(retlocitem^.register));
+                      R_ADDRESSREGISTER:
+                        include(regs_to_save_address,getsupreg(retlocitem^.register));
+                      R_TEMPREGISTER:
+                        ;
+                      else
+                        internalerror(2014020102);
+                      end;
                   LOC_FPUREGISTER:
                     include(regs_to_save_fpu,getsupreg(retlocitem^.register));
                   LOC_MMREGISTER:
@@ -990,11 +1063,12 @@ implementation
 
                  { call method }
                  extra_call_code;
+                 retloc.resetiftemp;
                  if callref then
-                   do_call_ref(href)
+                   retloc:=do_call_ref(href)
                  else
                    begin
-                     hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
+                     retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg,paralocs);
                      unget_call_reg(current_asmdata.CurrAsmList,pvreg);
                    end;
 
@@ -1029,12 +1103,13 @@ implementation
                       if (po_interrupt in procdefinition.procoptions) then
                         extra_interrupt_code;
                       extra_call_code;
+                      retloc.resetiftemp;
                       if (name_to_call='') then
                         name_to_call:=tprocdef(procdefinition).mangledname;
                       if cnf_inherited in callnodeflags then
-                        hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call)
+                        retloc:=hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs)
                       else
-                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,typedef,po_weakexternal in procdefinition.procoptions).resetiftemp;
+                        retloc:=hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,paralocs,typedef,po_weakexternal in procdefinition.procoptions);
                       extra_post_call_code;
                     end;
                end;
@@ -1043,31 +1118,20 @@ implementation
            { now procedure variable case }
            begin
               secondpass(right);
-              callref:=false;
 
-              pvreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,proc_addr_voidptrdef);
-              { Only load OS_ADDR from the reference (when converting to hlcg:
-                watch out with procedure of object) }
-              if po_is_block in procdefinition.procoptions then
-                load_block_invoke(pvreg)
-              else if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+              { can we directly call the procvar in a memory location? }
+              callref:=false;
+              if not(po_is_block in procdefinition.procoptions) and
+                 (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                 begin
                   href:=right.location.reference;
                   callref:=can_call_ref(href);
-                  if not callref then
-                    cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,right.location.reference,pvreg)
-                end
-              else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                begin
-                  { in case left is a method pointer and we are on a big endian target, then
-                    the method address is stored in registerhi }
-                  if (target_info.endian=endian_big) and (right.location.size in [OS_PAIR,OS_SPAIR]) then
-                    hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,proc_addr_voidptrdef,proc_addr_voidptrdef,right.location.registerhi,pvreg)
-                  else
-                    hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,proc_addr_voidptrdef,proc_addr_voidptrdef,right.location.register,pvreg);
-                end
+                end;
+
+              if not callref then
+                pvreg:=load_procvar_codeptr
               else
-                hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,proc_addr_voidptrdef,proc_addr_voidptrdef,right.location,pvreg);
+                pvreg:=NR_INVALID;
               location_freetemp(current_asmdata.CurrAsmList,right.location);
 
               { Load parameters that are in temporary registers in the
@@ -1097,10 +1161,11 @@ implementation
                 extra_interrupt_code;
               extra_call_code;
 
+              retloc.resetiftemp;
               if callref then
-                do_call_ref(href)
+                retloc:=do_call_ref(href)
               else
-                hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg);
+                retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg,paralocs);
               extra_post_call_code;
            end;
 
@@ -1134,10 +1199,16 @@ implementation
                begin
                  case retlocitem^.loc of
                    LOC_REGISTER:
-                     if getregtype(retlocitem^.register)=R_INTREGISTER then
-                       exclude(regs_to_save_int,getsupreg(retlocitem^.register))
-                     else
-                       exclude(regs_to_save_address,getsupreg(retlocitem^.register));
+                     case getregtype(retlocitem^.register) of
+                       R_INTREGISTER:
+                         exclude(regs_to_save_int,getsupreg(retlocitem^.register));
+                       R_ADDRESSREGISTER:
+                         exclude(regs_to_save_address,getsupreg(retlocitem^.register));
+                       R_TEMPREGISTER:
+                         ;
+                       else
+                         internalerror(2014020103);
+                     end;
                    LOC_FPUREGISTER:
                      exclude(regs_to_save_fpu,getsupreg(retlocitem^.register));
                    LOC_MMREGISTER:
@@ -1203,9 +1274,7 @@ implementation
             (right=nil) and
             not(po_virtualmethod in procdefinition.procoptions) then
            begin
-              cg.allocallcpuregisters(current_asmdata.CurrAsmList);
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false);
-              cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_iocheck',[],nil).resetiftemp;
            end;
       end;
 

compiler/ncgcnv.pas

@@ -148,7 +148,7 @@ interface
               begin
                 location.register := cg.getintregister(current_asmdata.CurrAsmList,newsize);
                 location.loc := LOC_REGISTER;
-                cg.a_load_reg_reg(current_asmdata.CurrAsmList,orgsize,newsize,left.location.register,location.register);
+                hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
               end;
           end;
       end;
@@ -433,7 +433,7 @@ interface
                hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
              { round them down to the proper precision }
              tg.gethltemp(current_asmdata.currasmlist,resultdef,resultdef.size,tt_normal,tr);
-             cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr);
+             hlcg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,tr);
              location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment);
              left.location.reference:=tr;
              left.resultdef:=resultdef;
@@ -490,12 +490,12 @@ interface
                     begin
                       hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
                       location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-                      cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
+                      hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
                     end;
                   LOC_MMREGISTER:
                     begin
-                      location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size);
-                      cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar);
+                      location.register:=hlcg.getmmregister(current_asmdata.CurrAsmList,resultdef);
+                      hlcg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register,mms_movescalar);
                     end;
                   else
                     internalerror(2003012261);
@@ -533,7 +533,7 @@ interface
                     begin
                       { the procedure symbol is encoded in reference.symbol -> take address }
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
-                      hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,voidcodepointertype,left.location.reference,location.register);
+                      hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.reference,location.register);
                     end;
                   else
                     internalerror(2013031501)

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)
@@ -73,10 +76,11 @@ implementation
     uses
       globtype,widestr,systems,
       verbose,globals,cutils,
+      aasmcnst,
       symconst,symdef,aasmtai,aasmdata,aasmcpu,defutil,
       cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
-      ncgutil,hlcgobj,symtype,cclasses,asmutils,tgobj
+      ncgutil,hlcgobj,cclasses,tgobj
       ;
 
 
@@ -91,7 +95,7 @@ implementation
         b : byte;
       begin
         location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(maxalign));
-        current_asmdata.getdatalabel(l);
+        current_asmdata.getglobaldatalabel(l);
         maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
         new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l.name,const_align(maxalign));
         current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l));
@@ -112,8 +116,8 @@ implementation
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
       const
-        floattype2ait:array[tfloattype] of taitype=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
+        floattype2ait:array[tfloattype] of tairealconsttype=
+          (aitrealconst_s32bit,aitrealconst_s64bit,aitrealconst_s80bit,aitrealconst_s80bit,aitrealconst_s64comp,aitrealconst_s64comp,aitrealconst_s128bit);
 
       { Since the value is stored always as bestreal, we share a single pool
         between all float types. This requires type and hiloswapped flag to
@@ -127,7 +131,7 @@ implementation
 
       var
          lastlabel : tasmlabel;
-         realait : taitype;
+         realait : tairealconsttype;
          entry : PHashSetItem;
          key: tfloatkey;
 {$ifdef ARM}
@@ -158,64 +162,64 @@ implementation
              { :-(, we must generate a new entry }
              if not(assigned(lab_real)) then
                begin
-                  current_asmdata.getdatalabel(lastlabel);
+                  current_asmdata.getglobaldatalabel(lastlabel);
                   entry^.Data:=lastlabel;
                   lab_real:=lastlabel;
                   maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
                   new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(resultdef.alignment));
                   current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel));
                   case realait of
-                    ait_real_32bit :
+                    aitrealconst_s32bit :
                       begin
-                        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real)));
+                        current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s32real(ts32real(value_real)));
                         { range checking? }
                         if floating_point_range_check_error and
-                          (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                           (tai_realconst(current_asmdata.asmlists[al_typedconsts].last).value.s32val=MathInf.Value) then
                           Message(parser_e_range_check_error);
                       end;
 
-                    ait_real_64bit :
+                    aitrealconst_s64bit :
                       begin
 {$ifdef ARM}
                         if hiloswapped then
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
+                          current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s64real_hiloswapped(ts64real(value_real)))
                         else
 {$endif ARM}
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real)));
+                          current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s64real(ts64real(value_real)));
 
                         { range checking? }
                         if floating_point_range_check_error and
-                          (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                           (tai_realconst(current_asmdata.asmlists[al_typedconsts].last).value.s64val=MathInf.Value) then
                           Message(parser_e_range_check_error);
                      end;
 
-                    ait_real_80bit :
+                    aitrealconst_s80bit :
                       begin
-                        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real,resultdef.size));
+                        current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s80real(value_real,tfloatdef(resultdef).size));
 
                         { range checking? }
                         if floating_point_range_check_error and
-                          (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                           (tai_realconst(current_asmdata.asmlists[al_typedconsts].last).value.s80val=MathInf.Value) then
                           Message(parser_e_range_check_error);
                       end;
 {$ifdef cpufloat128}
-                    ait_real_128bit :
+                    aitrealconst_s128bit :
                       begin
-                        current_asmdata.asmlists[al_typedconsts].concat(Tai_real_128bit.Create(value_real));
+                        current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s128real(value_real));
 
                         { range checking? }
                         if floating_point_range_check_error and
-                          (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then
+                           (tai_realconst(current_asmdata.asmlists[al_typedconsts].last).value.s128val=MathInf.Value) then
                           Message(parser_e_range_check_error);
                       end;
 {$endif cpufloat128}
 
                     { the round is necessary for native compilers where comp isn't a float }
-                    ait_comp_64bit :
+                    aitrealconst_s64comp :
                       if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
                         message(parser_e_range_check_error)
                       else
-                        current_asmdata.asmlists[al_typedconsts].concat(Tai_comp_64bit.Create(round(value_real)));
+                        current_asmdata.asmlists[al_typedconsts].concat(tai_realconst.create_s64compreal(round(value_real)));
                   else
                     internalerror(10120);
                   end;
@@ -260,12 +264,13 @@ implementation
          lastlabel: tasmlabofs;
          pc: pchar;
          l: longint;
-         href: treference;
          pool: THashSet;
          entry: PHashSetItem;
          winlikewidestring: boolean;
          elementdef: tdef;
          strpointerdef: tdef;
+         datatcb: ttai_typedconstbuilder;
+         datadef: tdef;
 
       const
         PoolMap: array[tconststringtype] of TConstPoolType = (
@@ -320,6 +325,7 @@ implementation
               { :-(, we must generate a new entry }
               if not assigned(entry^.Data) then
                 begin
+                  datatcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);
                    case cst_type of
                       cst_ansistring:
                         begin
@@ -327,12 +333,15 @@ 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:=datatcb.emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding);
                                { because we hardcode the offset below due to it
                                  not being stored in the hashset, check here }
-                               if lastlabel.ofs<>get_string_symofs(st_ansistring,false) then
+                               if lastlabel.ofs<>datatcb.get_string_symofs(st_ansistring,false) then
                                  internalerror(2012051703);
                              end;
+                           { no contents of the datatcb itself to concatenate,
+                             as we will just return the address of the emitted
+                             ansistring constant record }
                         end;
                       cst_unicodestring,
                       cst_widestring:
@@ -341,23 +350,23 @@ implementation
                              InternalError(2008032302)   { empty string should be handled above }
                            else
                              begin
-                               lastlabel := emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
+                               lastlabel:=datatcb.emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
                                                value_str,
                                                tstringdef(resultdef).encoding,
                                                winlikewidestring);
                                { because we hardcode the offset below due to it
                                  not being stored in the hashset, check here }
-                               if lastlabel.ofs<>get_string_symofs(tstringdef(resultdef).stringtype,winlikewidestring) then
+                               if lastlabel.ofs<>datatcb.get_string_symofs(tstringdef(resultdef).stringtype,winlikewidestring) then
                                  internalerror(2012051704);
                              end;
+                           { no contents of the datatcb itself to concatenate,
+                             as we will just return the address of the emitted
+                             unicode/widestring constant record }
                         end;
                       cst_shortstring:
                         begin
-                          current_asmdata.getdatalabel(lastlabel.lab);
-                          maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                          new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)));
+                          current_asmdata.getglobaldatalabel(lastlabel.lab);
 
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel.lab));
                           { truncate strings larger than 255 chars }
                           if len>255 then
                            l:=255
@@ -368,23 +377,38 @@ implementation
                           move(value_str^,pc[1],l);
                           pc[0]:=chr(l);
                           pc[l+1]:=#0;
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,l+2));
+                          datadef:=getarraydef(cansichartype,l+1);
+                          datatcb.maybe_begin_aggregate(datadef);
+                          datatcb.emit_tai(Tai_string.Create_pchar(pc,l+1),datadef);
+                          datatcb.maybe_end_aggregate(datadef);
+                          current_asmdata.asmlists[al_typedconsts].concatList(
+                            datatcb.get_final_asmlist(lastlabel.lab,datadef,sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)))
+                          );
                         end;
                       cst_conststring:
                         begin
-                          current_asmdata.getdatalabel(lastlabel.lab);
-                          maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
-                          new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)));
+                          current_asmdata.getglobaldatalabel(lastlabel.lab);
 
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel.lab));
+                          datatcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);
                           { include terminating zero }
                           getmem(pc,len+1);
                           move(value_str^,pc[0],len);
                           pc[len]:=#0;
-                          current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1));
+                          { the data includes the terminating #0 because this
+                            string can be used for pchar assignments (but it's
+                            also used for array-of-char assignments, in which
+                            case the terminating #0 is not part of the data) }
+                          datadef:=getarraydef(cansichartype,len+1);
+                          datatcb.maybe_begin_aggregate(datadef);
+                          datatcb.emit_tai(Tai_string.Create_pchar(pc,len+1),datadef);
+                          datatcb.maybe_end_aggregate(datadef);
+                          current_asmdata.asmlists[al_typedconsts].concatList(
+                            datatcb.get_final_asmlist(lastlabel.lab,datadef,sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)))
+                          );
                         end;
                       else
                         internalerror(2013120103);
+                      datatcb.free;
                    end;
                    lab_str:=lastlabel.lab;
                    entry^.Data:=lastlabel.lab;
@@ -393,11 +417,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,
-               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
@@ -407,6 +428,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
 *****************************************************************************}
@@ -419,7 +451,7 @@ implementation
         lab: tasmlabel;
         i: longint;
       begin
-        current_asmdata.getdatalabel(lab);
+        current_asmdata.getglobaldatalabel(lab);
         result:=lab;
         lab_set:=lab;
         maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
@@ -501,7 +533,7 @@ implementation
                  { :-(, we must generate a new entry }
                  if not assigned(entry^.Data) then
                    begin
-                     current_asmdata.getdatalabel(lastlabel);
+                     current_asmdata.getglobaldatalabel(lastlabel);
                      lab_set:=lastlabel;
                      entry^.Data:=lastlabel;
                      maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);
@@ -561,7 +593,7 @@ implementation
              { :-(, we must generate a new entry }
              if not assigned(entry^.Data) then
                begin
-                 current_asmdata.getdatalabel(lastlabel);
+                 current_asmdata.getglobaldatalabel(lastlabel);
                  lab_set:=lastlabel;
                  entry^.Data:=lastlabel;
                  maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]);

compiler/ncgflw.pas

@@ -979,7 +979,7 @@ implementation
     { in the except block                                    }
     procedure cleanupobjectstack;
       begin
-         cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION');
+         hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_doneexception',[],nil);
       end;
 
     { generates code to be executed when another exeception is raised while
@@ -991,12 +991,12 @@ implementation
          { don't generate line info for internal cleanup }
          list.concat(tai_marker.create(mark_NoLineInfoStart));
          current_asmdata.getjumplabel(exitlabel);
-         cg.a_label(list,entrylabel);
+         hlcg.a_label(list,entrylabel);
          free_exception(list,t,0,exitlabel,false);
          { we don't need to save/restore registers here because reraise never }
          { returns                                                            }
-         cg.a_call_name(list,'FPC_RAISE_NESTED',false);
-         cg.a_label(list,exitlabel);
+         hlcg.g_call_system_proc(list,'fpc_raise_nested',[],nil);
+         hlcg.a_label(list,exitlabel);
          cleanupobjectstack;
       end;
 
@@ -1082,11 +1082,11 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,exceptlabel);
 
          free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false);
 
-         cg.a_label(current_asmdata.CurrAsmList,doexceptlabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,doexceptlabel);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -1108,7 +1108,7 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cg.a_label(current_asmdata.CurrAsmList,lastonlabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,lastonlabel);
          { default handling except handling }
          if assigned(t1) then
            begin
@@ -1138,93 +1138,81 @@ implementation
                  handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise);
 
                  unget_exception_temps(current_asmdata.CurrAsmList,destroytemps);
-                 cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
                end
                else
                  begin
                    exceptflowcontrol:=flowcontrol;
                    cleanupobjectstack;
-                   cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+                   hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
                  end;
            end
          else
            begin
-              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
               exceptflowcontrol:=flowcontrol;
            end;
 
          if fc_exit in exceptflowcontrol then
            begin
               { do some magic for exit in the try block }
-              cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
+              hlcg.a_label(current_asmdata.CurrAsmList,exitexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
               cleanupobjectstack;
-              cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
            end;
 
          if fc_break in exceptflowcontrol then
            begin
-              cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
+              hlcg.a_label(current_asmdata.CurrAsmList,breakexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
               cleanupobjectstack;
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
            end;
 
          if fc_continue in exceptflowcontrol then
            begin
-              cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
+              hlcg.a_label(current_asmdata.CurrAsmList,continueexceptlabel);
               { we must also destroy the address frame which guards }
               { exception object                                    }
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
               cleanupobjectstack;
-              cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
            end;
 
          if fc_exit in tryflowcontrol then
            begin
               { do some magic for exit in the try block }
-              cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
-              cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+              hlcg.a_label(current_asmdata.CurrAsmList,exittrylabel);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
+              hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
            end;
 
          if fc_break in tryflowcontrol then
            begin
-              cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              hlcg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
            end;
 
          if fc_continue in tryflowcontrol then
            begin
-              cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
-              cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK');
-              cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+              hlcg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
+              hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_popaddrstack',[],nil);
+              hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
               cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
-              { from g_exception_reason_load  }
-              cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
            end;
          unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
@@ -1283,7 +1271,7 @@ implementation
          paramanager.getintparaloc(pd,1,paraloc1);
          cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc1);
          paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
-         fpc_catches_res:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,nil);
+         fpc_catches_res:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@paraloc1],nil);
          location_reset(fpc_catches_resloc,LOC_REGISTER,def_cgsize(fpc_catches_res.def));
          fpc_catches_resloc.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,fpc_catches_res.def);
          hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,fpc_catches_res.def,fpc_catches_res,fpc_catches_resloc,true);
@@ -1427,6 +1415,7 @@ implementation
          oldBreakLabel : tasmlabel;
          oldflowcontrol,tryflowcontrol : tflowcontrol;
          excepttemps : texceptiontemps;
+         reasonreg : tregister;
       begin
          location_reset(location,LOC_VOID,OS_NO);
          tryflowcontrol:=[];
@@ -1483,7 +1472,7 @@ implementation
          { don't generate line info for internal cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
-         cg.a_label(current_asmdata.CurrAsmList,finallylabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,finallylabel);
          { just free the frame information }
          free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallylabel,true);
 
@@ -1504,12 +1493,11 @@ implementation
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
 
          { the value should now be in the exception handler }
-         cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
+         reasonreg:=hlcg.getintregister(current_asmdata.CurrAsmList,osuinttype);
+         hlcg.g_exception_reason_load(current_asmdata.CurrAsmList,osuinttype,osuinttype,excepttemps.reasonbuf,reasonreg);
          if implicitframe then
            begin
-             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel);
-             { from g_exception_reason_load  }
-             cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
              { finally code only needed to be executed on exception }
              flowcontrol:=[fc_inflowcontrol];
              secondpass(t1);
@@ -1521,50 +1509,43 @@ implementation
                 (current_procinfo.procdef.proccalloption=pocall_safecall) then
                handle_safecall_exception
              else
-                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+                hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
            end
          else
            begin
-             cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel);
+             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
              if fc_exit in tryflowcontrol then
-               cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,2,NR_FUNCTION_RESULT_REG,oldCurrExitLabel);
+               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,2,reasonreg,oldCurrExitLabel);
              if fc_break in tryflowcontrol then
-               cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,3,NR_FUNCTION_RESULT_REG,oldBreakLabel);
+               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,3,reasonreg,oldBreakLabel);
              if fc_continue in tryflowcontrol then
-               cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,4,NR_FUNCTION_RESULT_REG,oldContinueLabel);
-             cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
-             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
+               hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,4,reasonreg,oldContinueLabel);
+             hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_reraise',[],nil);
              { do some magic for exit,break,continue in the try block }
              if fc_exit in tryflowcontrol then
                begin
-                  cg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
-                  cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
-                  cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,2);
-                  cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
-                  { from g_exception_reason_load  }
-                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+                  hlcg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
+                  hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
+                  hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,2,excepttemps.reasonbuf);
+                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
                end;
              if fc_break in tryflowcontrol then
               begin
-                 cg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
-                 cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
-                 cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,3);
-                 cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
-                  { from g_exception_reason_load  }
-                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+                 hlcg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
+                 hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
+                 hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,3,excepttemps.reasonbuf);
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
                end;
              if fc_continue in tryflowcontrol then
                begin
-                  cg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
-                  cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
-                  cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,4);
-                  cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
-                  { from g_exception_reason_load  }
-                  cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
+                  hlcg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
+                  hlcg.g_exception_reason_discard(current_asmdata.CurrAsmList,osuinttype,excepttemps.reasonbuf);
+                  hlcg.g_exception_reason_save_const(current_asmdata.CurrAsmList,osuinttype,4,excepttemps.reasonbuf);
+                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
                end;
            end;
          unget_exception_temps(current_asmdata.CurrAsmList,excepttemps);
-         cg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
+         hlcg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
 
          { end cleanup }
          current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));

compiler/ncghlmat.pas

@@ -0,0 +1,76 @@
+{
+    Copyright (c) 2014 Jonas Maebe
+
+    Generate high level target code for math nodes
+
+    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 ncghlmat;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  node,
+  ncgmat;
+
+type
+
+  tcghlnotnode = class(tcgnotnode)
+    function pass_1: tnode; override;
+   protected
+    procedure second_boolean; override;
+  end;
+
+implementation
+
+uses
+  aasmbase,aasmdata,
+  defutil,
+  procinfo,
+  cgbase,pass_2,hlcgobj;
+
+{*****************************************************************************
+                               tcghlnotnode
+*****************************************************************************}
+
+function tcghlnotnode.pass_1: tnode;
+  begin
+    result:=inherited;
+    if not assigned(result) and
+       is_boolean(resultdef) then
+      expectloc:=LOC_JUMP;
+  end;
+
+
+procedure tcghlnotnode.second_boolean;
+  var
+    hl : tasmlabel;
+  begin
+    hl:=current_procinfo.CurrTrueLabel;
+    current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
+    current_procinfo.CurrFalseLabel:=hl;
+    secondpass(left);
+    hlcg.maketojumpbool(current_asmdata.CurrAsmList,left);
+    hl:=current_procinfo.CurrTrueLabel;
+    current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel;
+    current_procinfo.CurrFalseLabel:=hl;
+    location.loc:=LOC_JUMP;
+  end;
+
+end.

compiler/ncginl.pas

@@ -68,7 +68,7 @@ implementation
     uses
       globtype,systems,constexp,
       cutils,verbose,globals,
-      symconst,symdef,defutil,symsym,
+      symconst,symtype,symdef,defutil,symsym,
       aasmbase,aasmtai,aasmdata,aasmcpu,parabase,
       cgbase,pass_1,pass_2,
       cpuinfo,cpubase,paramgr,procinfo,
@@ -287,6 +287,7 @@ implementation
       var
         lengthlab : tasmlabel;
         hregister : tregister;
+        lendef : tdef;
         href : treference;
       begin
         secondpass(left);
@@ -301,24 +302,28 @@ implementation
            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
            current_asmdata.getjumplabel(lengthlab);
            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location.register,lengthlab);
-           if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then
-             begin
-               hlcg.reference_reset_base(href,left.resultdef,left.location.register,-sizeof(dword),sizeof(dword));
-               hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT);
-               cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_INT,href,hregister);
-             end
+           { the length of a widestring is a 32 bit unsigned int. Since every
+             character occupies 2 bytes, on a 32 bit platform you can express
+             the maximum length using 31 bits. On a 64 bit platform, it may be
+             32 bits. This means that regardless of the platform, a location
+             with size OS_SINT/ossinttype can hold the length without
+             overflowing (this code returns an ossinttype value) }
+           if is_widestring(left.resultdef) then
+             lendef:=u32inttype
            else
-             begin
-               hlcg.reference_reset_base(href,left.resultdef,left.location.register,-sizeof(pint),sizeof(pint));
-               hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT);
-               cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hregister);
-             end;
+             lendef:=ossinttype;
+           hlcg.reference_reset_base(href,left.resultdef,left.location.register,-lendef.size,lendef.alignment);
+           { if the string pointer is nil, the length is 0 -> reuse the register
+             that originally held the string pointer for the length, so that we
+             can keep the original nil/0 as length in that case }
+           hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,def_cgsize(resultdef));
+           hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,lendef,resultdef,href,hregister);
            if is_widestring(left.resultdef) then
-             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister);
+             hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,resultdef,1,hregister);
 
            { Dynamic arrays do not have their length attached but their maximum index }
            if is_dynamic_array(left.resultdef) then
-             cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,1,hregister);
+             hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,1,hregister);
 
            cg.a_label(current_asmdata.CurrAsmList,lengthlab);
            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));

compiler/ncgld.pas

@@ -263,6 +263,7 @@ implementation
         endrelocatelab,
         norelocatelab : tasmlabel;
         paraloc1 : tcgpara;
+        vd,
         pvd : tdef;
       begin
         { we don't know the size of all arrays }
@@ -447,10 +448,11 @@ implementation
                       hregister:=location.register
                     else
                       begin
-                        hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidpointertype);
+                        vd:=getpointerdef(resultdef);
+                        hregister:=hlcg.getaddressregister(current_asmdata.CurrAsmList,vd);
                         { we need to load only an address }
-                        location.size:=int_cgsize(voidpointertype.size);
-                        hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,voidpointertype,voidpointertype,location,hregister);
+                        location.size:=int_cgsize(vd.size);
+                        hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,vd,vd,location,hregister);
                       end;
                     { assume packed records may always be unaligned }
                     if not(resultdef.typ in [recorddef,objectdef]) or
@@ -742,6 +744,7 @@ implementation
                     LOC_REGISTER,
                     LOC_CREGISTER :
                       begin
+{$ifndef cpuhighleveltarget}
 {$ifdef cpu64bitalu}
                         if left.location.size in [OS_128,OS_S128] then
                           cg128.a_load128_ref_reg(current_asmdata.CurrAsmList,right.location.reference,left.location.register128)
@@ -751,6 +754,7 @@ implementation
                           cg64.a_load64_ref_reg(current_asmdata.CurrAsmList,right.location.reference,left.location.register64)
                         else
 {$endif cpu64bitalu}
+{$endif not cpuhighleveltarget}
                           hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,right.resultdef,left.resultdef,right.location.reference,left.location.register);
                       end;
                     LOC_FPUREGISTER,
@@ -881,6 +885,7 @@ implementation
               LOC_REGISTER,
               LOC_CREGISTER :
                 begin
+{$ifndef cpuhighleveltarget}
 {$ifdef cpu64bitalu}
                   if left.location.size in [OS_128,OS_S128] then
                     cg128.a_load128_reg_loc(current_asmdata.CurrAsmList,
@@ -893,6 +898,7 @@ implementation
                       right.location.register64,left.location)
                   else
 {$endif cpu64bitalu}
+{$endif not cpuhighleveltarget}
 {$ifdef i8086}
                   { prefer a_load_loc_ref, because it supports i8086-specific types
                     that use registerhi (like 6-byte method pointers)
@@ -1331,6 +1337,7 @@ implementation
                      end;
                    else
                      begin
+{$ifndef cpuhighleveltarget}
 {$ifdef cpu64bitalu}
                        if hp.left.location.size in [OS_128,OS_S128] then
                          cg128.a_load128_loc_ref(current_asmdata.CurrAsmList,hp.left.location,href)
@@ -1340,6 +1347,7 @@ implementation
                          cg64.a_load64_loc_ref(current_asmdata.CurrAsmList,hp.left.location,href)
                        else
 {$endif cpu64bitalu}
+{$endif not cpuhighleveltarget}
                          hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,eledef,eledef,hp.left.location,href);
                      end;
                  end;

compiler/ncgmat.pas

@@ -26,6 +26,7 @@ unit ncgmat;
 interface
 
     uses
+      symtype,
       node,nmat,cpubase,cgbase;
 
     type
@@ -41,7 +42,7 @@ interface
            point values are stored in the register
            in IEEE-754 format.
          }
-         procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
+         procedure emit_float_sign_change(r: tregister; _size : tdef);virtual;
 {$ifdef SUPPORT_MMX}
          procedure second_mmx;virtual;abstract;
 {$endif SUPPORT_MMX}
@@ -129,7 +130,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symtable,symconst,symtype,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
+      symtable,symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
       parabase,
       pass_2,
       ncon,
@@ -143,7 +144,7 @@ implementation
                           TCGUNARYMINUSNODE
 *****************************************************************************}
 
-    procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tcgsize);
+    procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tdef);
       var
         href,
         href2 : treference;
@@ -151,30 +152,34 @@ implementation
         { get a temporary memory reference to store the floating
           point value
         }
-        tg.gettemp(current_asmdata.CurrAsmList,tcgsize2size[_size],tcgsize2size[_size],tt_normal,href);
+        tg.gethltemp(current_asmdata.CurrAsmList,_size,_size.size,tt_normal,href);
         { store the floating point value in the temporary memory area }
-        cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,_size,_size,r,href);
+        hlcg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,_size,_size,r,href);
         { only single and double ieee are supported, for little endian
           the signed bit is in the second dword }
         href2:=href;
-        case _size of
-          OS_F64 :
+        if _size.typ<>floatdef then
+          internalerror(2014012211);
+        case tfloatdef(_size).floattype of
+          s64real,
+          s64comp,
+          s64currency:
             if target_info.endian = endian_little then
               inc(href2.offset,4);
-          OS_F32 :
+          s32real :
             ;
           else
             internalerror(200406021);
         end;
         { flip sign-bit (bit 31/63) of single/double }
-        cg.a_op_const_ref(current_asmdata.CurrAsmList,OP_XOR,OS_32,
+        hlcg.a_op_const_ref(current_asmdata.CurrAsmList,OP_XOR,u32inttype,
 {$ifdef cpu64bitalu}
           aint($80000000),
 {$else cpu64bitalu}
           longint($80000000),
 {$endif cpu64bitalu}
           href2);
-        cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,_size,_size,href,r);
+        hlcg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,_size,_size,href,r);
         tg.ungetiftemp(current_asmdata.CurrAsmList,href);
       end;
 
@@ -233,21 +238,21 @@ implementation
           LOC_CREFERENCE :
             begin
               location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-              cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,
-                 left.location.size,location.size,
+              hlcg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,
+                 left.resultdef,resultdef,
                  left.location.reference,location.register);
-              emit_float_sign_change(location.register,def_cgsize(left.resultdef));
+              emit_float_sign_change(location.register,left.resultdef);
             end;
           LOC_FPUREGISTER:
             begin
                location.register:=left.location.register;
-               emit_float_sign_change(location.register,def_cgsize(left.resultdef));
+               emit_float_sign_change(location.register,left.resultdef);
             end;
           LOC_CFPUREGISTER:
             begin
                location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-               cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register);
-               emit_float_sign_change(location.register,def_cgsize(left.resultdef));
+               hlcg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location.register,location.register);
+               emit_float_sign_change(location.register,left.resultdef);
             end;
           else
             internalerror(200306021);
@@ -281,7 +286,7 @@ implementation
           begin
             current_asmdata.getjumplabel(hl);
             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_NE,torddef(opsize).low.svalue,location.register,hl);
-            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',nil);
+            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil);
             hlcg.a_label(current_asmdata.CurrAsmList,hl);
           end;
       end;