+ i8086 specific far proc aware implementation of ttypeconvnode.second_proc_to_procvar

git-svn-id: trunk@24860 -

.gitattributes

@@ -248,6 +248,7 @@ compiler/i8086/i8086prop.inc svneol=native#text/plain
 compiler/i8086/i8086tab.inc svneol=native#text/plain
 compiler/i8086/n8086add.pas svneol=native#text/plain
 compiler/i8086/n8086cal.pas svneol=native#text/plain
+compiler/i8086/n8086cnv.pas svneol=native#text/plain
 compiler/i8086/n8086con.pas svneol=native#text/plain
 compiler/i8086/n8086inl.pas svneol=native#text/plain
 compiler/i8086/n8086mat.pas svneol=native#text/plain

compiler/i8086/cpunode.pas

@@ -46,10 +46,10 @@ unit cpunode;
          after the generic one (FK)
        }
        nx86set,
-       nx86cnv,
 
        n8086add,
        n8086cal,
+       n8086cnv,
        n8086mem{,
        n386set},
        n8086inl,

compiler/i8086/n8086cnv.pas

@@ -0,0 +1,137 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate code for i8086 assembler for type converting nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit n8086cnv;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,ncgcnv,nx86cnv,defutil,defcmp;
+
+    type
+       t8086typeconvnode = class(tx86typeconvnode)
+       protected
+         procedure second_proc_to_procvar;override;
+       end;
+
+
+implementation
+
+   uses
+      verbose,systems,globals,globtype,
+      aasmbase,aasmtai,aasmdata,aasmcpu,
+      symconst,symdef,
+      cgbase,cga,procinfo,pass_1,pass_2,
+      ncon,ncal,ncnv,
+      cpubase,cpuinfo,
+      cgutils,cgobj,hlcgobj,cgx86,ncgutil,
+      tgobj;
+
+
+    procedure t8086typeconvnode.second_proc_to_procvar;
+      var
+        tmpreg: tregister;
+        tmpref: treference;
+      begin
+        if not (po_far in tabstractprocdef(resultdef).procoptions) then
+          begin
+            inherited;
+            exit;
+          end;
+
+        if tabstractprocdef(resultdef).is_addressonly then
+          begin
+            location_reset(location,LOC_REGISTER,OS_32);
+            { only a code pointer? (when taking the address of classtype.method
+              we also only get a code pointer even though the resultdef is a
+              procedure of object, and hence is_addressonly would return false)
+             }
+  	    if left.location.size = OS_32 then
+              begin
+                case left.location.loc of
+                  LOC_REFERENCE,LOC_CREFERENCE:
+                    begin
+                      { the procedure symbol is encoded in reference.symbol -> take address }
+                      location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                      cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register);
+                      tmpref:=left.location.reference;
+                      tmpref.refaddr:=addr_seg;
+                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_16,OS_16,tmpref,GetNextReg(location.register));
+                    end;
+                  else
+                    internalerror(2013031501)
+                end;
+              end
+            else
+              begin
+                { TODO: update for far procs }
+                { conversion from a procedure of object/nested procvar to plain procvar }
+                case left.location.loc of
+                  LOC_REFERENCE,LOC_CREFERENCE:
+                    begin
+                      location.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                      { code field is the first one }
+                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register);
+                    end;
+                  LOC_REGISTER,LOC_CREGISTER:
+                    begin
+                      if target_info.endian=endian_little then
+                        location.register:=left.location.register
+                      else
+                        location.register:=left.location.registerhi;
+                    end;
+                  else
+                    internalerror(2013031502)
+                end;
+              end;
+          end
+        else
+          begin
+            { TODO: update for far procs }
+            if not tabstractprocdef(left.resultdef).is_addressonly then
+              location_copy(location,left.location)
+            else
+              begin
+                { assigning a global function to a nested procvar -> create
+                  tmethodpointer record and set the "frame pointer" to nil }
+                if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                  internalerror(2013031503);
+                location_reset_ref(location,LOC_REFERENCE,int_cgsize(sizeof(pint)*2),sizeof(pint));
+                tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
+                tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
+                cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,tmpreg);
+                cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,location.reference);
+                { setting the frame pointer to nil is not strictly necessary
+                  since the global procedure won't use it, but it can help with
+                  debugging }
+                inc(location.reference.offset,sizeof(pint));
+                cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_ADDR,0,location.reference);
+                dec(location.reference.offset,sizeof(pint));
+              end;
+          end;
+      end;
+
+
+begin
+  ctypeconvnode:=t8086typeconvnode
+end.