From d6ad2b1f8af672fe23bdb8b09708479bb96079b7 Mon Sep 17 00:00:00 2001
From: nickysn <nickysn@gmail.com>
Date: Wed, 16 Apr 2014 23:09:18 +0000
Subject: [PATCH] + added support for mixing near and far procedures in the
 i8086 far code memory   models. The $F directive and the 'near' and 'far'
 procedure modifiers should   now work as expected in the far code memory
 models (they are still ignored in   the near code memory models). The
 compiler defaults to the {$F+} state,   because {$F-} requires adding 'far'
 to a lot of procedures in the rtl,   packages and tests.

git-svn-id: trunk@27590 -
---
 compiler/globals.pas      |  2 +-
 compiler/i8086/symcpu.pas | 52 ++++++++++++++++++++++++++++++++++++---
 2 files changed, 50 insertions(+), 4 deletions(-)

diff --git a/compiler/globals.pas b/compiler/globals.pas
index ba08bcaf5d..36b8f85f10 100644
--- a/compiler/globals.pas
+++ b/compiler/globals.pas
@@ -393,7 +393,7 @@ interface
         globalswitches : [cs_check_unit_name,cs_link_static];
         targetswitches : [];
         moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
-        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath];
+        localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath{$ifdef i8086},cs_force_far_calls{$endif}];
         modeswitches : fpcmodeswitches;
         optimizerswitches : [];
         genwpoptimizerswitches : [];
diff --git a/compiler/i8086/symcpu.pas b/compiler/i8086/symcpu.pas
index 1dcf3616ef..931c5230f0 100644
--- a/compiler/i8086/symcpu.pas
+++ b/compiler/i8086/symcpu.pas
@@ -99,8 +99,18 @@ type
   { tcpuprocdef }
 
   tcpuprocdef = class(ti86procdef)
+   private
+    { returns whether the function is far by default, i.e. whether it would be
+      far if _all_ of the following conditions are true:
+      - we're in a far code memory model
+      - it has no 'near' or 'far' specifiers
+      - it is compiled in a $F- state }
+    function default_far:boolean;
+   public
     constructor create(level:byte);override;
     function address_type:tdef;override;
+    procedure declared_far;override;
+    procedure declared_near;override;
     function is_far:boolean;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
@@ -211,8 +221,8 @@ implementation
   constructor tcpuprocdef.create(level: byte);
     begin
       inherited create(level);
-      { todo: allow using near procs in the far code memory models, like in TP7 }
-      if current_settings.x86memorymodel in x86_far_code_models then
+      if (current_settings.x86memorymodel in x86_far_code_models) and
+         (cs_force_far_calls in current_settings.localswitches) then
         procoptions:=procoptions+[po_far];
     end;
 
@@ -226,9 +236,45 @@ implementation
     end;
 
 
+  procedure tcpuprocdef.declared_far;
+    begin
+      if current_settings.x86memorymodel in x86_far_code_models then
+        include(procoptions,po_far)
+      else
+        inherited declared_far;
+    end;
+
+
+  procedure tcpuprocdef.declared_near;
+    begin
+      if current_settings.x86memorymodel in x86_far_code_models then
+        exclude(procoptions,po_far)
+      else
+        inherited declared_near;
+    end;
+
+
+  function tcpuprocdef.default_far: boolean;
+    begin
+      if proctypeoption in [potype_proginit,potype_unitinit,potype_unitfinalize,
+                            potype_constructor,potype_destructor,
+                            potype_class_constructor,potype_class_destructor,
+                            potype_propgetter,potype_propsetter] then
+        exit(true);
+      if (procoptions*[po_classmethod,po_virtualmethod,po_abstractmethod,
+                       po_finalmethod,po_staticmethod,po_overridingmethod,
+                       po_external,po_public])<>[] then
+        exit(true);
+      if is_methodpointer then
+        exit(true);
+      result:=not (visibility in [vis_private,vis_hidden]);
+    end;
+
+
   function tcpuprocdef.is_far: boolean;
     begin
-      result:=po_far in procoptions;
+      result:=(current_settings.x86memorymodel in x86_far_code_models) and
+        ((po_far in procoptions) or default_far);
     end;
 
 {****************************************************************************