Browse Source

* renamed thlcgobj.g_external_wrapper() into a_jmp_external_name(), and
moved the code to create the procedure start/end etc. that was at the
call sites of g_external_wrapper() into the new g_external_wrapper()
-> got rid of the x86-specific code in expunix, and fixed expunix for
llvm (e.g. tests/test/tlib1{a,b})

git-svn-id: trunk@34131 -

Jonas Maebe 9 years ago
parent
commit
c7ea921066

+ 4 - 3
compiler/arm/hlcgcpu.pas

@@ -29,6 +29,7 @@ unit hlcgcpu;
 interface
 interface
 
 
   uses
   uses
+    globtype,
     aasmdata,
     aasmdata,
     symdef,
     symdef,
     hlcg2ll;
     hlcg2ll;
@@ -42,7 +43,7 @@ interface
     end;
     end;
 
 
     tthumbhlcgcpu = class(tbasehlcgarm)
     tthumbhlcgcpu = class(tbasehlcgarm)
-      procedure g_external_wrapper(list : TAsmList; procdef : tprocdef; const externalname : string); override;
+      procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); override;
     end;
     end;
 
 
   procedure create_hlcodegen;
   procedure create_hlcodegen;
@@ -50,7 +51,7 @@ interface
 implementation
 implementation
 
 
   uses
   uses
-    globals,globtype,verbose,
+    globals,verbose,
     procinfo,fmodule,
     procinfo,fmodule,
     symconst,
     symconst,
     aasmbase,aasmtai,aasmcpu, cpuinfo,
     aasmbase,aasmtai,aasmcpu, cpuinfo,
@@ -229,7 +230,7 @@ implementation
 
 
   { tthumbhlcgcpu }
   { tthumbhlcgcpu }
 
 
-  procedure tthumbhlcgcpu.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+  procedure tthumbhlcgcpu.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     var
     var
       tmpref : treference;
       tmpref : treference;
       l : tasmlabel;
       l : tasmlabel;

+ 4 - 22
compiler/expunix.pas

@@ -60,6 +60,9 @@ uses
   fmodule,
   fmodule,
   cgbase,cgutils,cpubase,cgobj,
   cgbase,cgutils,cpubase,cgobj,
   cgcpu,hlcgobj,hlcgcpu,
   cgcpu,hlcgobj,hlcgcpu,
+{$ifdef llvm}
+  hlcgllvm,
+{$endif llvm}
   ncgutil,
   ncgutil,
   verbose;
   verbose;
 
 
@@ -161,28 +164,7 @@ begin
               break;
               break;
           end;
           end;
         if not anyhasalias then
         if not anyhasalias then
-         begin
-           { place jump in al_procedures }
-           current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
-           current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
-           if (cs_create_pic in current_settings.moduleswitches) and
-             { other targets need to be checked how it works }
-             (target_info.system in [system_i386_freebsd,system_x86_64_freebsd,system_x86_64_linux,system_i386_linux,system_x86_64_solaris,system_i386_solaris,system_i386_android,system_x86_64_dragonfly]) then
-             begin
-{$ifdef x86}
-               sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
-               reference_reset_symbol(r,sym,0,sizeof(pint));
-               if cs_create_pic in current_settings.moduleswitches then
-                 r.refaddr:=addr_pic
-               else
-                 r.refaddr:=addr_full;
-               current_asmdata.asmlists[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r));
-{$endif x86}
-             end
-           else
-             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;
+          hlcg.g_external_wrapper(current_asmdata.asmlists[al_procedures],pd,hp2.name^,pd.mangledname,true);
         exportedsymnames.insert(hp2.name^);
         exportedsymnames.insert(hp2.name^);
       end
       end
      else
      else

+ 26 - 10
compiler/hlcgobj.pas

@@ -513,11 +513,14 @@ unit hlcgobj;
           procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual; abstract;
           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: aint);virtual; abstract;
           procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual; abstract;
 
 
+         protected
+          procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); virtual;
+         public
           { generate a stub which only purpose is to pass control the given external method,
           { generate a stub which only purpose is to pass control the given external method,
           setting up any additional environment before doing so (if required).
           setting up any additional environment before doing so (if required).
 
 
           The default implementation issues a jump instruction to the external name. }
           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 wrappername, externalname: string; global: boolean); virtual;
 
 
          protected
          protected
           procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
           procedure g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
@@ -3772,11 +3775,31 @@ implementation
     begin
     begin
     end;
     end;
 
 
