paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 22:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ create a special 'heap' segment with reserved space equal to heapsize (i.e.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/aasmbase.pas
View File

@ -142,7 +142,9 @@ interface
sec_objc_nlcatlist,
sec_objc_protolist,
{ 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);

9
compiler/aggas.pas
View File

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

27
compiler/i8086/n8086util.pas
View File

@ -33,6 +33,7 @@ interface
ti8086nodeutils = class(tnodeutils)
class procedure InsertMemorySizes; override;
class procedure InsertStackSegment;
class procedure InsertHeapSegment;
end;
@ -49,6 +50,7 @@ implementation
inherited;
if current_settings.x86memorymodel<>mm_tiny then
InsertStackSegment;
InsertHeapSegment;
end;
@ -77,6 +79,31 @@ implementation
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
cnodeutils:=ti8086nodeutils;
end.

3
compiler/ogbase.pas
View File

@ -1080,7 +1080,8 @@ implementation
{sec_objc_catlist} [oso_data,oso_load],
{sec_objc_nlcatlist} [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
result:=secoptions[atype];

3
compiler/ogcoff.pas
View File

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

3
compiler/ogelf.pas
View File

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

1
compiler/powerpc/agppcmpw.pas
View File

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

2
compiler/systems/t_msdos.pas
View File

@ -280,7 +280,7 @@ begin
if current_settings.x86memorymodel=mm_tiny then
LinkRes.Add('order clname CODE clname DATA clname BSS')
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
LinkRes.Add('option map='+maybequoted(ChangeFileExt(current_module.exefilename,'.map')));
LinkRes.Add('name ' + maybequoted(current_module.exefilename));

2
compiler/x86/agx86int.pas
View File

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

8
compiler/x86/agx86nsm.pas
View File

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

5
rtl/msdos/prt0comn.asm
View File

@ -53,6 +53,8 @@
extern __nearheap_start
extern __nearheap_end
extern ___heap
%ifndef __TINY__
%ifdef __FAR_DATA__
extern ___stack
@ -465,6 +467,9 @@ mem_realloc_err_msg:
db 'Memory allocation error', 13, 10, '$'
not_enough_mem_msg:
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