+ 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 -
This commit is contained in:
nickysn 2014-06-19 14:14:01 +00:00
parent 2557f1bfa3
commit 7cfd7a66cd
11 changed files with 56 additions and 11 deletions

View File

@ -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);

View File

@ -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);

View File

@ -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.

View File

@ -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];

View File

@ -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=(

View File

@ -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];

View File

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

View File

@ -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));

View File

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

View File

@ -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

View File

@ -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