* 8086: Proper implementation of: If a far procvar is called, it must be in a memory location. This fixes a hack to emulate CALL reg1:reg2.

git-svn-id: trunk@46641 -

compiler/i8086/cgcpu.pas

@@ -45,8 +45,6 @@ unit cgcpu;
         procedure a_call_name_far(list : TAsmList;const s : string; weak: boolean);
         procedure a_call_name_static(list : TAsmList;const s : string);override;
         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_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;
@@ -200,38 +198,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg8086.a_call_reg(list: TAsmList; reg: tregister);
-      begin
-        if current_settings.x86memorymodel in x86_far_code_models then
-          a_call_reg_far(list,reg)
-        else
-          a_call_reg_near(list,reg);
-      end;
-
-
-    procedure tcg8086.a_call_reg_far(list: TAsmList; reg: tregister);
-      var
-        href: treference;
-      begin
-        { unfortunately, x86 doesn't have a 'call far reg:reg' instruction, so }
-        { we have to use a temp }
-        tg.gettemp(list,4,2,tt_normal,href);
-        { HACK!!! at this point all registers are allocated, due to the fact that
-          in the pascal calling convention, all registers are caller saved. This
-          causes the register allocator to fail on the next move instruction, so we
-          temporarily deallocate 2 registers.
-          TODO: figure out a better way to do this. }
-        cg.ungetcpuregister(list,NR_BX);
-        cg.ungetcpuregister(list,NR_SI);
-        a_load_reg_ref(list,OS_32,OS_32,reg,href);
-        cg.getcpuregister(list,NR_BX);
-        cg.getcpuregister(list,NR_SI);
-        href.segment:=NR_NO;
-        list.concat(taicpu.op_ref(A_CALL,S_FAR,href));
-        tg.ungettemp(list,href);
-      end;
-
-
     procedure tcg8086.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize;
       a: tcgint; reg: TRegister);
       type

compiler/i8086/hlcgcpu.pas

@@ -71,6 +71,7 @@ interface
 
       function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
       function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
+      function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
 
       procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
       procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
@@ -334,6 +335,14 @@ implementation
     end;
 
 
+  function thlcgcpu.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
+    begin
+      if is_proc_far(pd) then
+        Internalerror(2020082201);
+      Result:=inherited a_call_reg(list, pd, reg, paras);
+    end;
+
+
   procedure thlcgcpu.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);
     var
       tmpref: treference;

compiler/i8086/n8086cal.pas

@@ -28,6 +28,7 @@ interface
 { $define AnsiStrRef}
 
     uses
+      node,
       parabase,
       nx86cal,cgutils;
 
@@ -39,6 +40,8 @@ interface
           procedure extra_call_ref_code(var ref: treference);override;
           function do_call_ref(ref: treference): tcgpara;override;
           function can_call_ref(var ref: treference): boolean; override;
+        public
+          function pass_1: tnode; override;
        end;
 
 
@@ -47,6 +50,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
+      htypechk,pass_1,
       cgbase,
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
@@ -150,6 +154,26 @@ implementation
       end;
 
 
+    function ti8086callnode.pass_1: tnode;
+      begin
+        { If a far procvar is called, it must be in a memory location.
+          There is no CALL reg1:reg2 instruction. }
+        if (right<>nil) then
+          if is_proc_far(procdefinition) then
+            begin
+              make_not_regable(right,[]);
+              firstpass(right);
+              if not (right.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                begin
+                  { Use a temp if the procvar still not a reference }
+                  load_in_temp(right);
+                  make_not_regable(right,[]);
+                end;
+            end;
+
+        Result:=inherited pass_1;
+      end;
+
 begin
    ccallnode:=ti8086callnode;
 end.

compiler/ncal.pas

@@ -92,6 +92,7 @@ interface
           function get_expect_loc: tcgloc;
        protected
           function safe_call_self_node: tnode;
+          procedure load_in_temp(var p:tnode);
           procedure gen_vmt_entry_load; virtual;
           procedure gen_syscall_para(para: tcallparanode); virtual;
           procedure objc_convert_to_message_send;virtual;
@@ -2109,6 +2110,16 @@ implementation
       end;
 
     procedure tcallnode.maybe_load_in_temp(var p:tnode);
+      begin
+        { Load all complex loads into a temp to prevent
+          double calls to a function. We can't simply check for a hp.nodetype=calln }
+        if assigned(p) and
+           foreachnodestatic(p,@look_for_call,nil) then
+          load_in_temp(p);
+      end;
+
+
+    procedure tcallnode.load_in_temp(var p:tnode);
       var
         loadp,
         refp  : tnode;
@@ -2116,10 +2127,7 @@ implementation
         ptemp : ttempcreatenode;
         usederef : boolean;
       begin
-        { Load all complex loads into a temp to prevent
-          double calls to a function. We can't simply check for a hp.nodetype=calln }
-        if assigned(p) and
-           foreachnodestatic(p,@look_for_call,nil) then
+        if assigned(p) then
           begin
             { temp create }
             usederef:=(p.resultdef.typ in [arraydef,recorddef]) or