Pārlūkot izejas kodu

* moved g_external_wrapper() to the hlcg, and also g_intf_wrapper() because
for some platforms it depends on that routine

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

Jonas Maebe 11 gadi atpakaļ
vecāks
revīzija
b745dcc64c

+ 0 - 165
compiler/arm/cgcpu.pas

@@ -92,8 +92,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;
@@ -3143,169 +3141,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]));
-                  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;
-              list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
-            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);
-              list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
-            end;
-        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);
-
-        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_reg(A_MOV,NR_PC,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];

+ 180 - 4
compiler/arm/hlcgcpu.pas

@@ -28,20 +28,196 @@ 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,
-    cgcpu;
+    globtype,verbose,
+    procinfo,fmodule,
+    symconst,
+    aasmbase,aasmtai,aasmcpu,
+    hlcgobj,
+    cgbase, cgutils, cpubase, cgobj, cgcpu;
+
+  procedure thlcgcpu.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]));
+                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;
+            list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
+          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);
+            list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
+          end;
+      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);
+
+      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_reg(A_MOV,NR_PC,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 create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
 begin
-  chlcgobj:=thlcg2ll;
+  chlcgobj:=thlcgcpu;
 end.

+ 0 - 7
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;

+ 19 - 3
compiler/avr/hlcgcpu.pas

@@ -28,20 +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:=thlcg2ll;
+  chlcgobj:=thlcgcpu;
 end.

+ 0 - 7
compiler/cghlcpu.pas

@@ -45,7 +45,6 @@ uses
       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;
@@ -186,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);

+ 0 - 13
compiler/cgobj.pas

@@ -417,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 }
@@ -2368,12 +2361,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);

+ 1 - 1
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^);

+ 0 - 12
compiler/hlcg2ll.pas

@@ -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;
@@ -989,11 +982,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);

+ 6 - 1
compiler/hlcgobj.pas

@@ -517,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);
@@ -3720,6 +3720,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

+ 0 - 178
compiler/i386/cgcpu.pas

@@ -48,7 +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_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
         procedure g_maybe_got_init(list: TAsmList); override;
      end;
 
@@ -582,183 +581,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);

+ 182 - 1
compiler/i386/hlcgcpu.pas

@@ -47,6 +47,8 @@ interface
       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;
@@ -55,8 +57,10 @@ implementation
 
   uses
     verbose,
+    fmodule,systems,
+    aasmbase,aasmtai,
     paramgr,
-    defutil,
+    symconst,symsym,defutil,
     cpubase,aasmcpu,tgobj,cgobj,cgx86,cgcpu;
 
   { thlcgcpu }
@@ -236,6 +240,183 @@ implementation
     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;

+ 0 - 203
compiler/i8086/cgcpu.pas

@@ -92,7 +92,6 @@ unit cgcpu;
         procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
 
         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);
 
@@ -2116,208 +2115,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);

+ 205 - 0
compiler/i8086/hlcgcpu.pas

@@ -82,6 +82,8 @@ interface
       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;
 
@@ -92,6 +94,7 @@ implementation
   uses
     verbose,
     paramgr,
+    aasmbase,aasmtai,
     cpubase,cpuinfo,tgobj,cgobj,cgx86,cgcpu,
     defutil,
     symconst,symcpu,
@@ -436,6 +439,208 @@ implementation
     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;

+ 0 - 82
compiler/m68k/cgcpu.pas

@@ -84,7 +84,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.
@@ -1991,87 +1990,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));

+ 100 - 4
compiler/m68k/hlcgcpu.pas

@@ -28,20 +28,116 @@ 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,
-    cgcpu;
+    globtype,verbose,
+    fmodule,
+    aasmbase,aasmtai,aasmcpu,
+    symconst,
+    hlcgobj,
+    cgbase, cgutils, cgobj, cpubase, cgcpu;
+
+
+  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:=thlcg2ll.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
 begin
-  chlcgobj:=thlcg2ll;
+  chlcgobj:=thlcgcpu;
 end.

+ 0 - 129
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;
 
@@ -1612,133 +1610,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;

+ 135 - 6
compiler/mips/hlcgcpu.pas

