paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 06:59:24 +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

33
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));
@ -1287,19 +1279,21 @@ 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);
@ -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