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

* finally fixed tracereallocmem completely

Browse Source
This commit is contained in:
Jonas Maebe 2000-01-20 14:25:51 +00:00
parent adcc8f25b7
commit 8095e34fae
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/inc/heaptrc.pp
View File

@ -767,13 +767,12 @@ var
begin begin
if not assigned(p) then if not assigned(p) then
begin begin
{ only when a new block has to be allocated, the getmem_cnt increases! }
inc(getmem_cnt);
p:=TraceGetMem(size); p:=TraceGetMem(size);
TraceReallocMem:=P; TraceReallocMem:=P;
exit; exit;
end; end;
dec(p,sizeof(theap_mem_info)+extra_info_size); dec(p,sizeof(theap_mem_info)+extra_info_size);
{ remove heap_mem_info from linked list }
pp:=pheap_mem_info(p); pp:=pheap_mem_info(p);
if pp^.next<>nil then if pp^.next<>nil then
pp^.next^.previous:=pp^.previous; pp^.next^.previous:=pp^.previous;
@ -804,7 +803,10 @@ begin
traceReAllocMem := p; traceReAllocMem := p;
exit; exit;
end; end;
{ remove heap_mem_info from linked list } { adjust getmem/freemem sizes }
if pp^.size > size then
inc(freemem_size,pp^.size-size)
else inc(getmem_size,size-pp^.size);
{ Create the info block } { Create the info block }
pheap_mem_info(p)^.sig:=$DEADBEEF; pheap_mem_info(p)^.sig:=$DEADBEEF;
pheap_mem_info(p)^.size:=size; pheap_mem_info(p)^.size:=size;
@ -966,7 +968,10 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.35 2000-01-20 13:17:11 jonas Revision 1.36 2000-01-20 14:25:51 jonas
* finally fixed tracereallocmem completely
Revision 1.35 2000/01/20 13:17:11 jonas
* another problme with realloc fixed (one left) * another problme with realloc fixed (one left)
Revision 1.34 2000/01/20 12:35:35 jonas Revision 1.34 2000/01/20 12:35:35 jonas