paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* check if there is enough room before concatting blocks in

Browse Source 
systryresizemem()
This commit is contained in:
peter 2005-04-04 15:40:30 +00:00
parent aef9ac69a2
commit fc977d3259
1 changed files with 49 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
rtl/inc/heap.inc
View File

@ -792,6 +792,31 @@ begin
result := mc; result := mc;
end; end;
function check_concat_free_chunk_forward(mc: pmemchunk_var;reqsize:ptrint):boolean;
var
mc_tmp : pmemchunk_var;
freesize : ptrint;
begin
check_concat_free_chunk_forward:=false;
freesize:=0;
mc_tmp:=mc;
repeat
inc(freesize,mc_tmp^.size and sizemask);
if freesize>=reqsize then
begin
check_concat_free_chunk_forward:=true;
exit;
end;
if (mc_tmp^.size and lastblockflag) <> 0 then
break;
mc_tmp := pmemchunk_var(pointer(mc_tmp)+(mc_tmp^.size and sizemask));
if (mc_tmp^.size and usedflag) <> 0 then
break;
until false;
end;
{***************************************************************************** {*****************************************************************************
Grow Heap Grow Heap
*****************************************************************************} *****************************************************************************}
@ -1204,6 +1229,8 @@ var
currsize : ptrint; currsize : ptrint;
pcurr : pmemchunk_var; pcurr : pmemchunk_var;
begin begin
SysTryResizeMem := false;
{ fix p to point to the heaprecord } { fix p to point to the heaprecord }
pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size; pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
if (pcurrsize and fixedsizeflag) = 0 then if (pcurrsize and fixedsizeflag) = 0 then
@ -1230,10 +1257,7 @@ begin
{ don't do resizes on fixed-size blocks } { don't do resizes on fixed-size blocks }
if (pcurrsize and fixedsizeflag) <> 0 then if (pcurrsize and fixedsizeflag) <> 0 then
begin exit;
SysTryResizeMem := false;
exit;
end;
{ get pointer to block } { get pointer to block }
pcurr := pmemchunk_var(pointer(p)-sizeof(tmemchunk_var_hdr)); pcurr := pmemchunk_var(pointer(p)-sizeof(tmemchunk_var_hdr));
@ -1245,19 +1269,25 @@ begin
{ the size is bigger than the previous size, we need to allocated more mem. { the size is bigger than the previous size, we need to allocated more mem.
We first check if the blocks after the current block are free. If not we We first check if the blocks after the current block are free. If not we
simply call getmem/freemem to get the new block } simply call getmem/freemem to get the new block }
try_concat_free_chunk_forward(pcurr); if check_concat_free_chunk_forward(pcurr,size) then
currsize := (pcurr^.size and sizemask); begin
SysTryResizeMem := currsize>=size; try_concat_free_chunk_forward(pcurr);
currsize := (pcurr^.size and sizemask);
end;
end; end;
{ not enough space? }
if size>currsize then
exit;
{ is the size smaller then we can adjust the block to that size and insert
the other part into the freelist }
if currsize>size then if currsize>size then
begin split_block(pcurr, size);
{ is the size smaller then we can adjust the block to that size and insert
the other part into the freelist }
{ create the left over freelist block, if at least 16 bytes are free }
split_block(pcurr, size);
SysTryResizeMem := true;
end;
inc(internal_status.currheapused,size-oldsize); inc(internal_status.currheapused,size-oldsize);
SysTryResizeMem := true;
{$ifdef TestFreeLists} {$ifdef TestFreeLists}
if test_each then if test_each then
TestFreeLists; TestFreeLists;
@ -1352,7 +1382,11 @@ end;
{ {
$Log$ $Log$
Revision 1.50 2005-03-25 22:53:39 jonas Revision 1.51 2005-04-04 15:40:30 peter
* check if there is enough room before concatting blocks in
systryresizemem()
Revision 1.50 2005/03/25 22:53:39 jonas
* fixed several warnings and notes about unused variables (mainly) or * fixed several warnings and notes about unused variables (mainly) or
uninitialised use of variables/function results (a few) uninitialised use of variables/function results (a few)