* MEMDEBUG to see the sizes of asmlist,asmsymbols,symtables

compiler/cobjects.pas

@@ -72,6 +72,15 @@ unit cobjects;
          fileindex : word;
        end;
 
+       pmemdebug = ^tmemdebug;
+       tmemdebug = object
+          constructor init(const s:string);
+          destructor  done;
+          procedure show;
+       private
+          startmem : longint;
+          infostr  : string[40];
+       end;
 
        plinkedlist_item = ^tlinkedlist_item;
        tlinkedlist_item = object
@@ -403,6 +412,34 @@ unit cobjects;
 
   implementation
 
+{*****************************************************************************
+                                    Memory debug
+*****************************************************************************}
+
+    constructor tmemdebug.init(const s:string);
+      begin
+        infostr:=s;
+        startmem:=memavail;
+      end;
+
+    procedure tmemdebug.show;
+      var
+        l : longint;
+      begin
+        write('memory [',infostr,'] ');
+        l:=memavail;
+        if l>startmem then
+         writeln(l-startmem,' released')
+        else
+         writeln(startmem-l,' allocated');
+      end;
+
+    destructor tmemdebug.done;
+      begin
+        show;
+      end;
+
+
 {$ifndef OLDSPEEDVALUE}
 
 {*****************************************************************************
@@ -2217,7 +2254,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.40  1999-08-12 23:19:05  pierre
+  Revision 1.41  1999-08-24 13:13:57  peter
+    * MEMDEBUG to see the sizes of asmlist,asmsymbols,symtables
+
+  Revision 1.40  1999/08/12 23:19:05  pierre
    * added inherited init call to tstringcontainer.init_no_double for Peter
 
   Revision 1.39  1999/08/05 14:58:07  florian

compiler/files.pas

@@ -1212,6 +1212,10 @@ end;
 
 
     destructor tmodule.done;
+{$ifdef MEMDEBUG}
+      var
+        d : tmemdebug;
+{$endif}
       begin
         if assigned(map) then
          dispose(map);
@@ -1253,12 +1257,18 @@ end;
         stringdispose(localobjectsearchpath);
         stringdispose(localincludesearchpath);
         stringdispose(locallibrarysearchpath);
+{$ifdef MEMDEBUG}
+        d.init('symtable');
+{$endif}
         if assigned(globalsymtable) then
           dispose(punitsymtable(globalsymtable),done);
         globalsymtable:=nil;
         if assigned(localsymtable) then
           dispose(punitsymtable(localsymtable),done);
         localsymtable:=nil;
+{$ifdef MEMDEBUG}
+        d.done;
+{$endif}
         inherited done;
       end;
 
@@ -1314,7 +1324,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.99  1999-07-18 14:47:26  florian
+  Revision 1.100  1999-08-24 13:14:01  peter
+    * MEMDEBUG to see the sizes of asmlist,asmsymbols,symtables
+
+  Revision 1.99  1999/07/18 14:47:26  florian
     * bug 487 fixed, (inc(<property>) isn't allowed)
     * more fixes to compile with Delphi
 

compiler/hcodegen.pas

@@ -259,7 +259,14 @@ implementation
 
 
     procedure codegen_donemodule;
+{$ifdef MEMDEBUG}
+      var
+        d : tmemdebug;
+{$endif}
       begin
+{$ifdef MEMDEBUG}
+         d.init('asmlist');
+{$endif}
          dispose(exprasmlist,done);
          dispose(codesegment,done);
          dispose(bsssegment,done);
@@ -273,8 +280,17 @@ implementation
           dispose(exportssection,done);
          if assigned(resourcesection) then
           dispose(resourcesection,done);
+{$ifdef MEMDEBUG}
+         d.done;
+{$endif}
          { assembler symbols }
+{$ifdef MEMDEBUG}
+         d.init('asmsymbol');
+{$endif}
          dispose(asmsymbollist,done);
+{$ifdef MEMDEBUG}
+         d.done;
+{$endif}
          { resource strings }
          { if assigned(resourcestringlist) then
           dispose(resourcestringlist,done); }
@@ -296,7 +312,10 @@ end.
 
 {
   $Log$
-  Revision 1.40  1999-08-24 12:01:32  michael
+  Revision 1.41  1999-08-24 13:14:03  peter
+    * MEMDEBUG to see the sizes of asmlist,asmsymbols,symtables
+
+  Revision 1.40  1999/08/24 12:01:32  michael
   + changes for resourcestrings
 
   Revision 1.39  1999/08/19 13:10:18  pierre