* a_call_ref functionality cannot be implemented efficiently at code generator level, because references need specific preparations at earlier points. Moved this support to tcgcallnode and its x86 descendants, and got rid of all ifdef's around.

+ x86 targets now directly call procedure variables located in references.
- a_call_ref method removed from tcg and thlcgobj.

git-svn-id: trunk@26666 -

compiler/arm/cgcpu.pas

@@ -47,7 +47,6 @@ unit cgcpu;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
         procedure a_call_reg(list : TAsmList;reg: tregister);override;
-        procedure a_call_ref(list : TAsmList;ref: treference);override;
 
         { move instructions }
         procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
@@ -681,16 +680,6 @@ unit cgcpu;
       end;
 
 
-    procedure tbasecgarm.a_call_ref(list : TAsmList;ref: treference);
-      begin
-        a_reg_alloc(list,NR_R12);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_R12);
-        a_call_reg(list,NR_R12);
-        a_reg_dealloc(list,NR_R12);
-        include(current_procinfo.flags,pi_do_call);
-      end;
-
-
      procedure tcgarm.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister);
        begin
           a_op_const_reg_reg(list,op,size,a,reg,reg);

compiler/avr/cgcpu.pas

@@ -54,7 +54,6 @@ unit cgcpu;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
         procedure a_call_reg(list : TAsmList;reg: tregister);override;
-        procedure a_call_ref(list : TAsmList;ref: treference);override;
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, dst : TRegister); override;
@@ -406,19 +405,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcgavr.a_call_ref(list : TAsmList;ref: treference);
-      begin
-        a_reg_alloc(list,NR_ZLO);
-        a_reg_alloc(list,NR_ZHI);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_ZLO);
-        list.concat(taicpu.op_none(A_ICALL));
-        a_reg_dealloc(list,NR_ZLO);
-        a_reg_dealloc(list,NR_ZHI);
-
-        include(current_procinfo.flags,pi_do_call);
-      end;
-
-
      procedure tcgavr.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister);
        begin
          if not(size in [OS_S8,OS_8,OS_S16,OS_16,OS_S32,OS_32]) then

compiler/cgobj.pas

@@ -227,7 +227,6 @@ unit cgobj;
           }
           procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
           procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
-          procedure a_call_ref(list : TAsmList;ref : treference);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
           procedure a_call_name_static(list : TAsmList;const s : string);virtual;
@@ -2413,16 +2412,6 @@ implementation
       end;
 
 
-    procedure tcg.a_call_ref(list : TAsmList;ref: treference);
-      var
-        tempreg : TRegister;
-      begin
-        tempreg := getintregister(list, OS_ADDR);
-        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
-        a_call_reg(list,tempreg);
-      end;
-
-
    function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister;
       var
         l: tasmsymbol;

compiler/hlcg2ll.pas

@@ -151,7 +151,6 @@ unit hlcg2ll;
 
           function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;override;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);override;
-          procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);override;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
           function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;override;
@@ -462,11 +461,6 @@ implementation
       cg.a_call_reg(list,reg);
     end;
 
-  procedure thlcg2ll.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
-    begin
-      cg.a_call_ref(list,ref);
-    end;
-
   function thlcg2ll.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       cg.a_call_name_static(list,s);

compiler/hlcgobj.pas

@@ -194,7 +194,6 @@ unit hlcgobj;
           }
           function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef; weak: boolean): tcgpara;virtual;abstract;
           procedure a_call_reg(list : TAsmList;pd : tabstractprocdef;reg : tregister);virtual;abstract;
-          procedure a_call_ref(list : TAsmList;pd : tabstractprocdef;const ref : treference);virtual;
           { same as a_call_name, might be overridden on certain architectures to emit
             static calls without usage of a got trampoline }
           function a_call_name_static(list : TAsmList;pd : tprocdef;const s : TSymStr; forceresdef: tdef): tcgpara;virtual;
@@ -975,22 +974,6 @@ implementation
          end;
     end;
 
-  procedure thlcgobj.a_call_ref(list: TAsmList; pd: tabstractprocdef; const ref: treference);
-    var
-      reg: tregister;
-      size: tdef;
-    begin
-      { the loaded data is always a pointer to a procdef. A procvardef is
-        implicitly a pointer already, but a procdef isn't -> create one }
-      if pd.typ=procvardef then
-        size:=pd
-      else
-        size:=getpointerdef(pd);
-      reg:=getaddressregister(list,size);
-      a_load_ref_reg(list,size,size,ref,reg);
-      a_call_reg(list,pd,reg);
-    end;
-
   function thlcgobj.a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; forceresdef: tdef): tcgpara;
     begin
       result:=a_call_name(list,pd,s,forceresdef,false);

compiler/i8086/cgcpu.pas

@@ -49,8 +49,6 @@ unit cgcpu;
         procedure a_call_name_static_far(list : TAsmList;const s : string);
         procedure a_call_reg(list : TAsmList;reg : tregister);override;
         procedure a_call_reg_far(list : TAsmList;reg : tregister);
