paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 15:40:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* growing is now 256k or 1mb

Browse Source
This commit is contained in:
peter 1999-05-31 20:36:34 +00:00
parent 20d56ae2a4
commit e161a3e489
2 changed files with 26 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/inc/heap.inc
View File

@ -976,15 +976,24 @@ begin
wantedsize:=size; wantedsize:=size;
{ Allocate by 64K size } { Allocate by 64K size }
size:=(size+$fffff) and $ffff0000; size:=(size+$fffff) and $ffff0000;
{ first try 1Meg } { first try 256K (default) }
if size<GrowHeapSize then if size<GrowHeapSize1 then
begin begin
NewPos:=Sbrk(GrowHeapSize); NewPos:=Sbrk(GrowHeapSize1);
if NewPos>0 then if NewPos>0 then
size:=GrowHeapSize; size:=GrowHeapSize1;
end end
else else
NewPos:=SBrk(size); { second try 1024K (default) }
if size<GrowHeapSize2 then
begin
NewPos:=Sbrk(GrowHeapSize2);
if NewPos>0 then
size:=GrowHeapSize2;
end
{ else alloate the needed bytes }
else
NewPos:=SBrk(size);
{ try again } { try again }
if NewPos=-1 then if NewPos=-1 then
begin begin
@ -1089,7 +1098,10 @@ end;
{ {
$Log$ $Log$
Revision 1.10 1999-05-17 21:52:36 florian Revision 1.11 1999-05-31 20:36:34 peter
* growing is now 256k or 1mb
Revision 1.10 1999/05/17 21:52:36 florian
* most of the Object Pascal stuff moved to the system unit * most of the Object Pascal stuff moved to the system unit
Revision 1.9 1999/04/19 11:53:13 pierre Revision 1.9 1999/04/19 11:53:13 pierre

12
rtl/inc/heaph.inc
View File

@ -30,8 +30,9 @@ Procedure SysFreemem(Var p:pointer;Size:Longint);
{ Variables } { Variables }
const const
heapblocks : boolean=true; heapblocks : boolean=true;
growheapsize : longint=$100000; growheapsize1 : longint=256*1024; { < 256k will grow with 256k }
growheapsize2 : longint=1024*1024; { > 256k will grow with 1m }
var var
heaporg,heapptr,heapend,heaperror,freelist : pointer; heaporg,heapptr,heapend,heaperror,freelist : pointer;
@ -57,14 +58,17 @@ Procedure releaseheap(oldfreelist,oldheapptr : pointer);
Procedure unsplit_heap; Procedure unsplit_heap;
Procedure switch_to_base_heap; Procedure switch_to_base_heap;
Procedure switch_to_temp_heap; Procedure switch_to_temp_heap;
Procedure switch_heap; Procedure switch_heap;
Procedure releasetempheap; Procedure releasetempheap;
Procedure gettempmem(var p : pointer;size : longint); Procedure gettempmem(var p : pointer;size : longint);
{$endif TEMPHEAP} {$endif TEMPHEAP}
{ {
$Log$ $Log$
Revision 1.8 1999-02-08 09:31:40 florian Revision 1.9 1999-05-31 20:36:35 peter
* growing is now 256k or 1mb
Revision 1.8 1999/02/08 09:31:40 florian
* fixed small things regarding TEMPHEAP * fixed small things regarding TEMPHEAP
Revision 1.7 1998/10/01 14:55:18 peter Revision 1.7 1998/10/01 14:55:18 peter