Przeglądaj źródła

+ create a special 'heap' segment with reserved space equal to heapsize (i.e.
the value set by -Ch or the second parameter to the $M directive). This is
equivalent to the heapmin value in Turbo Pascal 7 and ensures that the program
has at least this amount of heap space available (otherwise DOS will show a
'not enough memory' error and will refuse to load the program).

git-svn-id: trunk@28002 -

nickysn 11 lat temu
rodzic
commit
7cfd7a66cd

+ 3 - 1
compiler/aasmbase.pas

@@ -142,7 +142,9 @@ interface
          sec_objc_nlcatlist,
          sec_objc_nlcatlist,
          sec_objc_protolist,
          sec_objc_protolist,
          { stack segment for 16-bit DOS }
          { stack segment for 16-bit DOS }
-         sec_stack
+         sec_stack,
+         { initial heap segment for 16-bit DOS }
+         sec_heap
        );
        );
 
 
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);
        TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end);

+ 6 - 3
compiler/aggas.pas

@@ -348,7 +348,8 @@ implementation
           '.objc_catlist',
           '.objc_catlist',
           '.obcj_nlcatlist',
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.objc_protolist',
-          '.stack'
+          '.stack',
+          '.heap'
         );
         );
         secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
         secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','',
           '.text',
           '.text',
@@ -406,7 +407,8 @@ implementation
           '.objc_catlist',
           '.objc_catlist',
           '.obcj_nlcatlist',
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.objc_protolist',
-          '.stack'
+          '.stack',
+          '.heap'
         );
         );
       var
       var
         sep     : string[3];
         sep     : string[3];
@@ -2017,7 +2019,8 @@ implementation
          sec_none (* sec_objc_catlist *),
          sec_none (* sec_objc_catlist *),
          sec_none (* sec_objc_nlcatlist *),
          sec_none (* sec_objc_nlcatlist *),
          sec_none (* sec_objc_protlist *),
          sec_none (* sec_objc_protlist *),
-         sec_none (* sec_stack *)
+         sec_none (* sec_stack *),
+         sec_none (* sec_heap *)
         );
         );
       begin
       begin
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);
         Result := inherited SectionName (SecXTable [AType], AName, AOrder);

+ 27 - 0
compiler/i8086/n8086util.pas

@@ -33,6 +33,7 @@ interface
     ti8086nodeutils = class(tnodeutils)
     ti8086nodeutils = class(tnodeutils)
       class procedure InsertMemorySizes; override;
       class procedure InsertMemorySizes; override;
       class procedure InsertStackSegment;
       class procedure InsertStackSegment;
+      class procedure InsertHeapSegment;
     end;
     end;
 
 
 
 
@@ -49,6 +50,7 @@ implementation
       inherited;
       inherited;
       if current_settings.x86memorymodel<>mm_tiny then
       if current_settings.x86memorymodel<>mm_tiny then
         InsertStackSegment;
         InsertStackSegment;
+      InsertHeapSegment;
     end;
     end;
 
 
 
 
@@ -77,6 +79,31 @@ implementation
     end;
     end;
 
 
 
 
+  class procedure ti8086nodeutils.InsertHeapSegment;
+    var
+      heapsizeleft,heapblock: LongInt;
+      i: Integer;
+    begin
+      maybe_new_object_file(current_asmdata.asmlists[al_globals]);
+      new_section(current_asmdata.asmlists[al_globals],sec_heap,'__heap', 16);
+      current_asmdata.asmlists[al_globals].concat(tai_symbol.Createname_global('___heap', AT_DATA, heapsize));
+      { HACK: since tai_datablock's size parameter is aint, which cannot be
+        larger than 32767 on i8086, but we'd like to support heap size of
+        up to 640kb, we may need to use several tai_datablocks to reserve
+        the heap segment }
+      i:=0;
+      heapsizeleft:=heapsize;
+      while heapsizeleft>0 do
+        begin
+          heapblock:=min(heapsizeleft,high(aint));
+          current_asmdata.asmlists[al_globals].concat(tai_datablock.Create('___heapblock'+IntToStr(i),heapblock));
+          dec(heapsizeleft,heapblock);
+          inc(i);
+        end;
+      current_asmdata.asmlists[al_globals].concat(tai_symbol.Createname_global('___heaptop',AT_DATA,0));
+    end;
+
+
 begin
 begin
   cnodeutils:=ti8086nodeutils;
   cnodeutils:=ti8086nodeutils;
 end.
 end.

+ 2 - 1
compiler/ogbase.pas

@@ -1080,7 +1080,8 @@ implementation
           {sec_objc_catlist} [oso_data,oso_load],
           {sec_objc_catlist} [oso_data,oso_load],
           {sec_objc_nlcatlist} [oso_data,oso_load],
           {sec_objc_nlcatlist} [oso_data,oso_load],
           {sec_objc_protolist'} [oso_data,oso_load],
           {sec_objc_protolist'} [oso_data,oso_load],
-          {stack} [oso_load,oso_write]
+          {stack} [oso_load,oso_write],
+          {heap} [oso_load,oso_write]
         );
         );
       begin
       begin
         result:=secoptions[atype];
         result:=secoptions[atype];

+ 2 - 1
compiler/ogcoff.pas

