paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* readded support for ReturnIfGrowHeapFails

Browse Source
This commit is contained in:
peter 2004-06-29 20:50:32 +00:00
parent aa96e78b7c
commit cd35d3fd5e
2 changed files with 27 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/inc/heap.inc
View File

@ -816,10 +816,15 @@ begin
result := SysOSAlloc(size);
{ try again }
if result=nil then
begin
begin
result := SysOSAlloc(size);
if result=nil then
HandleError(203);
if (result=nil) then
begin
if ReturnNilIfGrowHeapFails then
exit
else
HandleError(203);
end;
end;
{ set the total new heap size }
inc(internal_memavail,size);
@ -873,12 +878,17 @@ var
poc: poschunk;
s: ptrint;
begin
result:=nil;
{ try to find a block in one of the freelists per size }
s := size shr blockshr;
pcurr := freelists_fixed[s];
{ no free blocks ? }
if not assigned(pcurr) then
pcurr := alloc_oschunk(s, size);
begin
pcurr := alloc_oschunk(s, size);
if not assigned(pcurr) then
exit;
end;
{ get a pointer to the block we should return }
result := pointer(pcurr)+sizeof(tmemchunk_fixed_hdr);
{ flag as in-use }
@ -902,6 +912,7 @@ var
pbest : pmemchunk_var;
{$endif}
begin
result:=nil;
{$ifdef BESTMATCH}
pbest := nil;
{$endif}
@ -935,6 +946,8 @@ begin
begin
// all os-chunks full, allocate a new one
pcurr := alloc_oschunk(0, size);
if not assigned(pcurr) then
exit;
end;
{ get pointer of the block we should return }
@ -1290,7 +1303,10 @@ end;
{
$Log$
Revision 1.34 2004-06-27 19:47:27 florian
Revision 1.35 2004-06-29 20:50:32 peter
* readded support for ReturnIfGrowHeapFails
Revision 1.34 2004/06/27 19:47:27 florian
* fixed heap corruption on sparc
Revision 1.33 2004/06/27 11:57:18 florian

7
rtl/inc/heaph.inc
View File

@ -45,6 +45,8 @@ const
growheapsizesmall : ptrint=32*1024; { fixed-size small blocks will grow with 32k }
growheapsize1 : ptrint=256*1024; { < 256k will grow with 256k }
growheapsize2 : ptrint=1024*1024; { > 256k will grow with 1m }
var
ReturnNilIfGrowHeapFails : boolean;
{ Default MemoryManager functions }
Function SysGetmem(Size:ptrint):Pointer;
@ -93,7 +95,10 @@ Procedure AsmFreemem(var p:pointer);
{
$Log$
Revision 1.10 2004-06-20 09:24:40 peter
Revision 1.11 2004-06-29 20:50:32 peter
* readded support for ReturnIfGrowHeapFails
Revision 1.10 2004/06/20 09:24:40 peter
fixed go32v2 compile
Revision 1.9 2004/06/17 16:16:13 peter