mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 19:50:17 +02:00
* optimize by removing expensive calculations
git-svn-id: trunk@1973 -
This commit is contained in:
peter
parent
ef2a0c7ddf
commit
9d817056ce
492
rtl/inc/heap.inc
492
rtl/inc/heap.inc
@ -21,29 +21,25 @@
|
||||
{ DEBUG: Dump info when the heap needs to grow }
|
||||
{ define DUMPGROW}
|
||||
|
||||
{ DEBUG: Test the FreeList on correctness }
|
||||
|
||||
{$ifdef SYSTEMDEBUG}
|
||||
{$define TestFreeLists}
|
||||
{$endif SYSTEMDEBUG}
|
||||
|
||||
const
|
||||
{$ifdef CPU64}
|
||||
blocksize = 32; { at least size of freerecord }
|
||||
blockshr = 5; { shr value for blocksize=2^blockshr}
|
||||
blockshift = 5; { shr value for blocksize=2^blockshift}
|
||||
maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord }
|
||||
{$else}
|
||||
blocksize = 16; { at least size of freerecord }
|
||||
blockshr = 4; { shr value for blocksize=2^blockshr}
|
||||
blockshift = 4; { shr value for blocksize=2^blockshift}
|
||||
maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord }
|
||||
{$endif}
|
||||
maxblockindex = maxblocksize div blocksize; { highest index in array of lists of memchunks }
|
||||
maxreusebigger = 8; { max reuse bigger tries }
|
||||
|
||||
usedflag = 1; { flag if the block is used or not }
|
||||
lastblockflag = 2; { flag if the block is the last in os chunk }
|
||||
firstblockflag = 4; { flag if the block is the first in os chunk }
|
||||
fixedsizeflag = 8; { flag if the block is of fixed size }
|
||||
{ common flags }
|
||||
fixedsizeflag = 1; { flag if the block is of fixed size }
|
||||
{ memchunk var flags }
|
||||
usedflag = 2; { flag if the block is used or not }
|
||||
lastblockflag = 4; { flag if the block is the last in os chunk }
|
||||
firstblockflag = 8; { flag if the block is the first in os chunk }
|
||||
sizemask = not(blocksize-1);
|
||||
fixedsizemask = sizemask and $ffff;
|
||||
|
||||
@ -81,21 +77,27 @@ const
|
||||
);
|
||||
|
||||
type
|
||||
poschunk = ^toschunk;
|
||||
toschunk = record
|
||||
size,
|
||||
used,
|
||||
chunkindex : ptrint;
|
||||
next,
|
||||
prev : poschunk;
|
||||
end;
|
||||
|
||||
pmemchunk_fixed = ^tmemchunk_fixed;
|
||||
tmemchunk_fixed = record
|
||||
{$ifdef cpusparc}
|
||||
{ Sparc needs to alloc aligned on 8 bytes, to allow doubles }
|
||||
_dummy : ptrint;
|
||||
{$endif cpusparc}
|
||||
size : ptrint;
|
||||
size : ptrint;
|
||||
poc : poschunk;
|
||||
next_fixed,
|
||||
prev_fixed : pmemchunk_fixed;
|
||||
end;
|
||||
|
||||
pmemchunk_var = ^tmemchunk_var;
|
||||
tmemchunk_var = record
|
||||
size : ptrint;
|
||||
prevsize : ptrint;
|
||||
size : ptrint;
|
||||
next_var,
|
||||
prev_var : pmemchunk_var;
|
||||
end;
|
||||
@ -103,25 +105,16 @@ type
|
||||
{ ``header'', ie. size of structure valid when chunk is in use }
|
||||
{ should correspond to tmemchunk_var_hdr structure starting with the
|
||||
last field. Reason is that the overlap is starting from the end of the
|
||||
record. }
|
||||
record.
|
||||
Alignment is 8 bytes for 32bit machines. This required
|
||||
for x86 MMX/SSE and for sparc Double values }
|
||||
tmemchunk_fixed_hdr = record
|
||||
{$ifdef cpusparc}
|
||||
{ Sparc needs to alloc aligned on 8 bytes, to allow doubles }
|
||||
_dummy : ptrint;
|
||||
{$endif cpusparc}
|
||||
size : ptrint;
|
||||
size : ptrint;
|
||||
poschunk : pointer;
|
||||
end;
|
||||
tmemchunk_var_hdr = record
|
||||
prevsize : ptrint;
|
||||
size : ptrint;
|
||||
end;
|
||||
|
||||
poschunk = ^toschunk;
|
||||
toschunk = record
|
||||
size : ptrint;
|
||||
next,
|
||||
prev : poschunk;
|
||||
used : ptrint;
|
||||
prevsize,
|
||||
size : ptrint;
|
||||
end;
|
||||
|
||||
tfreelists = array[1..maxblockindex] of pmemchunk_fixed;
|
||||
@ -136,11 +129,6 @@ var
|
||||
freeoslist : poschunk;
|
||||
freeoslistcount : dword;
|
||||
|
||||
{$ifdef TestFreeLists}
|
||||
{ this can be turned on by debugger }
|
||||
const
|
||||
test_each : boolean = false;
|
||||
{$endif TestFreeLists}
|
||||
|
||||
{*****************************************************************************
|
||||
Memory Manager
|
||||
@ -505,41 +493,12 @@ end;
|
||||
{$endif}
|
||||
|
||||
|
||||
{$ifdef TestFreeLists}
|
||||
procedure TestFreeLists;
|
||||
var
|
||||
i,j : ptrint;
|
||||
mc : pmemchunk_fixed;
|
||||
begin
|
||||
for i := 1 to maxblockindex do
|
||||
begin
|
||||
j := 0;
|
||||
mc := freelists_fixed[i];
|
||||
while assigned(mc) do
|
||||
begin
|
||||
inc(j);
|
||||
if ((mc^.size and fixedsizemask) <> i * blocksize) then
|
||||
RunError(204);
|
||||
mc := mc^.next_fixed;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif TestFreeLists}
|
||||
|
||||
{*****************************************************************************
|
||||
List adding/removal
|
||||
*****************************************************************************}
|
||||
|
||||
procedure append_to_list_fixed(blockindex: ptrint; pmc: pmemchunk_fixed);
|
||||
begin
|
||||
pmc^.prev_fixed := nil;
|
||||
pmc^.next_fixed := freelists_fixed[blockindex];
|
||||
if freelists_fixed[blockindex]<>nil then
|
||||
freelists_fixed[blockindex]^.prev_fixed := pmc;
|
||||
freelists_fixed[blockindex] := pmc;
|
||||
end;
|
||||
|
||||
procedure append_to_list_var(pmc: pmemchunk_var);
|
||||
procedure append_to_list_var(pmc: pmemchunk_var);inline;
|
||||
begin
|
||||
pmc^.prev_var := nil;
|
||||
pmc^.next_var := freelist_var;
|
||||
@ -548,17 +507,7 @@ begin
|
||||
freelist_var := pmc;
|
||||
end;
|
||||
|
||||
procedure remove_from_list_fixed(blockindex: ptrint; pmc: pmemchunk_fixed);
|
||||
begin
|
||||
if assigned(pmc^.next_fixed) then
|
||||
pmc^.next_fixed^.prev_fixed := pmc^.prev_fixed;
|
||||
if assigned(pmc^.prev_fixed) then
|
||||
pmc^.prev_fixed^.next_fixed := pmc^.next_fixed
|
||||
else
|
||||
freelists_fixed[blockindex] := pmc^.next_fixed;
|
||||
end;
|
||||
|
||||
procedure remove_from_list_var(pmc: pmemchunk_var);
|
||||
procedure remove_from_list_var(pmc: pmemchunk_var);inline;
|
||||
begin
|
||||
if assigned(pmc^.next_var) then
|
||||
pmc^.next_var^.prev_var := pmc^.prev_var;
|
||||
@ -572,8 +521,8 @@ procedure append_to_oslist(poc: poschunk);
|
||||
begin
|
||||
{ decide whether to free block or add to list }
|
||||
{$ifdef HAS_SYSOSFREE}
|
||||
if (freeoslistcount >= MaxKeptOSChunks)
|
||||
or (poc^.size > growheapsize2) then
|
||||
if (freeoslistcount >= MaxKeptOSChunks) or
|
||||
(poc^.size > growheapsize2) then
|
||||
begin
|
||||
dec(internal_status.currheapsize, poc^.size);
|
||||
SysOSFree(poc, poc^.size);
|
||||
@ -613,16 +562,25 @@ begin
|
||||
append_to_oslist(poc);
|
||||
end;
|
||||
|
||||
procedure append_to_oslist_fixed(blockindex, chunksize: ptrint; poc: poschunk);
|
||||
procedure append_to_oslist_fixed(poc: poschunk);
|
||||
var
|
||||
pmc: pmemchunk_fixed;
|
||||
chunksize,
|
||||
chunkindex,
|
||||
i, count: ptrint;
|
||||
begin
|
||||
count := (poc^.size - sizeof(toschunk)) div chunksize;
|
||||
chunkindex:=poc^.chunkindex;
|
||||
chunksize:=chunkindex shl blockshift;
|
||||
pmc := pmemchunk_fixed(pointer(poc)+sizeof(toschunk));
|
||||
count := (poc^.size - sizeof(toschunk)) div chunksize;
|
||||
for i := 0 to count - 1 do
|
||||
begin
|
||||
remove_from_list_fixed(blockindex, pmc);
|
||||
if assigned(pmc^.next_fixed) then
|
||||
pmc^.next_fixed^.prev_fixed := pmc^.prev_fixed;
|
||||
if assigned(pmc^.prev_fixed) then
|
||||
pmc^.prev_fixed^.next_fixed := pmc^.next_fixed
|
||||
else
|
||||
freelists_fixed[chunkindex] := pmc^.next_fixed;
|
||||
pmc := pointer(pmc)+chunksize;
|
||||
end;
|
||||
append_to_oslist(poc);
|
||||
@ -655,6 +613,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Try concat freerecords
|
||||
*****************************************************************************}
|
||||
@ -751,35 +710,40 @@ end;
|
||||
Grow Heap
|
||||
*****************************************************************************}
|
||||
|
||||
function alloc_oschunk(blockindex, size: ptrint): pointer;
|
||||
function alloc_oschunk(chunkindex, size: ptrint):pointer;
|
||||
var
|
||||
pmcfirst,
|
||||
pmclast,
|
||||
pmc : pmemchunk_fixed;
|
||||
pmcv : pmemchunk_var;
|
||||
poc : poschunk;
|
||||
chunksize,
|
||||
minsize,
|
||||
maxsize,
|
||||
i, count : ptrint;
|
||||
chunksize : ptrint;
|
||||
begin
|
||||
result:=nil;
|
||||
chunksize:=chunkindex shl blockshift;
|
||||
{ increase size by size needed for os block header }
|
||||
minsize := size + sizeof(toschunk);
|
||||
if blockindex<>0 then
|
||||
maxsize := (size * $ffff) + sizeof(toschunk)
|
||||
if chunkindex<>0 then
|
||||
maxsize := (chunksize * $ffff) + sizeof(toschunk)
|
||||
else
|
||||
maxsize := high(ptrint);
|
||||
{ blocks available in freelist? }
|
||||
result := freeoslist;
|
||||
while result <> nil do
|
||||
poc := freeoslist;
|
||||
while poc <> nil do
|
||||
begin
|
||||
if (poschunk(result)^.size >= minsize) and
|
||||
(poschunk(result)^.size <= maxsize) then
|
||||
if (poc^.size >= minsize) and
|
||||
(poc^.size <= maxsize) then
|
||||
begin
|
||||
size := poschunk(result)^.size;
|
||||
remove_from_oslist(poschunk(result));
|
||||
size := poc^.size;
|
||||
remove_from_oslist(poc);
|
||||
break;
|
||||
end;
|
||||
result := poschunk(result)^.next;
|
||||
poc := poc^.next;
|
||||
end;
|
||||
if result = nil then
|
||||
if poc = nil then
|
||||
begin
|
||||
{$ifdef DUMPGROW}
|
||||
writeln('growheap(',size,') allocating ',(size+sizeof(toschunk)+$ffff) and $ffff0000);
|
||||
@ -788,135 +752,131 @@ begin
|
||||
{ allocate by 64K size }
|
||||
size := (size+sizeof(toschunk)+$ffff) and not $ffff;
|
||||
{ allocate smaller blocks for fixed-size chunks }
|
||||
if blockindex<>0 then
|
||||
if chunksize<>0 then
|
||||
begin
|
||||
result := SysOSAlloc(GrowHeapSizeSmall);
|
||||
if result<>nil then
|
||||
poc := SysOSAlloc(GrowHeapSizeSmall);
|
||||
if poc<>nil then
|
||||
size := GrowHeapSizeSmall;
|
||||
end
|
||||
{ first try 256K (default) }
|
||||
else if size<=GrowHeapSize1 then
|
||||
begin
|
||||
result := SysOSAlloc(GrowHeapSize1);
|
||||
if result<>nil then
|
||||
size := GrowHeapSize1;
|
||||
end
|
||||
{ second try 1024K (default) }
|
||||
else if size<=GrowHeapSize2 then
|
||||
begin
|
||||
result := SysOSAlloc(GrowHeapSize2);
|
||||
if result<>nil then
|
||||
size := GrowHeapSize2;
|
||||
end
|
||||
{ else allocate the needed bytes }
|
||||
else
|
||||
result := SysOSAlloc(size);
|
||||
{ try again }
|
||||
if result=nil then
|
||||
begin
|
||||
result := SysOSAlloc(size);
|
||||
if (result=nil) then
|
||||
{ first try 256K (default) }
|
||||
else if size<=GrowHeapSize1 then
|
||||
begin
|
||||
if ReturnNilIfGrowHeapFails then
|
||||
exit
|
||||
else
|
||||
HandleError(203);
|
||||
poc := SysOSAlloc(GrowHeapSize1);
|
||||
if poc<>nil then
|
||||
size := GrowHeapSize1;
|
||||
end
|
||||
{ second try 1024K (default) }
|
||||
else if size<=GrowHeapSize2 then
|
||||
begin
|
||||
poc := SysOSAlloc(GrowHeapSize2);
|
||||
if poc<>nil then
|
||||
size := GrowHeapSize2;
|
||||
end
|
||||
{ else allocate the needed bytes }
|
||||
else
|
||||
poc := SysOSAlloc(size);
|
||||
{ try again }
|
||||
if poc=nil then
|
||||
begin
|
||||
poc := SysOSAlloc(size);
|
||||
if (poc=nil) then
|
||||
begin
|
||||
if ReturnNilIfGrowHeapFails then
|
||||
exit
|
||||
else
|
||||
HandleError(203);
|
||||
end;
|
||||
end;
|
||||
{ set the total new heap size }
|
||||
inc(internal_status.currheapsize,size);
|
||||
if internal_status.currheapsize>internal_status.maxheapsize then
|
||||
internal_status.maxheapsize:=internal_status.currheapsize;
|
||||
end;
|
||||
{ set the total new heap size }
|
||||
inc(internal_status.currheapsize,size);
|
||||
if internal_status.currheapsize>internal_status.maxheapsize then
|
||||
internal_status.maxheapsize:=internal_status.currheapsize;
|
||||
end;
|
||||
{ initialize os-block }
|
||||
poschunk(result)^.used := 0;
|
||||
poschunk(result)^.size := size;
|
||||
inc(result, sizeof(toschunk));
|
||||
if blockindex<>0 then
|
||||
poc^.used := 0;
|
||||
poc^.size := size;
|
||||
poc^.chunkindex := chunkindex;
|
||||
{ initialized oschunck for fixed chunks }
|
||||
if chunkindex<>0 then
|
||||
begin
|
||||
{ chop os chunk in fixedsize parts,
|
||||
maximum of $ffff elements are allowed, otherwise
|
||||
there will be an overflow }
|
||||
chunksize := blockindex shl blockshr;
|
||||
count := (size-sizeof(toschunk)) div chunksize;
|
||||
if count>$ffff then
|
||||
HandleError(204);
|
||||
pmc := pmemchunk_fixed(result);
|
||||
pmc^.prev_fixed := nil;
|
||||
i := 0;
|
||||
repeat
|
||||
pmc^.size := fixedsizeflag or chunksize or (i shl 16);
|
||||
pmc^.next_fixed := pointer(pmc)+chunksize;
|
||||
inc(i);
|
||||
if i < count then
|
||||
begin
|
||||
pmc := pmemchunk_fixed(pointer(pmc)+chunksize);
|
||||
pmc^.prev_fixed := pointer(pmc)-chunksize;
|
||||
end
|
||||
else
|
||||
begin
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
append_to_list_fixed(blockindex, pmc);
|
||||
pmc^.prev_fixed := pointer(pmc)-chunksize;
|
||||
freelists_fixed[blockindex] := pmemchunk_fixed(result);
|
||||
{ Initialize linkedlist of chunks, the first chunk
|
||||
is pmemchunk_fixed(poc) and the last chunk will be in pmc at
|
||||
the end of the loop }
|
||||
pmcfirst := pmemchunk_fixed(pointer(poc)+sizeof(toschunk));
|
||||
pmc:=pmcfirst;
|
||||
for i:=1 to count do
|
||||
begin
|
||||
pmc^.poc:=poc;
|
||||
pmc^.size:=chunksize or fixedsizeflag;
|
||||
pmc^.prev_fixed := pointer(pmc)-chunksize;
|
||||
pmc^.next_fixed := pointer(pmc)+chunksize;
|
||||
pmc := pmemchunk_fixed(pointer(pmc)+chunksize);
|
||||
end;
|
||||
{ undo last increase to get last chunk }
|
||||
pmclast := pmemchunk_fixed(pointer(pmc)-chunksize);
|
||||
{ Add to freelist and fixup first and last chunk }
|
||||
pmclast^.next_fixed := freelists_fixed[chunkindex];
|
||||
if freelists_fixed[chunkindex]<>nil then
|
||||
freelists_fixed[chunkindex]^.prev_fixed := pmclast;
|
||||
freelists_fixed[chunkindex] := pmcfirst;
|
||||
pmemchunk_fixed(poc)^.prev_fixed:=nil;
|
||||
result:=pmcfirst;
|
||||
end
|
||||
else
|
||||
begin
|
||||
pmcv := pmemchunk_var(result);
|
||||
pmcv := pmemchunk_var(pointer(poc)+sizeof(toschunk));
|
||||
append_to_list_var(pmcv);
|
||||
pmcv^.size := ((size-sizeof(toschunk)) and sizemask) or (firstblockflag or lastblockflag);
|
||||
pmcv^.prevsize := 0;
|
||||
result:=pmcv;
|
||||
end;
|
||||
{$ifdef TestFreeLists}
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SysGetMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysGetMem_Fixed(size: ptrint): pointer;
|
||||
var
|
||||
pcurr: pmemchunk_fixed;
|
||||
poc: poschunk;
|
||||
s: ptrint;
|
||||
pmc : pmemchunk_fixed;
|
||||
poc : poschunk;
|
||||
chunkindex : ptrint;
|
||||
begin
|
||||
result:=nil;
|
||||
{ try to find a block in one of the freelists per size }
|
||||
s := size shr blockshr;
|
||||
pcurr := freelists_fixed[s];
|
||||
chunkindex := size shr blockshift;
|
||||
pmc := freelists_fixed[chunkindex];
|
||||
{ no free blocks ? }
|
||||
if not assigned(pcurr) then
|
||||
if not assigned(pmc) then
|
||||
begin
|
||||
pcurr := alloc_oschunk(s, size);
|
||||
if not assigned(pcurr) then
|
||||
pmc:=alloc_oschunk(chunkindex, size);
|
||||
if not assigned(pmc) then
|
||||
exit;
|
||||
end;
|
||||
{ get a pointer to the block we should return }
|
||||
result := pointer(pcurr)+sizeof(tmemchunk_fixed_hdr);
|
||||
{ flag as in-use }
|
||||
pcurr^.size := pcurr^.size or usedflag;
|
||||
result := pointer(pmc)+sizeof(tmemchunk_fixed_hdr);
|
||||
{ update freelist }
|
||||
freelists_fixed[s] := pcurr^.next_fixed;
|
||||
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)));
|
||||
freelists_fixed[chunkindex] := pmc^.next_fixed;
|
||||
if assigned(freelists_fixed[chunkindex]) then
|
||||
freelists_fixed[chunkindex]^.prev_fixed := nil;
|
||||
poc := pmc^.poc;
|
||||
if (poc^.used = 0) then
|
||||
freelists_free_chunk[s] := false;
|
||||
freelists_free_chunk[chunkindex] := false;
|
||||
inc(poc^.used);
|
||||
{ statistics }
|
||||
inc(internal_status.currheapused,size);
|
||||
if internal_status.currheapused>internal_status.maxheapused then
|
||||
internal_status.maxheapused:=internal_status.currheapused;
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
end;
|
||||
|
||||
|
||||
function SysGetMem_Var(size: ptrint): pointer;
|
||||
var
|
||||
pcurr : pmemchunk_var;
|
||||
@ -976,10 +936,6 @@ begin
|
||||
inc(internal_status.currheapused,size);
|
||||
if internal_status.currheapused>internal_status.maxheapused then
|
||||
internal_status.maxheapused:=internal_status.currheapused;
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
end;
|
||||
|
||||
function SysGetMem(size : ptrint):pointer;
|
||||
@ -998,12 +954,12 @@ begin
|
||||
if size <= (maxblocksize - sizeof(tmemchunk_fixed_hdr)) then
|
||||
begin
|
||||
size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
|
||||
sysgetmem := sysgetmem_fixed(size);
|
||||
result := sysgetmem_fixed(size);
|
||||
end
|
||||
else
|
||||
begin
|
||||
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
|
||||
sysgetmem := sysgetmem_var(size);
|
||||
result := sysgetmem_var(size);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1012,83 +968,70 @@ end;
|
||||
SysFreeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysFreeMem_Fixed(pcurr: pmemchunk_fixed; size: ptrint): ptrint;
|
||||
function SysFreeMem_Fixed(pmc: pmemchunk_fixed): ptrint;
|
||||
var
|
||||
pcurrsize: ptrint;
|
||||
blockindex: ptrint;
|
||||
poc: poschunk;
|
||||
chunksize,
|
||||
chunkindex : ptrint;
|
||||
poc : poschunk;
|
||||
begin
|
||||
pcurrsize := pcurr^.size and fixedsizemask;
|
||||
if size<>pcurrsize then
|
||||
HandleError(204);
|
||||
dec(internal_status.currheapused,pcurrsize);
|
||||
poc := pmc^.poc;
|
||||
chunkindex:=poc^.chunkindex;
|
||||
chunksize:=chunkindex shl blockshift;
|
||||
{ statistics }
|
||||
dec(internal_status.currheapused,chunksize);
|
||||
{ insert the block in it's freelist }
|
||||
pcurr^.size := pcurr^.size and (not usedflag);
|
||||
blockindex := pcurrsize shr blockshr;
|
||||
append_to_list_fixed(blockindex, pcurr);
|
||||
pmc^.prev_fixed := nil;
|
||||
pmc^.next_fixed := freelists_fixed[chunkindex];
|
||||
if freelists_fixed[chunkindex]<>nil then
|
||||
freelists_fixed[chunkindex]^.prev_fixed := pmc;
|
||||
freelists_fixed[chunkindex] := pmc;
|
||||
{ decrease used blocks count }
|
||||
poc := poschunk(pointer(pcurr)-(pcurr^.size shr 16)*pcurrsize-sizeof(toschunk));
|
||||
if poc^.used = 0 then
|
||||
HandleError(204);
|
||||
dec(poc^.used);
|
||||
if poc^.used = 0 then
|
||||
begin
|
||||
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}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
begin
|
||||
{ osblock can be freed? }
|
||||
if freelists_free_chunk[chunkindex] then
|
||||
append_to_oslist_fixed(poc)
|
||||
else
|
||||
freelists_free_chunk[chunkindex] := true;
|
||||
end;
|
||||
result := chunksize;
|
||||
end;
|
||||
|
||||
function SysFreeMem_Var(pcurr: pmemchunk_var; size: ptrint): ptrint;
|
||||
|
||||
function SysFreeMem_Var(pcurr: pmemchunk_var): ptrint;
|
||||
var
|
||||
pcurrsize: ptrint;
|
||||
chunksize: ptrint;
|
||||
begin
|
||||
pcurrsize := pcurr^.size and sizemask;
|
||||
if size<>pcurrsize then
|
||||
HandleError(204);
|
||||
dec(internal_status.currheapused,pcurrsize);
|
||||
chunksize := pcurr^.size and sizemask;
|
||||
dec(internal_status.currheapused,chunksize);
|
||||
{ insert the block in it's freelist }
|
||||
pcurr^.size := pcurr^.size and (not usedflag);
|
||||
append_to_list_var(pcurr);
|
||||
SysFreeMem_Var := pcurrsize;
|
||||
result := chunksize;
|
||||
pcurr := try_concat_free_chunk(pcurr);
|
||||
if (pcurr^.size and (firstblockflag or lastblockflag)) = (firstblockflag or lastblockflag) then
|
||||
begin
|
||||
append_to_oslist_var(pcurr);
|
||||
end;
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
end;
|
||||
|
||||
|
||||
function SysFreeMem(p: pointer): ptrint;
|
||||
var
|
||||
pcurrsize: ptrint;
|
||||
size : ptrint;
|
||||
begin
|
||||
if p=nil then
|
||||
begin
|
||||
result:=0;
|
||||
exit;
|
||||
end;
|
||||
pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
size := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
{ check if this is a fixed- or var-sized chunk }
|
||||
if (pcurrsize and fixedsizeflag) = 0 then
|
||||
begin
|
||||
result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)), pcurrsize and sizemask);
|
||||
end
|
||||
if (size and fixedsizeflag) = 0 then
|
||||
result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)))
|
||||
else
|
||||
begin
|
||||
result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)), pcurrsize and fixedsizemask);
|
||||
end;
|
||||
result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)));
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -1097,7 +1040,7 @@ end;
|
||||
|
||||
Function SysFreeMemSize(p: pointer; size: ptrint):ptrint;
|
||||
var
|
||||
pcurrsize: ptrint;
|
||||
chunksize: ptrint;
|
||||
begin
|
||||
SysFreeMemSize := 0;
|
||||
if p=nil then
|
||||
@ -1109,18 +1052,14 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
{ check if this is a fixed- or var-sized chunk }
|
||||
if (pcurrsize and fixedsizeflag) = 0 then
|
||||
begin
|
||||
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
|
||||
result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)), size);
|
||||
end
|
||||
chunksize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
{ check if this is a fixed- or var-sized chunk. We can't check the passed
|
||||
size parameter since the block can be resized (by reallocmem) to an
|
||||
optimized value that the user doesn't know }
|
||||
if (chunksize and fixedsizeflag) = 0 then
|
||||
result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr)))
|
||||
else
|
||||
begin
|
||||
size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
|
||||
result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)), size);
|
||||
end;
|
||||
result := sysfreemem_fixed(pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)));
|
||||
end;
|
||||
|
||||
|
||||
@ -1130,16 +1069,16 @@ end;
|
||||
|
||||
function SysMemSize(p: pointer): ptrint;
|
||||
begin
|
||||
SysMemSize := pmemchunk_fixed(pointer(p)-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
if (SysMemSize and fixedsizeflag) = 0 then
|
||||
result := pmemchunk_fixed(pointer(p)-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
if (result and fixedsizeflag) = 0 then
|
||||
begin
|
||||
SysMemSize := SysMemSize and sizemask;
|
||||
dec(SysMemSize, sizeof(tmemchunk_var_hdr));
|
||||
result := SysMemSize and sizemask;
|
||||
dec(result, sizeof(tmemchunk_var_hdr));
|
||||
end
|
||||
else
|
||||
begin
|
||||
SysMemSize := SysMemSize and fixedsizemask;
|
||||
dec(SysMemSize, sizeof(tmemchunk_fixed_hdr));
|
||||
result := SysMemSize and fixedsizemask;
|
||||
dec(result, sizeof(tmemchunk_fixed_hdr));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1150,9 +1089,9 @@ end;
|
||||
|
||||
function SysAllocMem(size: ptrint): pointer;
|
||||
begin
|
||||
sysallocmem := MemoryManager.GetMem(size);
|
||||
if sysallocmem<>nil then
|
||||
FillChar(sysallocmem^,MemoryManager.MemSize(sysallocmem),0);
|
||||
result := MemoryManager.GetMem(size);
|
||||
if result<>nil then
|
||||
FillChar(result^,MemoryManager.MemSize(result),0);
|
||||
end;
|
||||
|
||||
|
||||
@ -1162,7 +1101,7 @@ end;
|
||||
|
||||
function SysTryResizeMem(var p: pointer; size: ptrint): boolean;
|
||||
var
|
||||
pcurrsize,
|
||||
chunksize,
|
||||
oldsize,
|
||||
currsize : ptrint;
|
||||
pcurr : pmemchunk_var;
|
||||
@ -1170,13 +1109,13 @@ begin
|
||||
SysTryResizeMem := false;
|
||||
|
||||
{ fix p to point to the heaprecord }
|
||||
pcurrsize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
chunksize := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
|
||||
{ handle fixed memchuncks separate. Only allow resizes when the
|
||||
new size fits in the same block }
|
||||
if (pcurrsize and fixedsizeflag) <> 0 then
|
||||
if (chunksize and fixedsizeflag) <> 0 then
|
||||
begin
|
||||
currsize := pcurrsize and fixedsizemask;
|
||||
currsize := chunksize and fixedsizemask;
|
||||
|
||||
{ first check if the size fits in the fixed block range to prevent
|
||||
"truncating" the size by the fixedsizemask }
|
||||
@ -1186,24 +1125,19 @@ begin
|
||||
systryresizemem:=true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ we need to allocate a new fixed or var memchunck }
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ var memchunck }
|
||||
currsize := pcurrsize and sizemask;
|
||||
currsize := chunksize and sizemask;
|
||||
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
|
||||
|
||||
{ is the allocated block still correct? }
|
||||
if (currsize>=size) and (size>(currsize-blocksize)) then
|
||||
begin
|
||||
SysTryResizeMem := true;
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
exit;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ get pointer to block }
|
||||
@ -1231,11 +1165,6 @@ begin
|
||||
|
||||
inc(internal_status.currheapused,size-oldsize);
|
||||
SysTryResizeMem := true;
|
||||
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
{$endif TestFreeLists}
|
||||
end;
|
||||
|
||||
|
||||
@ -1245,6 +1174,8 @@ end;
|
||||
|
||||
function SysReAllocMem(var p: pointer; size: ptrint):pointer;
|
||||
var
|
||||
newsize,
|
||||
oldsize,
|
||||
minsize : ptrint;
|
||||
p2 : pointer;
|
||||
begin
|
||||
@ -1267,10 +1198,23 @@ begin
|
||||
{ Resize block }
|
||||
if not SysTryResizeMem(p,size) then
|
||||
begin
|
||||
minsize := MemoryManager.MemSize(p);
|
||||
if size < minsize then
|
||||
minsize := size;
|
||||
p2 := MemoryManager.GetMem(size);
|
||||
oldsize:=MemoryManager.MemSize(p);
|
||||
{ Grow with bigger steps to prevent the need for
|
||||
multiple getmem/freemem calls for fixed blocks. It might cost a bit
|
||||
of extra memory, but in most cases a reallocmem is done multiple times. }
|
||||
if oldsize<maxblocksize then
|
||||
begin
|
||||
newsize:=oldsize*2+blocksize;
|
||||
if size>newsize then
|
||||
newsize:=size;
|
||||
end
|
||||
else
|
||||
newsize:=size;
|
||||
{ calc size of data to move }
|
||||
minsize:=oldsize;
|
||||
if newsize < minsize then
|
||||
minsize := newsize;
|
||||
p2 := MemoryManager.GetMem(newsize);
|
||||
if p2<>nil then
|
||||
Move(p^,p2^,minsize);
|
||||
MemoryManager.FreeMem(p);
|
||||
@ -1324,5 +1268,3 @@ begin
|
||||
freeoslistcount := 0;
|
||||
fillchar(internal_status,sizeof(internal_status),0);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user