@@ -32,7 +32,7 @@ uses
   globtype,
   aasmbase, aasmdata,
   cgbase, cgutils,
-  symconst,symtype,symdef,
+  symtype,symdef,
   parabase, hlcgobj, hlcg2ll;
 
   type
@@ -41,6 +41,9 @@ uses
       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,12 +51,11 @@ uses
 implementation
 
   uses
-    verbose,
-    aasmtai,
-    aasmcpu,
+    verbose,globals,
+    fmodule,
+    aasmtai,aasmcpu,
     cutils,
-    globals,
-    defutil,
+    symconst,symsym,defutil,
     cgobj,
     cpubase,
     cpuinfo,
@@ -146,6 +148,133 @@ 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;

+ 1 - 1
compiler/ncgutil.pas

@@ -1484,7 +1484,7 @@ implementation
         else
           list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
 
-        cg.g_external_wrapper(list,pd,externalname);
+        hlcg.g_external_wrapper(list,pd,externalname);
         destroy_hlcodegen;
       end;
 

+ 2 - 2
compiler/ncgvmt.pas

@@ -753,7 +753,7 @@ implementation
             sym:=current_asmdata.DefineAsmSymbol(pd.mangledname,AB_LOCAL,AT_FUNCTION);
             list.concat(Tai_symbol.Create(sym,0));
           end;
-        cg.g_external_wrapper(list,pd,'FPC_ABSTRACTERROR');
+        hlcg.g_external_wrapper(list,pd,'FPC_ABSTRACTERROR');
         list.concat(Tai_symbol_end.Create(sym));
       end;
 
@@ -963,7 +963,7 @@ implementation
                     { create wrapper code }
                     new_section(list,sec_code,tmps,target_info.alignment.procalign);
                     hlcg.init_register_allocators;
-                    cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
+                    hlcg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset);
                     hlcg.done_register_allocators;
                   end;
               end;

+ 7 - 153
compiler/ppcgen/cgppc.pas

@@ -58,17 +58,20 @@ unit cgppc;
         procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override;
         procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
 
-        procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
 
         procedure g_maybe_got_init(list: TAsmList); override;
 
         procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean);
         procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint);
-        procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
         procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override;
+
+        { returns true if the offset of the given reference can not be  }
+        { represented by a 16 bit immediate as required by some PowerPC }
+        { instructions                                                  }
+        function hasLargeOffset(const ref : TReference) : Boolean; inline;
+        function  get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
        protected
         function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister; override;
-        function  get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
         { Make sure ref is a valid reference for the PowerPC and sets the }
         { base to the value of the index if (base = R_NO).                }
         { Returns true if the reference contained a base, index and an    }
@@ -84,11 +87,6 @@ unit cgppc;
         procedure a_jmp(list: TAsmList; op: tasmop;
                         c: tasmcondflag; crval: longint; l: tasmlabel);
 
-        { returns true if the offset of the given reference can not be  }
-        { represented by a 16 bit immediate as required by some PowerPC }
-        { instructions                                                  }
-        function hasLargeOffset(const ref : TReference) : Boolean; inline;
-
         function save_lr_in_prologue: boolean;
 
         function load_got_symbol(list : TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
@@ -685,101 +683,7 @@ unit cgppc;
 
 
 
-    procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-
-        procedure loadvmttor11;
-        var
-          href : treference;
-        begin
-          reference_reset_base(href,NR_R3,0,sizeof(pint));
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
-        end;
-
-
-        procedure op_onr11methodaddr;
-        var
-          href : treference;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-          if hasLargeOffset(href) then
-            begin
-{$ifdef cpu64}
-              if (longint(href.offset) <> href.offset) then
-                { add support for offsets > 32 bit }
-                internalerror(200510201);
-{$endif cpu64}
-              list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
-                smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
-              href.offset := smallint(href.offset and $ffff);
-            end;
-          a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
-          if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
-            begin
-              reference_reset_base(href, NR_R11, 0, sizeof(pint));
-              a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
-            end;
-          list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
-          list.concat(taicpu.op_none(A_BCTR));
-          if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
-            list.concat(taicpu.op_none(A_NOP));
-        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
-            loadvmttor11;
-            op_onr11methodaddr;
-          end
-        { case 0 }
-        else
-          case target_info.system of
-            system_powerpc_darwin,
-            system_powerpc64_darwin:
-              list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
-            system_powerpc64_linux,
-            system_powerpc_aix,
-            system_powerpc64_aix:
-              {$note ts:todo add GOT change?? - think not needed :) }
-              list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
-            else
-              list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
-          end;
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
-    function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
+  function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister;
     var
       l: tasmsymbol;
       ref: treference;
