mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-20 16:26:40 +02:00
* reallocmem fixed for freemem() call when size=0
This commit is contained in:
peter
parent
b8647dbc1a
commit
ba0b8a2e1b
@ -531,38 +531,21 @@ end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SysReAllocMem
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
function internSysReAllocMem(var p:pointer;size : longint; var doMove: boolean):pointer;
|
||||
{ On entry, doMove determines if a new block has to be allocated, whether this is }
|
||||
{ done and the data is moved from the old to the new block }
|
||||
{ If doMove was false on entry, it is set to true on exit if a move has to be done }
|
||||
{ which then has to be carried out by the caller, otherwise it remains false }
|
||||
{ This functionality is required if you install you own heap manager (e.g. heaptrc) }
|
||||
|
||||
function SysTryResizeMem(var p:pointer;size : longint):boolean;
|
||||
var
|
||||
orgsize,
|
||||
currsize,
|
||||
foundsize,
|
||||
sizeleft,
|
||||
s : longint;
|
||||
wasbeforeheapend, canDoMove : boolean;
|
||||
p2 : pointer;
|
||||
wasbeforeheapend : boolean;
|
||||
hp,
|
||||
pnew,
|
||||
pcurr : pfreerecord;
|
||||
begin
|
||||
canDoMove := doMove;
|
||||
{ assume no move is necessary }
|
||||
doMove := false;
|
||||
{ Allocate a new block? }
|
||||
if p=nil then
|
||||
begin
|
||||
p:=MemoryManager.GetMem(size);
|
||||
internSysReallocmem:=P;
|
||||
exit;
|
||||
end;
|
||||
{ fix needed size }
|
||||
orgsize:=size;
|
||||
size:=(size+sizeof(theaprecord)+(blocksize-1)) and (not (blocksize-1));
|
||||
{ fix p to point to the heaprecord }
|
||||
pcurr:=pfreerecord(pointer(p)-sizeof(theaprecord));
|
||||
@ -571,7 +554,7 @@ begin
|
||||
{ is the allocated block still correct? }
|
||||
if currsize=size then
|
||||
begin
|
||||
internSysReAllocMem:=p;
|
||||
SysTryResizeMem:=true;
|
||||
exit;
|
||||
end;
|
||||
{ do we need to allocate more memory ? }
|
||||
@ -639,17 +622,7 @@ begin
|
||||
else
|
||||
begin
|
||||
{ we need to call getmem/move/freemem }
|
||||
If canDoMove then
|
||||
begin
|
||||
p2:= MemoryManager.GetMem(orgsize);
|
||||
if p2<>nil then
|
||||
Move(p^,p2^,orgsize);
|
||||
MemoryManager.FreeMem(p);
|
||||
p:=p2;
|
||||
end
|
||||
else
|
||||
doMove := true;
|
||||
internSysReAllocMem:=p;
|
||||
SysTryResizeMem:=false;
|
||||
exit;
|
||||
end;
|
||||
currsize:=pcurr^.size and sizemask;
|
||||
@ -682,15 +655,43 @@ begin
|
||||
pcurr^.size:=size or usedmask or (pcurr^.size and beforeheapendmask);
|
||||
end;
|
||||
end;
|
||||
internSysReAllocMem:=p;
|
||||
SysTryResizeMem:=true;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysReAllocMem(var p:pointer;size : longint):pointer;
|
||||
var
|
||||
doMove: boolean;
|
||||
p2 : pointer;
|
||||
begin
|
||||
doMove:=true;
|
||||
SysReAllocMem := internSysReallocMem(p,size,doMove);
|
||||
{ Free block? }
|
||||
if size=0 then
|
||||
begin
|
||||
if p<>nil then
|
||||
MemoryManager.FreeMem(p);
|
||||
SysReallocmem:=P;
|
||||
exit;
|
||||
end;
|
||||
{ Allocate a new block? }
|
||||
if p=nil then
|
||||
begin
|
||||
p:=MemoryManager.GetMem(size);
|
||||
SysReallocmem:=P;
|
||||
exit;
|
||||
end;
|
||||
{ Resize block }
|
||||
if not SysTryResizeMem(p,size) then
|
||||
begin
|
||||
p2:= MemoryManager.GetMem(size);
|
||||
if p2<>nil then
|
||||
Move(p^,p2^,size);
|
||||
MemoryManager.FreeMem(p);
|
||||
p:=p2;
|
||||
end;
|
||||
SysReAllocMem := p;
|
||||
end;
|
||||
|
||||
|
||||
@ -803,7 +804,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2000-01-24 23:56:10 peter
|
||||
Revision 1.32 2000-01-31 23:41:30 peter
|
||||
* reallocmem fixed for freemem() call when size=0
|
||||
|
||||
Revision 1.31 2000/01/24 23:56:10 peter
|
||||
* fixed reallocmem which didn't work anymore and thus broke a lot
|
||||
of objfpc/delphi code
|
||||
|
||||
|
||||
@ -45,9 +45,7 @@ Function SysFreemem(var p:pointer):Longint;
|
||||
Function SysFreememSize(var p:pointer;Size:Longint):Longint;
|
||||
Function SysMemSize(p:pointer):Longint;
|
||||
Function SysAllocMem(size:longint):Pointer;
|
||||
{ the next one is for internal use by heap managers only, don't call directly }
|
||||
{ from programs! (JM) }
|
||||
Function InternSysReAllocMem(var p:pointer;size : longint; var doMove: boolean):pointer;
|
||||
function SysTryResizeMem(var p:pointer;size : longint):boolean;
|
||||
Function SysReAllocMem(var p:pointer;size:longint):Pointer;
|
||||
Function Sysmemavail:Longint;
|
||||
Function Sysmaxavail:Longint;
|
||||
@ -79,7 +77,10 @@ Procedure release(var p : pointer);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2000-01-20 12:35:35 jonas
|
||||
Revision 1.16 2000-01-31 23:41:30 peter
|
||||
* reallocmem fixed for freemem() call when size=0
|
||||
|
||||
Revision 1.15 2000/01/20 12:35:35 jonas
|
||||
* fixed problem with reallocmem and heaptrc
|
||||
|
||||
Revision 1.14 2000/01/07 16:41:34 daniel
|
||||
|
||||
@ -763,15 +763,24 @@ var
|
||||
i,bp : longint;
|
||||
pl : plongint;
|
||||
pp : pheap_mem_info;
|
||||
mustMove: boolean;
|
||||
begin
|
||||
if not assigned(p) then
|
||||
{ Free block? }
|
||||
if size=0 then
|
||||
begin
|
||||
if p<>nil then
|
||||
TraceFreeMem(p);
|
||||
TraceReallocMem:=P;
|
||||
exit;
|
||||
end;
|
||||
{ Allocate a new block? }
|
||||
if p=nil then
|
||||
begin
|
||||
p:=TraceGetMem(size);
|
||||
TraceReallocMem:=P;
|
||||
exit;
|
||||
end;
|
||||
dec(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
{ Resize block }
|
||||
dec(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
{ remove heap_mem_info from linked list }
|
||||
pp:=pheap_mem_info(p);
|
||||
if pp^.next<>nil then
|
||||
@ -780,33 +789,31 @@ begin
|
||||
pp^.previous^.next:=pp^.next;
|
||||
if pp=heap_mem_root then
|
||||
heap_mem_root:=heap_mem_root^.previous;
|
||||
{ Do the real ReAllocMem, but alloc also for the info block }
|
||||
{ Do the real ReAllocMem, but alloc also for the info block }
|
||||
bp:=size+sizeof(theap_mem_info)+extra_info_size;
|
||||
if add_tail then
|
||||
inc(bp,sizeof(longint));
|
||||
{ the internal ReAllocMem is not allowed to move any data }
|
||||
mustMove := false;
|
||||
p:=internSysReAllocMem(p,bp,mustMove);
|
||||
{ a new block is needed? }
|
||||
if mustMove then
|
||||
begin
|
||||
{ restore p }
|
||||
inc(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
{ get a new block }
|
||||
newP := TraceGetMem(size);
|
||||
{ move the data }
|
||||
if newP <> nil then
|
||||
move(p^,newP^,pp^.size);
|
||||
{ release p }
|
||||
traceFreeMem(p);
|
||||
p := newP;
|
||||
traceReAllocMem := p;
|
||||
exit;
|
||||
end;
|
||||
if not SysTryResizeMem(p,size) then
|
||||
begin
|
||||
{ restore p }
|
||||
inc(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
{ get a new block }
|
||||
newP := TraceGetMem(size);
|
||||
{ move the data }
|
||||
if newP <> nil then
|
||||
move(p^,newP^,pp^.size);
|
||||
{ release p }
|
||||
traceFreeMem(p);
|
||||
p := newP;
|
||||
traceReAllocMem := p;
|
||||
exit;
|
||||
end;
|
||||
{ adjust getmem/freemem sizes }
|
||||
if pp^.size > size then
|
||||
inc(freemem_size,pp^.size-size)
|
||||
else inc(getmem_size,size-pp^.size);
|
||||
else
|
||||
inc(getmem_size,size-pp^.size);
|
||||
{ Create the info block }
|
||||
pheap_mem_info(p)^.sig:=$DEADBEEF;
|
||||
pheap_mem_info(p)^.size:=size;
|
||||
@ -968,7 +975,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 2000-01-20 14:25:51 jonas
|
||||
Revision 1.37 2000-01-31 23:41:30 peter
|
||||
* reallocmem fixed for freemem() call when size=0
|
||||
|
||||
Revision 1.36 2000/01/20 14:25:51 jonas
|
||||
* finally fixed tracereallocmem completely
|
||||
|
||||
Revision 1.35 2000/01/20 13:17:11 jonas
|
||||
|
||||
Loading…
Reference in New Issue
Block a user