paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 17:10:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Patch for heap allocation from Florian

Browse Source
This commit is contained in:
michael 1999-08-20 10:31:17 +00:00
parent f0fa79dad2
commit 50ae4cf315
1 changed files with 33 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/inc/heap.inc
View File

@ -532,7 +532,8 @@ var
proc : heaperrorproc;
last,hp : pfreerecord;
again : boolean;
s,hpsize : longint;
s,sizeleft,hpsize : longint;
pp : pointer;
{$IfDef CHECKHEAP}
i,bp,orsize : longint;
label
@ -588,6 +589,33 @@ begin
{$else CHECKHEAP}
exit;
{$endif CHECKHEAP}
end
else
begin
inc(s);
while s<=maxblock do
begin
p:=blocks^[s];
if assigned(p) then
begin
blocks^[s]:=pointer(p^);
dec(nblocks^[s]);
sizeleft:=s-(size shr 3);
// reinsert the rest of the block
pp:=p+size;
ppointer(pp)^:=blocks^[sizeleft];
blocks^[sizeleft]:=pp;
inc(nblocks^[sizeleft]);
{$ifdef CHECKHEAP}
goto check_new;
{$else CHECKHEAP}
exit;
{$endif CHECKHEAP}
end;
inc(s);
end;
end;
end;
end;
@ -1098,7 +1126,10 @@ end;
{
$Log$
Revision 1.11 1999-05-31 20:36:34 peter
Revision 1.12 1999-08-20 10:31:17 michael
+ Patch for heap allocation from 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