@@ -944,56 +848,6 @@ unit cgppc;
     end;
 
 
-    procedure tcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
-      var
-        href : treference;
-      begin
-        if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
-          inherited;
-          exit;
-        end;
-
-        { for ppc64/linux and aix emit correct code which sets up a stack frame
-          and then calls the external method normally to ensure that the GOT/TOC
-          will be loaded correctly if required.
-
-        The resulting code sequence looks as follows:
-
-        mflr r0
-        stw/d r0, 16(r1)
-        stw/du r1, -112(r1)
-        bl <external_method>
-        nop
-        addi r1, r1, 112
-        lwz/d r0, 16(r1)
-        mtlr r0
-        blr
-
-        }
-        list.concat(taicpu.op_reg(A_MFLR, NR_R0));
-        if target_info.abi=abi_powerpc_sysv then
-          reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
-        else
-          reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
-        a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
-        reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
-        list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
-
-        a_call_name(list,externalname,false);
-
-        list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
-
-
-        if target_info.abi=abi_powerpc_sysv then
-          reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
-        else
-          reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
-        list.concat(taicpu.op_reg(A_MTLR, NR_R0));
-        list.concat(taicpu.op_none(A_BLR));
-      end;
-
-
     procedure tcgppcgen.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister);
       var
         testbit: byte;

+ 153 - 2
compiler/ppcgen/hlcgppc.pas

@@ -29,20 +29,27 @@ interface
 
 uses
   aasmdata,
-  symtype,
+  symtype,symdef,
   cgbase,cgutils,hlcgobj,hlcg2ll;
 
 type
   thlcgppcgen = class(thlcg2ll)
    protected
     procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
+   public
+    procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+    procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override;
   end;
 
 implementation
 
   uses
+    verbose,
+    systems,fmodule,
+    symconst,
+    aasmbase,aasmtai,aasmcpu,
     cpubase,globtype,
-    symdef,defutil;
+    defutil,cgobj,cgppc;
 
 { thlcgppc }
 
@@ -80,5 +87,149 @@ implementation
       a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
     end;
 
