+ added support for units with code larger than 64kb in the far code i8086

memory models. Enabled by the new directive {$hugecode on}. The directive is
  ignored in the near code memory models. When enabled, it forces each procedure
  to be in a separate segment and disables mixing near and far procedures (so
  'near' and {$F-} are ignored in this mode). Note that {$hugecode on} does not
  count as a different memory model, because you can freely link modules (units)
  compiled with {$hugecode on} and {$hugecode off}.

git-svn-id: trunk@27615 -

compiler/globtype.pas

@@ -164,7 +164,9 @@ interface
          { browser switches are back }
          cs_browser,cs_local_browser,
          { target specific }
-         cs_executable_stack
+         cs_executable_stack,
+         { i8086 specific }
+         cs_huge_code
        );
        tmoduleswitches = set of tmoduleswitch;
 

compiler/i8086/symcpu.pas

@@ -222,7 +222,8 @@ implementation
     begin
       inherited create(level);
       if (current_settings.x86memorymodel in x86_far_code_models) and
-         (cs_force_far_calls in current_settings.localswitches) then
+         ((cs_huge_code in current_settings.moduleswitches) or
+          (cs_force_far_calls in current_settings.localswitches)) then
         procoptions:=procoptions+[po_far];
     end;
 
@@ -247,7 +248,8 @@ implementation
 
   procedure tcpuprocdef.declared_near;
     begin
-      if current_settings.x86memorymodel in x86_far_code_models then
+      if (current_settings.x86memorymodel in x86_far_code_models) and
+         not (cs_huge_code in current_settings.moduleswitches) then
         exclude(procoptions,po_far)
       else
         inherited declared_near;

compiler/scandir.pas

@@ -1516,6 +1516,20 @@ unit scandir;
       begin
       end;
 
+    procedure dir_hugecode;
+      begin
+        if (target_info.system<>system_i8086_msdos)
+{$ifdef i8086}
+           or (current_settings.x86memorymodel in x86_near_code_models)
+{$endif i8086}
+            then
+          begin
+            Message1(scan_n_ignored_switch,pattern);
+            exit;
+          end;
+        do_moduleswitch(cs_huge_code);
+      end;
+
     procedure dir_weakpackageunit;
       begin
       end;
@@ -1618,6 +1632,7 @@ unit scandir;
         AddDirective('HINT',directive_all, @dir_hint);
         AddDirective('HINTS',directive_all, @dir_hints);
         AddDirective('HPPEMIT',directive_all, @dir_hppemit);
+        AddDirective('HUGECODE',directive_all, @dir_hugecode);
         AddDirective('IEEEERRORS',directive_all,@dir_ieeeerrors);
         AddDirective('IOCHECKS',directive_all, @dir_iochecks);
         AddDirective('IMAGEBASE',directive_all, @dir_imagebase);

compiler/x86/agx86nsm.pas

@@ -37,7 +37,7 @@ interface
       TX86NasmAssembler = class(texternalassembler)
       private
         using_relative : boolean;
-        function CodeSectionName: string;
+        function CodeSectionName(const aname:string): string;
         procedure WriteReference(var ref : treference);
         procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
         procedure WriteOper_jmp(const o:toper; ai : taicpu);
@@ -312,11 +312,16 @@ interface
  ****************************************************************************}
 
 
-    function TX86NasmAssembler.CodeSectionName: string;
+    function TX86NasmAssembler.CodeSectionName(const aname:string): string;
       begin
 {$ifdef i8086}
         if current_settings.x86memorymodel in x86_far_code_models then
-          result:=current_module.modulename^ + '_TEXT'
+          begin
+            if cs_huge_code in current_settings.moduleswitches then
+              result:=aname + '_TEXT use16 class=code'
+            else
+              result:=current_module.modulename^ + '_TEXT';
+          end
         else
 {$endif}
           result:='.text';
@@ -581,7 +586,7 @@ interface
           (target_info.system in (systems_windows+systems_wince)) then
           AsmWrite('.tls'#9'bss')
         else if secnames[atype]='.text' then
-          AsmWrite(CodeSectionName)
+          AsmWrite(CodeSectionName(aname))
         else
           AsmWrite(secnames[atype]);
         if create_smartlink_sections and
@@ -1211,7 +1216,7 @@ interface
           internalerror(2013050101);
       end;
 
-      AsmWriteLn('SECTION ' + CodeSectionName + ' use16 class=code');
+      AsmWriteLn('SECTION ' + CodeSectionName(current_module.modulename^) + ' use16 class=code');
       { NASM complains if you put a missing section in the GROUP directive, so }
       { we add empty declarations to make sure they exist, even if empty }
       AsmWriteLn('SECTION .rodata');
@@ -1231,7 +1236,7 @@ interface
           AsmWriteLn('SECTION .debug_line   use32 class=DWARF');
           AsmWriteLn('SECTION .debug_abbrev use32 class=DWARF');
         end;
-      AsmWriteLn('SECTION ' + CodeSectionName);
+      AsmWriteLn('SECTION ' + CodeSectionName(current_module.modulename^));
 {$else i8086}
 {$ifdef i386}
       AsmWriteLn('BITS 32');