-  procedure thlcgobj.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+  procedure thlcgobj.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     begin
     begin
       cg.a_jmp_name(list,externalname);
       cg.a_jmp_name(list,externalname);
     end;
     end;
 
 
+  procedure thlcgobj.g_external_wrapper(list: TAsmList; procdef: tprocdef; const wrappername, externalname: string; global: boolean);
+    var
+      sym: tasmsymbol;
+    begin
+      maybe_new_object_file(list);
+      new_section(list,sec_code,wrappername,target_info.alignment.procalign);
+      if global then
+        begin
+          sym:=current_asmdata.DefineAsmSymbol(wrappername,AB_GLOBAL,AT_FUNCTION);
+          list.concat(Tai_symbol.Create_global(sym,0));
+        end
+      else
+        begin
+          sym:=current_asmdata.DefineAsmSymbol(wrappername,AB_LOCAL,AT_FUNCTION);
+          list.concat(Tai_symbol.Create(sym,0));
+        end;
+      a_jmp_external_name(list,externalname);
+      list.concat(Tai_symbol_end.Create(sym));
+    end;
+
   procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
   procedure thlcgobj.g_allocload_reg_reg(list: TAsmList; regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
     begin
     begin
       case regtyp of
       case regtyp of
@@ -4490,14 +4513,7 @@ implementation
           if importname<>'' then
           if importname<>'' then
             begin
             begin
              { add the procedure to the al_procedures }
              { add the procedure to the al_procedures }
-             maybe_new_object_file(list);
-             new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign);
-             if (po_global in pd.procoptions) then
-               list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0))
-             else
-               list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0));
-
-             g_external_wrapper(list,pd,importname);
+             g_external_wrapper(list,pd,pd.mangledname,importname,true);
             end;
             end;
           { remove the external stuff, so that the interface crc
           { remove the external stuff, so that the interface crc
             doesn't change. This makes the function calls less
             doesn't change. This makes the function calls less

+ 3 - 3
compiler/llvm/hlcgllvm.pas

@@ -145,7 +145,7 @@ uses
       procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
       procedure varsym_set_localloc(list: TAsmList; vs: tabstractnormalvarsym); override;
       procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
       procedure paravarsym_set_initialloc_to_paraloc(vs: tparavarsym); override;
 
 
-      procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override;
+      procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const wrappername, externalname: string; global: boolean); override;
 
 
      { def is a pointerdef or implicit pointer type (class, classref, procvar,
      { def is a pointerdef or implicit pointer type (class, classref, procvar,
        dynamic array, ...).  }
        dynamic array, ...).  }
@@ -2002,14 +2002,14 @@ implementation
     end;
     end;
 
 
 
 
-  procedure thlcgllvm.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+  procedure thlcgllvm.g_external_wrapper(list: TAsmList; procdef: tprocdef; const wrappername, externalname: string; global: boolean);
     var
     var
       asmsym: TAsmSymbol;
       asmsym: TAsmSymbol;
     begin
     begin
       if po_external in procdef.procoptions then
       if po_external in procdef.procoptions then
         exit;
         exit;
       asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
       asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
-      list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,asmsym.bind));
+      list.concat(taillvmalias.create(asmsym,wrappername,procdef,asmsym.bind));
     end;
     end;
 
 
 
 

+ 2 - 2
compiler/mips/hlcgcpu.pas

@@ -43,7 +43,7 @@ uses
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
       procedure a_load_regconst_subsetreg_intern(list: TAsmList; fromsize, subsetsize: tdef; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override;
     public
     public
       procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); 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 a_jmp_external_name(list: TAsmList; const externalname: TSymStr);override;
   end;
   end;
 
 
   procedure create_hlcodegen;
   procedure create_hlcodegen;
@@ -148,7 +148,7 @@ implementation
     end;
     end;
 
 
 
 
-  procedure thlcgmips.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+  procedure thlcgmips.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     var
     var
       href: treference;
       href: treference;
     begin
     begin

+ 4 - 4
compiler/ppcgen/hlcgppc.pas

@@ -28,7 +28,7 @@ unit hlcgppc;
 interface
 interface
 
 
 uses
 uses
-  globals,
+  globtype,globals,
   aasmdata,
   aasmdata,
   symtype,symdef,
   symtype,symdef,
   cgbase,cgutils,hlcgobj,hlcg2ll;
   cgbase,cgutils,hlcgobj,hlcg2ll;
