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

* fixed tryresizemem

Browse Source
This commit is contained in:
peter 2005-03-20 18:57:29 +00:00
parent 7cb6368f12
commit d7ae60a9e0
1 changed files with 35 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
rtl/inc/heap.inc
View File

@ -1202,25 +1202,17 @@ var
pnew, pnew,
pcurr : pmemchunk_var; pcurr : pmemchunk_var;
begin begin
{ fix needed size }
if size <= (maxblocksize - sizeof(tmemchunk_fixed_hdr)) then
begin
size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
end
else
begin
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
end;
{ 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
begin begin
currsize := pcurrsize and sizemask; currsize := pcurrsize and sizemask;
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
end end
else else
begin begin
currsize := pcurrsize and fixedsizemask; currsize := pcurrsize and fixedsizemask;
size := (size+sizeof(tmemchunk_fixed_hdr)+(blocksize-1)) and fixedsizemask;
end; end;
oldsize := currsize; oldsize := currsize;
{ is the allocated block still correct? } { is the allocated block still correct? }
@ -1235,11 +1227,11 @@ begin
end; end;
{ 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 begin
SysTryResizeMem := false; SysTryResizeMem := false;
exit; exit;
// end; 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));
@ -1247,20 +1239,20 @@ begin
{ do we need to allocate more memory ? } { do we need to allocate more memory ? }
if size>currsize then if size>currsize then
begin 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); try_concat_free_chunk_forward(pcurr);
currsize := (pcurr^.size and sizemask); currsize := (pcurr^.size and sizemask);
SysTryResizeMem := currsize>=size; SysTryResizeMem := currsize>=size;
end; end;
if currsize>size then if currsize>size then
begin begin
{ is the size smaller then we can adjust the block to that size and insert { is the size smaller then we can adjust the block to that size and insert
the other part into the freelist } the other part into the freelist }
{ create the left over freelist block, if at least 16 bytes are free } { create the left over freelist block, if at least 16 bytes are free }
split_block(pcurr, size); split_block(pcurr, size);
SysTryResizeMem := true; SysTryResizeMem := true;
end; end;
inc(internal_status.currheapused,size-oldsize); inc(internal_status.currheapused,size-oldsize);
{$ifdef TestFreeLists} {$ifdef TestFreeLists}
@ -1285,25 +1277,27 @@ begin
if p<>nil then if p<>nil then
begin begin
MemoryManager.FreeMem(p); MemoryManager.FreeMem(p);
p := nil; p := nil;
end; end;
end else end
else
{ Allocate a new block? } { Allocate a new block? }
if p=nil then if p=nil then
begin begin
p := MemoryManager.AllocMem(size); p := MemoryManager.GetMem(size);
end else end
else
{ Resize block } { Resize block }
if not SysTryResizeMem(p,size) then if not SysTryResizeMem(p,size) then
begin begin
minsize := MemoryManager.MemSize(p); minsize := MemoryManager.MemSize(p);
if size < minsize then if size < minsize then
minsize := size; minsize := size;
p2 := MemoryManager.AllocMem(size); p2 := MemoryManager.GetMem(size);
if p2<>nil then if p2<>nil then
Move(p^,p2^,minsize); Move(p^,p2^,minsize);
MemoryManager.FreeMem(p); MemoryManager.FreeMem(p);
p := p2; p := p2;
end; end;
SysReAllocMem := p; SysReAllocMem := p;
end; end;
@ -1355,7 +1349,10 @@ end;
{ {
$Log$ $Log$
Revision 1.47 2005-03-04 16:49:34 peter Revision 1.48 2005-03-20 18:57:29 peter
* fixed tryresizemem
Revision 1.47 2005/03/04 16:49:34 peter
* fix getheapstatus bootstrapping * fix getheapstatus bootstrapping
Revision 1.46 2005/03/02 14:25:19 marco Revision 1.46 2005/03/02 14:25:19 marco