@@ -540,7 +540,8 @@ implementation
           '.objc_catlist',
           '.objc_catlist',
           '.obcj_nlcatlist',
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.objc_protolist',
-          '.stack'
+          '.stack',
+          '.heap'
         );
         );
 
 
 const go32v2stub : array[0..2047] of byte=(
 const go32v2stub : array[0..2047] of byte=(

+ 2 - 1
compiler/ogelf.pas

@@ -794,7 +794,8 @@ implementation
           '.objc_catlist',
           '.objc_catlist',
           '.obcj_nlcatlist',
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.objc_protolist',
-          '.stack'
+          '.stack',
+          '.heap'
         );
         );
       var
       var
         sep : string[3];
         sep : string[3];

+ 1 - 0
compiler/powerpc/agppcmpw.pas

@@ -116,6 +116,7 @@ interface
         '',
         '',
         '',
         '',
         '',
         '',
+        '',
         ''
         ''
       );
       );
 
 

+ 1 - 1
compiler/systems/t_msdos.pas

@@ -280,7 +280,7 @@ begin
   if current_settings.x86memorymodel=mm_tiny then
   if current_settings.x86memorymodel=mm_tiny then
     LinkRes.Add('order clname CODE clname DATA clname BSS')
     LinkRes.Add('order clname CODE clname DATA clname BSS')
   else
   else
-    LinkRes.Add('order clname CODE clname BEGDATA segment _NULL segment _AFTERNULL clname DATA clname BSS clname STACK');
+    LinkRes.Add('order clname CODE clname BEGDATA segment _NULL segment _AFTERNULL clname DATA clname BSS clname STACK clname HEAP');
   if (cs_link_map in current_settings.globalswitches) then
   if (cs_link_map in current_settings.globalswitches) then
     LinkRes.Add('option map='+maybequoted(ChangeFileExt(current_module.exefilename,'.map')));
     LinkRes.Add('option map='+maybequoted(ChangeFileExt(current_module.exefilename,'.map')));
   LinkRes.Add('name ' + maybequoted(current_module.exefilename));
   LinkRes.Add('name ' + maybequoted(current_module.exefilename));

+ 2 - 0
compiler/x86/agx86int.pas

@@ -107,6 +107,7 @@ implementation
         '',
         '',
         '',
         '',
         '',
         '',
+        '',
         ''
         ''
       );
       );
 
 
@@ -158,6 +159,7 @@ implementation
         '',
         '',
         '',
         '',
         '',
         '',
+        '',
         ''
         ''
       );
       );
 
 

+ 5 - 3
compiler/x86/agx86nsm.pas

@@ -559,7 +559,8 @@ interface
           '.objc_catlist',
           '.objc_catlist',
           '.obcj_nlcatlist',
           '.obcj_nlcatlist',
           '.objc_protolist',
           '.objc_protolist',
-          '.stack'
+          '.stack',
+          '.heap'
         );
         );
       begin
       begin
         AsmLn;
         AsmLn;
@@ -1217,11 +1218,12 @@ interface
       AsmWriteLn('SECTION .bss class=bss');
       AsmWriteLn('SECTION .bss class=bss');
       if current_settings.x86memorymodel<>mm_tiny then
       if current_settings.x86memorymodel<>mm_tiny then
         AsmWriteLn('SECTION stack stack class=stack align=16');
         AsmWriteLn('SECTION stack stack class=stack align=16');
+      AsmWriteLn('SECTION heap class=heap align=16');
       { group these sections in the same segment }
       { group these sections in the same segment }
       if current_settings.x86memorymodel=mm_tiny then
       if current_settings.x86memorymodel=mm_tiny then
-        AsmWriteLn('GROUP dgroup text rodata data fpc bss')
+        AsmWriteLn('GROUP dgroup text rodata data fpc bss heap')
       else if current_settings.x86memorymodel in x86_near_data_models then
       else if current_settings.x86memorymodel in x86_near_data_models then
-        AsmWriteLn('GROUP dgroup rodata data fpc bss stack')
+        AsmWriteLn('GROUP dgroup rodata data fpc bss stack heap')
       else
       else
         AsmWriteLn('GROUP dgroup rodata data fpc bss');
         AsmWriteLn('GROUP dgroup rodata data fpc bss');
       if paratargetdbg in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then
       if paratargetdbg in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then

+ 5 - 0
rtl/msdos/prt0comn.asm

@@ -53,6 +53,8 @@
         extern __nearheap_start
         extern __nearheap_start
         extern __nearheap_end
         extern __nearheap_end
 
 
+        extern ___heap
+
 %ifndef __TINY__
 %ifndef __TINY__
     %ifdef __FAR_DATA__
     %ifdef __FAR_DATA__
         extern ___stack
         extern ___stack
@@ -465,6 +467,9 @@ mem_realloc_err_msg:
         db 'Memory allocation error', 13, 10, '$'
         db 'Memory allocation error', 13, 10, '$'
 not_enough_mem_msg:
 not_enough_mem_msg:
         db 'Not enough memory', 13, 10, '$'
         db 'Not enough memory', 13, 10, '$'
+        ; add reference to the beginning of the minimal heap, so the object
+        ; module, containing the heap segment doesn't get smartlinked away
+        dd ___heap
 
 
         segment bss class=bss
         segment bss class=bss