+
+  procedure thlcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+
+      procedure loadvmttor11;
+      var
+        href : treference;
+      begin
+        reference_reset_base(href,voidpointertype,NR_R3,0,sizeof(pint));
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
+      end;
+
+
+      procedure op_onr11methodaddr;
+      var
+        href : treference;
+      begin
+        if (procdef.extnumber=$ffff) then
+          Internalerror(200006139);
+        { call/jmp  vmtoffs(%eax) ; method offs }
+        reference_reset_base(href,voidpointertype,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+        if tcgppcgen(cg).hasLargeOffset(href) then
+          begin
+{$ifdef cpu64}
+            if (longint(href.offset) <> href.offset) then
+              { add support for offsets > 32 bit }
+              internalerror(200510201);
+{$endif cpu64}
+            list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
+              smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
+            href.offset := smallint(href.offset and $ffff);
+          end;
+        cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
+        if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
+          begin
+            reference_reset_base(href, voidpointertype, NR_R11, 0, sizeof(pint));
+            cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
+          end;
+        list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
+        list.concat(taicpu.op_none(A_BCTR));
+        if (target_info.system in ([system_powerpc64_linux]+systems_aix)) then
+          list.concat(taicpu.op_none(A_NOP));
+      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
+          loadvmttor11;
+          op_onr11methodaddr;
+        end
+      { case 0 }
+      else
+        case target_info.system of
+          system_powerpc_darwin,
+          system_powerpc64_darwin:
+            list.concat(taicpu.op_sym(A_B,tcgppcgen(cg).get_darwin_call_stub(procdef.mangledname,false)));
+          system_powerpc64_linux,
+          system_powerpc_aix,
+          system_powerpc64_aix:
+            {$note ts:todo add GOT change?? - think not needed :) }
+            list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
+          else
+            list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)))
+        end;
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
+  procedure thlcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
+    var
+      href : treference;
+    begin
+      if not(target_info.system in ([system_powerpc64_linux]+systems_aix)) then begin
+        inherited;
+        exit;
+      end;
+
+      { for ppc64/linux and aix emit correct code which sets up a stack frame
+        and then calls the external method normally to ensure that the GOT/TOC
+        will be loaded correctly if required.
+
+      The resulting code sequence looks as follows:
+
+      mflr r0
+      stw/d r0, 16(r1)
+      stw/du r1, -112(r1)
+      bl <external_method>
+      nop
+      addi r1, r1, 112
+      lwz/d r0, 16(r1)
+      mtlr r0
+      blr
+
+      }
+      list.concat(taicpu.op_reg(A_MFLR, NR_R0));
+      if target_info.abi=abi_powerpc_sysv then
+        reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
+      else
+        reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
+      cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_R0,href);
+      reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8);
+      list.concat(taicpu.op_reg_ref({$ifdef cpu64bitaddr}A_STDU{$else}A_STWU{$endif}, NR_STACK_POINTER_REG, href));
+
+      cg.a_call_name(list,externalname,false);
+
+      list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE));
+
+
+      if target_info.abi=abi_powerpc_sysv then
+        reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_SYSV, 8)
+      else
+        reference_reset_base(href, voidstackpointertype, NR_STACK_POINTER_REG, LA_LR_AIX, 8);
+      cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R0);
+      list.concat(taicpu.op_reg(A_MTLR, NR_R0));
+      list.concat(taicpu.op_none(A_BLR));
+    end;
+
 end.
 

+ 0 - 83
compiler/sparc/cgcpu.pas

@@ -88,8 +88,6 @@ interface
         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;
        private
         use_unlimited_pic_mode : boolean;
       end;
@@ -1278,87 +1276,6 @@ implementation
       end;
 
 
-    procedure tcgsparc.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      var
-        make_global : boolean;
-        href : treference;
-        hsym : tsym;
-        paraloc : pcgparalocation;
-      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  }
-        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>=simm13lo) and (ioffset<=simm13hi)) then
-                a_op_const_reg(list,OP_SUB,paraloc^.size,ioffset,paraloc^.register)
-              else
-                begin
-                  a_load_const_reg(list,paraloc^.size,ioffset,NR_G1);
-                  a_op_reg_reg(list,OP_SUB,paraloc^.size,NR_G1,paraloc^.register);
-                end;
-            end;
-        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));
-            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
-            { jmp *vmtoffs(%eax) ; method offs }
-            reference_reset_base(href,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-            list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
-            list.concat(taicpu.op_reg(A_JMP,NR_G1));
-            { Delay slot }
-            list.Concat(TAiCpu.Op_none(A_NOP));
-          end
-        else
-          g_external_wrapper(list,procdef,procdef.mangledname);
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
-    procedure tcgsparc.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
-      begin
-        { CALL overwrites %o7 with its own address, we use delay slot to restore it. }
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_O7,NR_G1));
-        list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(externalname)));
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_G1,NR_O7));
-      end;
-
-
 {****************************************************************************
                                TCG64Sparc
 ****************************************************************************}

+ 100 - 4
compiler/sparc/hlcgcpu.pas

@@ -28,20 +28,116 @@ 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;
+     procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
+    end;
+
   procedure create_hlcodegen;
 
 implementation
 
   uses