-        procedure a_call_ref(list : TAsmList;ref : treference);override;
-        procedure a_call_ref_far(list : TAsmList;ref : treference);
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
@@ -254,27 +252,12 @@ unit cgcpu;
         a_load_reg_ref(list,OS_32,OS_32,reg,href);
         cg.getcpuregister(list,NR_BX);
         cg.getcpuregister(list,NR_SI);
-        a_call_ref_far(list,href);
+        href.refaddr:=addr_far_ref;
+        list.concat(taicpu.op_ref(A_CALL,S_NO,href));
         tg.ungettemp(list,href);
       end;
 
 
-    procedure tcg8086.a_call_ref(list: TAsmList; ref: treference);
-      begin
-        if current_settings.x86memorymodel in x86_far_code_models then
-          a_call_ref_far(list,ref)
-        else
-          a_call_ref_near(list,ref);
-      end;
-
-
-    procedure tcg8086.a_call_ref_far(list: TAsmList; ref: treference);
-      begin
-        ref.refaddr:=addr_far_ref;
-        list.concat(taicpu.op_ref(A_CALL,S_NO,ref));
-      end;
-
-
     procedure tcg8086.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize;
       a: tcgint; reg: TRegister);
       var

compiler/i8086/n8086cal.pas

@@ -28,13 +28,15 @@ interface
 { $define AnsiStrRef}
 
     uses
-      nx86cal;
+      nx86cal,cgutils;
 
     type
        ti8086callnode = class(tx86callnode)
        protected
           procedure pop_parasize(pop_size:longint);override;
           procedure extra_interrupt_code;override;
+          procedure extra_call_ref_code(var ref: treference);override;
+          procedure do_call_ref(ref: treference);override;
        end;
 
 
@@ -43,11 +45,11 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      cgbase,cgutils,
+      cgbase,
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
       ncal,nbas,nmem,nld,ncnv,
-      cga,cgobj,cpuinfo;
+      cga,cgobj,cgx86,cpuinfo;
 
 
 {*****************************************************************************
@@ -92,6 +94,33 @@ implementation
       end;
 
 
+    procedure ti8086callnode.extra_call_ref_code(var ref: treference);
+      begin
+        if ref.base<>NR_NO then
+          begin
+            cg.getcpuregister(current_asmdata.CurrAsmList,NR_BX);
+            cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.base,NR_BX);
+            ref.base:=NR_BX;
+            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_BX);
+          end;
+        if ref.index<>NR_NO then
+          begin
+            cg.getcpuregister(current_asmdata.CurrAsmList,NR_SI);
+            cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.index,NR_SI);
+            ref.index:=NR_SI;
+            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_SI);
+          end;
+      end;
+
+
+    procedure ti8086callnode.do_call_ref(ref: treference);
+      begin
+        if current_settings.x86memorymodel in x86_far_code_models then
+          ref.refaddr:=addr_far_ref;
+        current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+      end;
+
+
 begin
    ccallnode:=ti8086callnode;
 end.

compiler/ncgcal.pas

@@ -87,6 +87,14 @@ interface
             LOC_REFERENCE, this method will be called to perform the necessary
             cleanups. By default it does not do anything }
           procedure do_release_unused_return_value;virtual;
+
+          { Override the following three methods to support calls to address in
+            'ref' without loading it into register (only x86 targets probably).
+            If can_call_ref returns true, it should do required simplification
+            on ref. }
+          function can_call_ref(var ref: treference):boolean;virtual;
+          procedure extra_call_ref_code(var ref: treference);virtual;
+          procedure do_call_ref(ref: treference);virtual;
        public
           procedure pass_generate_code;override;
           destructor destroy;override;
@@ -415,6 +423,24 @@ implementation
       end;
 
 
+    function tcgcallnode.can_call_ref(var ref: treference): boolean;
+      begin
+        result:=false;
+      end;
+
+
+    procedure tcgcallnode.extra_call_ref_code(var ref: treference);
+      begin
+        { no action by default }
+      end;
+
+
+    procedure tcgcallnode.do_call_ref(ref: treference);
+      begin
+        InternalError(2014012901);
+      end;
+
+
     procedure tcgcallnode.set_result_location(realresdef: tstoreddef);
       begin
         if realresdef.is_intregable or
@@ -757,6 +783,7 @@ implementation
         pd : tprocdef;
         proc_addr_size: TCgSize;
         proc_addr_voidptrdef: tdef;
+        callref: boolean;
 {$ifdef vtentry}
         sym : tasmsymbol;
 {$endif vtentry}
@@ -884,10 +911,14 @@ implementation
                    tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
 
                  reference_reset_base(href,vmtreg,vmtoffset,proc_addr_voidptrdef.alignment);
-{$ifndef x86}
+                 pvreg:=NR_NO;
-                 pvreg:=cg.getintregister(current_asmdata.CurrAsmList,proc_addr_size);
+
-                 cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,href,pvreg);
+                 callref:=can_call_ref(href);
-{$endif not x86}
+                 if not callref then
+                   begin
+                     pvreg:=cg.getintregister(current_asmdata.CurrAsmList,proc_addr_size);
+                     cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,href,pvreg);
+                   end;
 
                  { Load parameters that are in temporary registers in the
                    correct parameter register }
