Browse Source

* 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

pierre 27 years ago
parent
commit
b6986c4f1c
1 changed files with 27 additions and 6 deletions
  1. 27 6
      rtl/inc/heaptrc.pp

+ 27 - 6
rtl/inc/heaptrc.pp

@@ -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