-    hlcgobj, hlcg2ll,
-    cgcpu;
+    verbose,globtype,fmodule,
+    aasmbase,aasmtai,aasmcpu,
+    parabase,
+    symconst,symtype,symsym,
+    cgbase,cgutils,cgobj,hlcgobj,cpubase,cgcpu;
+
+
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    var
+      make_global : boolean;
+      href : treference;
+      hsym : tsym;
+      paraloc : pcgparalocation;
+    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  }
+      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>=simm13lo) and (ioffset<=simm13hi)) 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_G1);
+                cg.a_op_reg_reg(list,OP_SUB,paraloc^.size,NR_G1,paraloc^.register);
+              end;
+          end;
+      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));
+          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
+          { jmp *vmtoffs(%eax) ; method offs }
+          reference_reset_base(href,voidpointertype,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+          list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
+          list.concat(taicpu.op_reg(A_JMP,NR_G1));
+          { Delay slot }
+          list.Concat(TAiCpu.Op_none(A_NOP));
+        end
+      else
+        g_external_wrapper(list,procdef,procdef.mangledname);
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
+
+  procedure thlcgcpu.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
+    begin
+      { CALL overwrites %o7 with its own address, we use delay slot to restore it. }
+      list.concat(taicpu.op_reg_reg(A_MOV,NR_O7,NR_G1));
+      list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(externalname)));
+      list.concat(taicpu.op_reg_reg(A_MOV,NR_G1,NR_O7));
+    end;
+
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
 begin
-  chlcgobj:=thlcg2ll;
+  chlcgobj:=thlcgcpu;
 end.

+ 2 - 28
compiler/x86/cgx86.pas

@@ -125,9 +125,9 @@ unit cgx86;
 
         procedure g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef);override;
 
-        procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
-
         procedure make_simple_ref(list:TAsmList;var ref: treference);
+
+        function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
       protected
         procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
         procedure check_register_size(size:tcgsize;reg:tregister);
@@ -135,7 +135,6 @@ unit cgx86;
         procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
         procedure opmm_loc_reg_reg(list : TAsmList;Op : TOpCG;size : tcgsize;loc : tlocation;src,dst : tregister;shuffle : pmmshuffle);
 
-        function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
         procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
 
         procedure floatload(list: TAsmList; t : tcgsize;const ref : treference);
@@ -3025,29 +3024,4 @@ unit cgx86;
          a_label(list,hl);
       end;
 