@@ -39,7 +39,7 @@ type
     procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
     procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
    public
    public
     procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
     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;
+    procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); override;
     procedure gen_load_para_value(list: TAsmList); override;
     procedure gen_load_para_value(list: TAsmList); override;
   end;
   end;
 
 
@@ -50,7 +50,7 @@ implementation
     systems,fmodule,
     systems,fmodule,
     symconst,
     symconst,
     aasmbase,aasmtai,aasmcpu,
     aasmbase,aasmtai,aasmcpu,
-    cpubase,globtype,
+    cpubase,
     procinfo,cpupi,cgobj,cgppc,
     procinfo,cpupi,cgobj,cgppc,
     defutil;
     defutil;
 
 
@@ -193,7 +193,7 @@ implementation
     end;
     end;
 
 
 
 
-  procedure thlcgppcgen.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string);
+  procedure thlcgppcgen.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     var
     var
       href : treference;
       href : treference;
     begin
     begin

+ 5 - 4
compiler/sparc/hlcgcpu.pas

@@ -29,6 +29,7 @@ unit hlcgcpu;
 interface
 interface
 
 
   uses
   uses
+    globtype,
     aasmdata,
     aasmdata,
     symdef,
     symdef,
     hlcg2ll;
     hlcg2ll;
@@ -36,7 +37,7 @@ interface
   type
   type
     thlcgcpu = class(thlcg2ll)
     thlcgcpu = class(thlcg2ll)
      procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);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 a_jmp_external_name(list: TAsmList; const externalname: TSymStr);override;
     end;
     end;
 
 
   procedure create_hlcodegen;
   procedure create_hlcodegen;
@@ -44,7 +45,7 @@ interface
 implementation
 implementation
 
 
   uses
   uses
-    verbose,globtype,fmodule,
+    verbose,fmodule,
     aasmbase,aasmtai,aasmcpu,
     aasmbase,aasmtai,aasmcpu,
     parabase,
     parabase,
     symconst,symtype,symsym,
     symconst,symtype,symsym,
@@ -118,12 +119,12 @@ implementation
           list.Concat(TAiCpu.Op_none(A_NOP));
           list.Concat(TAiCpu.Op_none(A_NOP));
         end
         end
       else
       else
-        g_external_wrapper(list,procdef,procdef.mangledname);
+        a_jmp_external_name(list,procdef.mangledname);
       List.concat(Tai_symbol_end.Createname(labelname));
       List.concat(Tai_symbol_end.Createname(labelname));
     end;
     end;
 
 
 
 
-  procedure thlcgcpu.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
+  procedure thlcgcpu.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     begin
     begin
       { CALL overwrites %o7 with its own address, we use delay slot to restore it. }
       { 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_reg_reg(A_MOV,NR_O7,NR_G1));

+ 5 - 5
compiler/x86/hlcgx86.pas

@@ -29,6 +29,7 @@ interface
 {$i fpcdefs.inc}
 {$i fpcdefs.inc}
 
 
   uses
   uses
+    globtype,
     aasmdata,
     aasmdata,
     symtype,symdef,
     symtype,symdef,
     parabase,
     parabase,
@@ -41,14 +42,13 @@ interface
     thlcgx86 = class(thlcg2ll)
     thlcgx86 = class(thlcg2ll)
      protected
      protected
       procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
       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;
+      procedure a_jmp_external_name(list: TAsmList; const externalname: TSymStr); override;
     end;
     end;
 
 
 implementation
 implementation
 
 
   uses
   uses
-    globtype,globals,systems,
+    globals,systems,
     aasmbase,
     aasmbase,
     cgbase,cgutils,
     cgbase,cgutils,
     cpubase,aasmcpu;
     cpubase,aasmcpu;
@@ -64,7 +64,7 @@ implementation
     end;
     end;
 
 
 
 
-  procedure thlcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string);
+  procedure thlcgx86.a_jmp_external_name(list: TAsmList; const externalname: TSymStr);
     var
     var
       ref : treference;
       ref : treference;
       sym : tasmsymbol;
       sym : tasmsymbol;
@@ -72,7 +72,7 @@ implementation
      if (target_info.system = system_i386_darwin) then
      if (target_info.system = system_i386_darwin) then
        begin
        begin
          { a_jmp_name jumps to a stub which is always pic-safe on darwin }
          { a_jmp_name jumps to a stub which is always pic-safe on darwin }
-         inherited g_external_wrapper(list,procdef,externalname);
+         inherited;
          exit;
          exit;
        end;
        end;