paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 12:49:33 +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);
const
{ tracing level
splitted in two if memory is released !! }
tracesize = 8;
quicktrace : boolean=true;
keepreleased : boolean=true;
{ set this to true if you suspect that memory
is freed several times }
keepreleased : boolean=false;
implementation
@ -66,6 +70,8 @@ var
freemem_cnt : longint;
getmem_size,
freemem_size : longint;
getmem8_size,
freemem8_size : longint;
{*****************************************************************************
@ -154,6 +160,7 @@ var
i,bp : longint;
begin
inc(getmem_size,size);
inc(getmem8_size,((size+7) div 8)*8);
{ Do the real GetMem, but alloc also for the info block }
SysGetMem(p,size+sizeof(theap_mem_info)+extra_info_size);
{ Create the info block }
@ -189,6 +196,7 @@ procedure TraceFreeMem(var p:pointer;size:longint);
pp : pheap_mem_info;
begin
inc(freemem_size,size);
inc(freemem8_size,((size+7) div 8)*8);
inc(size,sizeof(theap_mem_info)+extra_info_size);
dec(p,sizeof(theap_mem_info)+extra_info_size);
pp:=pheap_mem_info(p);
@ -222,8 +230,11 @@ begin
inc(freemem_cnt);
{ release the normal memory at least !! }
{ this way we keep all info about all released memory !! }
dec(size,sizeof(theap_mem_info));
inc(p,sizeof(theap_mem_info));
if keepreleased then
begin
dec(size,sizeof(theap_mem_info)+extra_info_size);
inc(p,sizeof(theap_mem_info)+extra_info_size);
end;
SysFreeMem(p,size);
end;
@ -239,9 +250,13 @@ var
begin
pp:=heap_mem_root;
Writeln(stderr,'Heap dump by heaptrc unit');
Writeln(stderr,getmem_cnt, ' memory blocks allocated : ',getmem_size);
Writeln(stderr,freemem_cnt,' memory blocks freed : ',freemem_size);
Writeln(stderr,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_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,'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;
while pp<>nil do
begin
@ -321,7 +336,13 @@ begin
end.
{
$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
Revision 1.3 1998/10/06 17:09:13 pierre