-    procedure tcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
-      var
-        ref : treference;
-        sym : tasmsymbol;
-      begin
-       if (target_info.system = system_i386_darwin) then
-         begin
-           { a_jmp_name jumps to a stub which is always pic-safe on darwin }
-           inherited g_external_wrapper(list,procdef,externalname);
-           exit;
-         end;
-
-        sym:=current_asmdata.RefAsmSymbol(externalname);
-        reference_reset_symbol(ref,sym,0,sizeof(pint));
-
-        { create pic'ed? }
-        if (cs_create_pic in current_settings.moduleswitches) and
-           { darwin/x86_64's assembler doesn't want @PLT after call symbols }
-           not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then
-          ref.refaddr:=addr_pic
-        else
-          ref.refaddr:=addr_full;
-        list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
-      end;
-
 end.

+ 31 - 1
compiler/x86/hlcgx86.pas

@@ -41,12 +41,16 @@ interface
     thlcgx86 = class(thlcg2ll)
      protected
       procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
+     public
+      procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
     end;
 
 implementation
 
   uses
-    cgbase,
+    globtype,globals,systems,
+    aasmbase,
+    cgbase,cgutils,
     cpubase,aasmcpu;
 
 { thlcgx86 }
@@ -59,4 +63,30 @@ implementation
         list.concat(taicpu.op_none(A_FLDZ));
     end;
 
+
+  procedure thlcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+    var
+      ref : treference;
+      sym : tasmsymbol;
+    begin
+     if (target_info.system = system_i386_darwin) then
+       begin
+         { a_jmp_name jumps to a stub which is always pic-safe on darwin }
+         inherited g_external_wrapper(list,procdef,externalname);
+         exit;
+       end;
+
+      sym:=current_asmdata.RefAsmSymbol(externalname);
+      reference_reset_symbol(ref,sym,0,sizeof(pint));
+
+      { create pic'ed? }
+      if (cs_create_pic in current_settings.moduleswitches) and
+         { darwin/x86_64's assembler doesn't want @PLT after call symbols }
+         not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then
+        ref.refaddr:=addr_pic
+      else
+        ref.refaddr:=addr_full;
+      list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
+    end;
+
 end.

+ 0 - 63
compiler/x86_64/cgcpu.pas

@@ -38,7 +38,6 @@ unit cgcpu;
 
         procedure g_proc_entry(list : TAsmList;localsize:longint; nostackframe:boolean);override;
         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_local_unwind(list: TAsmList; l: TAsmLabel);override;
         procedure g_save_registers(list: TAsmList);override;
         procedure g_restore_registers(list: TAsmList);override;
@@ -402,68 +401,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcgx86_64.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
-      var
-        make_global : boolean;
-        href : treference;
-        sym : tasmsymbol;
-        r : 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.extnumber=$ffff) then
-              Internalerror(200006139);
-            { load vmt from first paramter }
-            { win64 uses a different abi }
-            if target_info.system=system_x86_64_win64 then
-              reference_reset_base(href,NR_RCX,0,sizeof(pint))
-            else
-              reference_reset_base(href,NR_RDI,0,sizeof(pint));
-            cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
-            { jmp *vmtoffs(%eax) ; method offs }
-            reference_reset_base(href,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
-            list.concat(taicpu.op_ref(A_JMP,S_Q,href));
-          end
-        else
-          begin
-            sym:=current_asmdata.RefAsmSymbol(procdef.mangledname);
-            reference_reset_symbol(r,sym,0,sizeof(pint));
-            if (cs_create_pic in current_settings.moduleswitches) and
-               { darwin/x86_64's assembler doesn't want @PLT after call symbols }
-               (target_info.system<>system_x86_64_darwin) then
-              r.refaddr:=addr_pic
-            else
-              r.refaddr:=addr_full;
-
-            list.concat(taicpu.op_ref(A_JMP,S_NO,r));
-          end;
-
-        List.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
     procedure tcgx86_64.g_local_unwind(list: TAsmList; l: TAsmLabel);
       var
         para1,para2: tcgpara;

+ 81 - 4
compiler/x86_64/hlcgcpu.pas

@@ -28,20 +28,97 @@ unit hlcgcpu;
 
 interface
 
+  uses
+    aasmdata,
+    symdef,
+    hlcgx86;
+
+  type
+    thlcgcpu = class(thlcgx86)
+     procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
+    end;
+
   procedure create_hlcodegen;
 
 implementation
 
   uses
-    hlcgobj, hlcgx86,
-    cgcpu;
+    globtype,globals,verbose,
+    fmodule,systems,
+    aasmbase,aasmtai,aasmcpu,
+    symconst,
+    hlcgobj,
+    cgbase,cgutils,cgobj,cpubase,cgcpu;
+
+  procedure thlcgcpu.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
+    var
+      make_global : boolean;
+      href : treference;
+      sym : tasmsymbol;
+      r : 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.extnumber=$ffff) then
+            Internalerror(200006139);
+          { load vmt from first paramter }
+          { win64 uses a different abi }
+          if target_info.system=system_x86_64_win64 then
+            reference_reset_base(href,voidpointertype,NR_RCX,0,sizeof(pint))
+          else
+            reference_reset_base(href,voidpointertype,NR_RDI,0,sizeof(pint));
+          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
+          { jmp *vmtoffs(%eax) ; method offs }
+          reference_reset_base(href,voidpointertype,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
+          list.concat(taicpu.op_ref(A_JMP,S_Q,href));
+        end
+      else
+        begin
+          sym:=current_asmdata.RefAsmSymbol(procdef.mangledname);
+          reference_reset_symbol(r,sym,0,sizeof(pint));
+          if (cs_create_pic in current_settings.moduleswitches) and
+             { darwin/x86_64's assembler doesn't want @PLT after call symbols }
+             (target_info.system<>system_x86_64_darwin) then
+            r.refaddr:=addr_pic
+          else
+            r.refaddr:=addr_full;
+
+          list.concat(taicpu.op_ref(A_JMP,S_NO,r));
+        end;
+
+      List.concat(Tai_symbol_end.Createname(labelname));
+    end;
+
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcgx86.create;
+      hlcg:=thlcgcpu.create;
       create_codegen;
     end;
 
 begin
-  chlcgobj:=thlcgx86;
+  chlcgobj:=thlcgcpu;
 end.