@@ -899,22 +930,9 @@ implementation
                      freeparas;
                    end;
 
-{$ifdef i8086}
+                 if callref then
-                 if href.base<>NR_NO then
+                   extra_call_ref_code(href);
-                   begin
+
-                     cg.getcpuregister(current_asmdata.CurrAsmList,NR_BX);
-                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,href.base,NR_BX);
-                     href.base:=NR_BX;
-                     cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_BX);
-                   end;
-                 if href.index<>NR_NO then
-                   begin
-                     cg.getcpuregister(current_asmdata.CurrAsmList,NR_SI);
-                     cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,href.base,NR_SI);
-                     href.index:=NR_SI;
-                     cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_SI);
-                   end;
-{$endif i8086}
                  cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
                  if cg.uses_registers(R_ADDRESSREGISTER) then
                    cg.alloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
@@ -925,11 +943,11 @@ implementation
 
                  { call method }
                  extra_call_code;
-{$ifdef x86}
+                 if callref then
-                 hlcg.a_call_ref(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),href);
+                   do_call_ref(href)
-{$else x86}
+                 else
-                 hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
+                   hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
-{$endif x86}
+
                  extra_post_call_code;
                end
              else
@@ -977,12 +995,18 @@ implementation
            { now procedure variable case }
            begin
               secondpass(right);
+              callref:=false;
 
               pvreg:=cg.getintregister(current_asmdata.CurrAsmList,proc_addr_size);
               { Only load OS_ADDR from the reference (when converting to hlcg:
                 watch out with procedure of object) }
               if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
-                cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,right.location.reference,pvreg)
+                begin
+                  href:=right.location.reference;
+                  callref:=can_call_ref(href);
+                  if not callref then
+                    cg.a_load_ref_reg(current_asmdata.CurrAsmList,proc_addr_size,proc_addr_size,right.location.reference,pvreg)
+                end
               else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
                 begin
                   { in case left is a method pointer and we are on a big endian target, then
@@ -1005,6 +1029,9 @@ implementation
                   freeparas;
                 end;
 
+              if callref then
+                extra_call_ref_code(href);
+
               cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
               if cg.uses_registers(R_ADDRESSREGISTER) then
                 cg.alloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
@@ -1018,7 +1045,11 @@ implementation
               if (po_interrupt in procdefinition.procoptions) then
                 extra_interrupt_code;
               extra_call_code;
-              hlcg.a_call_reg(current_asmdata.CurrAsmList,tabstractprocdef(procdefinition),pvreg);
+
+              if callref then
+                do_call_ref(href)
+              else
+                hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg);
               extra_post_call_code;
            end;
 

compiler/x86/cgx86.pas

@@ -61,8 +61,6 @@ unit cgx86;
         procedure a_call_name_static_near(list : TAsmList;const s : string);
         procedure a_call_reg(list : TAsmList;reg : tregister);override;
         procedure a_call_reg_near(list : TAsmList;reg : tregister);
-        procedure a_call_ref(list : TAsmList;ref : treference);override;
-        procedure a_call_ref_near(list : TAsmList;ref : treference);
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
@@ -850,18 +848,6 @@ unit cgx86;
       end;
 
 
-    procedure tcgx86.a_call_ref(list : TAsmList;ref : treference);
-      begin
-        a_call_ref_near(list,ref);
-      end;
-
-
-    procedure tcgx86.a_call_ref_near(list: TAsmList; ref: treference);
-      begin
-        list.concat(taicpu.op_ref(A_CALL,S_NO,ref));
-      end;
-
-
 {********************** load instructions ********************}
 
     procedure tcgx86.a_load_const_reg(list : TAsmList; tosize: TCGSize; a : tcgint; reg : TRegister);

compiler/x86/nx86cal.pas

@@ -29,6 +29,7 @@ interface
 
     uses
       symdef,
+      cgutils,
       ncgcal;
 
     type
@@ -39,6 +40,8 @@ interface
         protected
          procedure do_release_unused_return_value;override;
          procedure set_result_location(realresdef: tstoreddef);override;
+         function can_call_ref(var ref: treference):boolean;override;
+         procedure do_call_ref(ref: treference);override;
        end;
 
 
@@ -46,7 +49,7 @@ implementation
 
     uses
       cgobj,
-      cgbase,cgutils,cpubase,cgx86,cga;
+      cgbase,cpubase,cgx86,cga,aasmdata,aasmcpu;
 
 
 {*****************************************************************************
@@ -81,4 +84,16 @@ implementation
     end;
 
 
+  function tx86callnode.can_call_ref(var ref: treference): boolean;
+    begin
+      tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref);
+      result:=true;
+    end;
+
+
+  procedure tx86callnode.do_call_ref(ref: treference);
+    begin
+      current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+    end;
+
 end.