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

* always keep 1 free os chunk available in the freelist to avoid

Browse Source 
a performance killing corner case where one block is constantly allocated
    and freed and can result in a redividing of an os chunk in small parts
    for each allocation

git-svn-id: trunk@1900 -
This commit is contained in:
Jonas Maebe 2005-12-07 20:01:15 +00:00
parent 7996bb3b06
commit 31b173fe85
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
rtl/inc/heap.inc
View File

@ -131,6 +131,7 @@ var
internal_status : TFPCHeapStatus;
freelists_fixed : tfreelists;
freelists_free_chunk : array[1..maxblockindex] of boolean;
freelist_var : pmemchunk_var;
freeoslist : poschunk;
freeoslistcount : dword;
@ -902,6 +903,8 @@ begin
if assigned(freelists_fixed[s]) then
freelists_fixed[s]^.prev_fixed := nil;
poc := poschunk(pointer(pcurr)-((pcurr^.size shr 16)*(pcurr^.size and fixedsizemask)+sizeof(toschunk)));
if (poc^.used = 0) then
freelists_free_chunk[s] := false;
inc(poc^.used);
{ statistics }
inc(internal_status.currheapused,size);
@ -1029,8 +1032,11 @@ begin
dec(poc^.used);
if poc^.used = 0 then
begin
// block eligable for freeing
append_to_oslist_fixed(blockindex, pcurrsize, poc);
if (freelists_free_chunk[blockindex]) then
// block eligable for freeing
append_to_oslist_fixed(blockindex, pcurrsize, poc)
else
freelists_free_chunk[blockindex] := true;
end;
SysFreeMem_Fixed := pcurrsize;
{$ifdef TestFreeLists}
@ -1311,6 +1317,7 @@ end;
procedure InitHeap;
begin
FillChar(freelists_fixed,sizeof(tfreelists),0);
FillChar(freelists_free_chunk,sizeof(freelists_free_chunk),0);
freelist_var := nil;
freeoslist := nil;
freeoslistcount := 0;