mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-18 18:31:41 +02:00
* several extra_size_info fixes
This commit is contained in:
pierre
parent
ec77ff77ee
commit
bd7d22c00f
@ -78,6 +78,8 @@ const
|
||||
{ function to fill this info up }
|
||||
fill_extra_info : FillExtraInfoType = nil;
|
||||
error_in_heap : boolean = false;
|
||||
inside_trace_getmem : boolean = false;
|
||||
|
||||
type
|
||||
pheap_mem_info = ^theap_mem_info;
|
||||
{ warning the size of theap_mem_info
|
||||
@ -93,7 +95,7 @@ type
|
||||
sig : longint;
|
||||
{$ifdef EXTRA}
|
||||
release_sig : longint;
|
||||
next_valid : pheap_mem_info;
|
||||
prev_valid : pheap_mem_info;
|
||||
{$endif EXTRA}
|
||||
calls : array [1..tracesize] of longint;
|
||||
extra_info : record
|
||||
@ -299,7 +301,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function is_in_getmem_list (p : pointer) : boolean;
|
||||
function is_in_getmem_list (p : pheap_mem_info) : boolean;
|
||||
var
|
||||
i : longint;
|
||||
pp : pheap_mem_info;
|
||||
@ -363,27 +365,32 @@ begin
|
||||
pheap_mem_info(p)^.previous:=heap_mem_root;
|
||||
pheap_mem_info(p)^.next:=nil;
|
||||
{$ifdef EXTRA}
|
||||
pheap_mem_info(p)^.next_valid:=nil;
|
||||
if assigned(heap_valid_last) then
|
||||
heap_valid_last^.next_valid:=pheap_mem_info(p);
|
||||
pheap_mem_info(p)^.prev_valid:=heap_valid_last;
|
||||
heap_valid_last:=pheap_mem_info(p);
|
||||
if not assigned(heap_valid_first) then
|
||||
heap_valid_first:=pheap_mem_info(p);
|
||||
{$endif EXTRA}
|
||||
heap_mem_root:=p;
|
||||
{ must be changed before fill_extra_info is called
|
||||
because checkpointer can be called from within
|
||||
fill_extra_info PM }
|
||||
inc(getmem_cnt);
|
||||
if assigned(fill_extra_info) then
|
||||
fill_extra_info(@pheap_mem_info(p)^.extra_info);
|
||||
begin
|
||||
inside_trace_getmem:=true;
|
||||
fill_extra_info(@pheap_mem_info(p)^.extra_info);
|
||||
inside_trace_getmem:=false;
|
||||
end;
|
||||
{ update the pointer }
|
||||
if usecrc then
|
||||
pheap_mem_info(p)^.sig:=calculate_sig(pheap_mem_info(p));
|
||||
inc(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
inc(getmem_cnt);
|
||||
TraceGetmem:=p;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TraceFreeMem
|
||||
TraceFreeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceFreeMemSize(var p:pointer;size:longint):longint;
|
||||
@ -401,9 +408,9 @@ begin
|
||||
ppsize:=ppsize+sizeof(longint);
|
||||
dec(p,sizeof(theap_mem_info)+extra_info_size);
|
||||
pp:=pheap_mem_info(p);
|
||||
if not quicktrace and not(is_in_getmem_list(p)) then
|
||||
if not quicktrace and not(is_in_getmem_list(pp)) then
|
||||
RunError(204);
|
||||
if pp^.sig=$AAAAAAAA then
|
||||
if (pp^.sig=$AAAAAAAA) and not usecrc then
|
||||
begin
|
||||
error_in_heap:=true;
|
||||
dump_already_free(pp,ptext^);
|
||||
@ -465,25 +472,25 @@ begin
|
||||
fillchar(p^,size,#240); { $F0 will lead to GFP if used as pointer ! }
|
||||
{ We want to check if the memory was changed after release !! }
|
||||
pp^.release_sig:=calculate_release_sig(pp);
|
||||
if pp=heap_valid_first then
|
||||
if pp=heap_valid_last then
|
||||
begin
|
||||
heap_valid_first:=pp^.next_valid;
|
||||
if pp=heap_valid_last then
|
||||
heap_valid_last:=nil;
|
||||
heap_valid_last:=pp^.prev_valid;
|
||||
if pp=heap_valid_first then
|
||||
heap_valid_first:=nil;
|
||||
exit;
|
||||
end;
|
||||
pp2:=heap_valid_first;
|
||||
pp2:=heap_valid_last;
|
||||
while assigned(pp2) do
|
||||
begin
|
||||
if pp2^.next_valid=pp then
|
||||
if pp2^.prev_valid=pp then
|
||||
begin
|
||||
pp2^.next_valid:=pp^.next_valid;
|
||||
if pp=heap_valid_last then
|
||||
heap_valid_last:=pp2;
|
||||
pp2^.prev_valid:=pp^.prev_valid;
|
||||
if pp=heap_valid_first then
|
||||
heap_valid_first:=pp2;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
pp2:=pp2^.next_valid;
|
||||
pp2:=pp2^.prev_valid;
|
||||
end;
|
||||
exit;
|
||||
{$endif EXTRA}
|
||||
@ -500,7 +507,7 @@ function TraceMemSize(p:pointer):Longint;
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
l:=SysMemSize(p-sizeof(theap_mem_info)+extra_info_size);
|
||||
l:=SysMemSize(p-(sizeof(theap_mem_info)+extra_info_size));
|
||||
dec(l,sizeof(theap_mem_info)+extra_info_size);
|
||||
if add_tail then
|
||||
dec(l,sizeof(longint));
|
||||
@ -513,7 +520,7 @@ var
|
||||
size : longint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
pp:=pheap_mem_info(pointer(p)-sizeof(theap_mem_info)+extra_info_size);
|
||||
pp:=pheap_mem_info(pointer(p)-(sizeof(theap_mem_info)+extra_info_size));
|
||||
size:=TraceMemSize(p);
|
||||
{ this can never happend normaly }
|
||||
if pp^.size>size then
|
||||
@ -538,8 +545,11 @@ var
|
||||
edata : cardinal; external name 'edata';
|
||||
{$endif go32v2}
|
||||
|
||||
{$S-}
|
||||
|
||||
var
|
||||
heap_at_init : pointer;
|
||||
StartUpHeapEnd : pointer;
|
||||
|
||||
procedure CheckPointer(p : pointer);[public, alias : 'FPC_CHECKPOINTER'];
|
||||
var
|
||||
@ -580,26 +590,44 @@ begin
|
||||
{$endif go32v2}
|
||||
|
||||
{ I don't know where the stack is in other OS !! }
|
||||
{$ifdef win32}
|
||||
if (cardinal(p)>=$40000) and (p<=HeapOrg) then
|
||||
goto _exit;
|
||||
{ inside stack ? }
|
||||
if (cardinal(startupheapend)<Win32StackTop) and (cardinal(p)>cardinal(startupheapend)) and
|
||||
(cardinal(p)<Win32StackTop) then
|
||||
goto _exit;
|
||||
{$endif win32}
|
||||
|
||||
if p>=heapptr then
|
||||
runerror(216);
|
||||
{ first try valid list faster }
|
||||
|
||||
{$ifdef EXTRA}
|
||||
pp:=heap_valid_first;
|
||||
pp:=heap_valid_last;
|
||||
while pp<>nil do
|
||||
begin
|
||||
{ inside this valid block ! }
|
||||
if (cardinal(p)>=cardinal(pp)+sizeof(theap_mem_info)+extra_info_size) and
|
||||
{ we can be changing the extrainfo !! }
|
||||
if (cardinal(p)>=cardinal(pp)+sizeof(theap_mem_info){+extra_info_size}) and
|
||||
(cardinal(p)<=cardinal(pp)+sizeof(theap_mem_info)+extra_info_size+pp^.size) then
|
||||
begin
|
||||
{ check allocated block }
|
||||
if ((pp^.sig=$DEADBEEF) and not usecrc) or
|
||||
((pp^.sig=calculate_sig(pp)) and usecrc) then
|
||||
goto _exit;
|
||||
((pp^.sig=calculate_sig(pp)) and usecrc) or
|
||||
{ special case of the fill_extra_info call }
|
||||
((pp=heap_valid_last) and usecrc and (pp^.sig=$DEADBEEF)
|
||||
and inside_trace_getmem) then
|
||||
goto _exit
|
||||
else
|
||||
begin
|
||||
writeln(ptext^,'corrupted heap_mem_info');
|
||||
dump_error(pp,ptext^);
|
||||
halt(1);
|
||||
end;
|
||||
end
|
||||
else
|
||||
pp:=pp^.next_valid;
|
||||
pp:=pp^.prev_valid;
|
||||
inc(i);
|
||||
if i>getmem_cnt-freemem_cnt then
|
||||
begin
|
||||
@ -851,6 +879,7 @@ begin
|
||||
end;
|
||||
|
||||
Procedure SetHeapTraceOutput(const name : string);
|
||||
var i : longint;
|
||||
begin
|
||||
if ptext<>@stderr then
|
||||
begin
|
||||
@ -864,6 +893,9 @@ begin
|
||||
Rewrite(ownfile);
|
||||
{$I+}
|
||||
ptext:=@ownfile;
|
||||
for i:=0 to Paramcount do
|
||||
write(ptext^,paramstr(i),' ');
|
||||
writeln(ptext^);
|
||||
end;
|
||||
|
||||
procedure SetExtraInfo( size : longint;func : fillextrainfotype);
|
||||
@ -892,12 +924,16 @@ Initialization
|
||||
Rewrite(error_file);
|
||||
{$endif EXTRA}
|
||||
Heap_at_init:=HeapPtr;
|
||||
StartupHeapEnd:=HeapEnd;
|
||||
finalization
|
||||
TraceExit;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 1999-11-06 14:35:38 peter
|
||||
Revision 1.28 1999-11-09 22:32:23 pierre
|
||||
* several extra_size_info fixes
|
||||
|
||||
Revision 1.27 1999/11/06 14:35:38 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.26 1999/11/01 13:56:50 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user