* 8086: 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@46557 -

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;
@@ -332,6 +333,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;
 
@@ -38,6 +39,8 @@ interface
           procedure extra_interrupt_code;override;
           procedure extra_call_ref_code(var ref: treference);override;
           function do_call_ref(ref: treference): tcgpara;override;
+        public
+          function pass_typecheck: tnode; override;
        end;
 
 
@@ -46,6 +49,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
+      htypechk,
       cgbase,
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
@@ -127,6 +131,19 @@ implementation
       end;
 
 
+    function ti8086callnode.pass_typecheck: tnode;
+      begin
+        Result:=inherited pass_typecheck;
+        { If calling a procvar allow the procvar address to be in a register only for
+          the register calling convention and near code memory models.
+          In other cases there are no available registers to perform the call.
+          Additionally there is no CALL reg1:reg2 instruction. }
+        if (right<>nil) then
+          if is_proc_far(procdefinition) or
+             (procdefinition.proccalloption<>pocall_register) then
+            make_not_regable(right,[]);
+      end;
+
 begin
    ccallnode:=ti8086callnode;
 end.