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

* changed default to keepreleased=false

Browse Source 
(allows to compile pp in one call without reaching the
    64Mb limit of Windows 95 dos box)
  * corrected so typo errors
This commit is contained in:
pierre 1998-10-09 11:59:31 +00:00
parent 4073682c64
commit b6986c4f1c
1 changed files with 27 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
rtl/inc/heaptrc.pp
View File

@ -29,9 +29,13 @@ type
procedure set_extra_info( size : longint;func : fill_extra_info_type); procedure set_extra_info( size : longint;func : fill_extra_info_type);
const const
{ tracing level
splitted in two if memory is released !! }
tracesize = 8; tracesize = 8;
quicktrace : boolean=true; quicktrace : boolean=true;
keepreleased : boolean=true; { set this to true if you suspect that memory
is freed several times }
keepreleased : boolean=false;
implementation implementation
@ -66,6 +70,8 @@ var
freemem_cnt : longint; freemem_cnt : longint;
getmem_size, getmem_size,
freemem_size : longint; freemem_size : longint;
getmem8_size,
freemem8_size : longint;
{***************************************************************************** {*****************************************************************************
@ -154,6 +160,7 @@ var
i,bp : longint; i,bp : longint;
begin begin
inc(getmem_size,size); inc(getmem_size,size);
inc(getmem8_size,((size+7) div 8)*8);
{ Do the real GetMem, but alloc also for the info block } { Do the real GetMem, but alloc also for the info block }
SysGetMem(p,size+sizeof(theap_mem_info)+extra_info_size); SysGetMem(p,size+sizeof(theap_mem_info)+extra_info_size);
{ Create the info block } { Create the info block }
@ -189,6 +196,7 @@ procedure TraceFreeMem(var p:pointer;size:longint);
pp : pheap_mem_info; pp : pheap_mem_info;
begin begin
inc(freemem_size,size); inc(freemem_size,size);
inc(freemem8_size,((size+7) div 8)*8);
inc(size,sizeof(theap_mem_info)+extra_info_size); inc(size,sizeof(theap_mem_info)+extra_info_size);
dec(p,sizeof(theap_mem_info)+extra_info_size); dec(p,sizeof(theap_mem_info)+extra_info_size);
pp:=pheap_mem_info(p); pp:=pheap_mem_info(p);
@ -222,8 +230,11 @@ begin
inc(freemem_cnt); inc(freemem_cnt);
{ release the normal memory at least !! } { release the normal memory at least !! }
{ this way we keep all info about all released memory !! } { this way we keep all info about all released memory !! }
dec(size,sizeof(theap_mem_info)); if keepreleased then
inc(p,sizeof(theap_mem_info)); begin
dec(size,sizeof(theap_mem_info)+extra_info_size);
inc(p,sizeof(theap_mem_info)+extra_info_size);
end;
SysFreeMem(p,size); SysFreeMem(p,size);
end; end;
@ -239,9 +250,13 @@ var
begin begin
pp:=heap_mem_root; pp:=heap_mem_root;
Writeln(stderr,'Heap dump by heaptrc unit'); Writeln(stderr,'Heap dump by heaptrc unit');
Writeln(stderr,getmem_cnt, ' memory blocks allocated : ',getmem_size); Writeln(stderr,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
Writeln(stderr,freemem_cnt,' memory blocks freed : ',freemem_size); Writeln(stderr,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_size);
Writeln(stderr,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size); Writeln(stderr,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size);
Writeln(stderr,'True heap size : ',system.HeapSize);
Writeln(stderr,'True free heap : ',MemAvail);
Writeln(stderr,'Should be : ',system.HeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size));
i:=getmem_cnt-freemem_cnt; i:=getmem_cnt-freemem_cnt;
while pp<>nil do while pp<>nil do
begin begin
@ -321,7 +336,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-10-08 14:49:05 pierre Revision 1.5 1998-10-09 11:59:31 pierre
* changed default to keepreleased=false
(allows to compile pp in one call without reaching the
64Mb limit of Windows 95 dos box)
* corrected so typo errors
Revision 1.4 1998/10/08 14:49:05 pierre
+ added possibility for more info + added possibility for more info
Revision 1.3 1998/10/06 17:09:13 pierre Revision 1.3 1998/10/06 17:09:13 pierre