* memdebug enhancements

compiler/assemble.pas

@@ -602,13 +602,13 @@ Implementation
 {$endif}
       begin
 {$ifdef MEMDEBUG}
-         d := tmemdebug.create('agbin');
+        d := tmemdebug.create(name+' - agbin');
 {$endif}
         objectdata.free;
         objectoutput.free;
         objectalloc.free;
 {$ifdef MEMDEBUG}
-         d.free;
+        d.free;
 {$endif}
       end;
 
@@ -1608,7 +1608,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.43  2002-08-20 16:55:38  peter
+  Revision 1.44  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.43  2002/08/20 16:55:38  peter
     * don't write (stabs)line info when inlining a procedure
 
   Revision 1.42  2002/08/12 15:08:39  carl

compiler/cclasses.pas

@@ -36,12 +36,15 @@ interface
     type
        tmemdebug = class
        private
+          totalmem,
           startmem : integer;
           infostr  : string[40];
        public
           constructor Create(const s:string);
           destructor  Destroy;override;
           procedure show;
+          procedure start;
+          procedure stop;
        end;
 
 {********************************************
@@ -293,6 +296,13 @@ implementation
     constructor tmemdebug.create(const s:string);
       begin
         infostr:=s;
+        totalmem:=0;
+        Start;
+      end;
+
+
+    procedure tmemdebug.start;
+      begin
 {$ifdef Delphi}
         startmem:=0;
 {$else}
@@ -301,25 +311,31 @@ implementation
       end;
 
 
+    procedure tmemdebug.stop;
+      begin
+        if startmem<>0 then
+         begin
+           inc(TotalMem,memavail-startmem);
+           startmem:=0;
+         end;
+      end;
+
+
     destructor tmemdebug.destroy;
       begin
+        Stop;
         show;
       end;
 
 
     procedure tmemdebug.show;
-{$ifndef Delphi}
-      var
-        l : integer;
-{$endif}
       begin
 {$ifndef Delphi}
         write('memory [',infostr,'] ');
-        l:=memavail;
-        if l>startmem then
-         writeln(l-startmem,' released')
+        if TotalMem>0 then
+         writeln(DStr(TotalMem shr 10),' Kb released')
         else
-         writeln(startmem-l,' allocated');
+         writeln(DStr((-TotalMem) shr 10),' Kb allocated');
 {$endif Delphi}
       end;
 
@@ -1735,7 +1751,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  2002-08-11 13:24:11  peter
+  Revision 1.18  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.17  2002/08/11 13:24:11  peter
     * saving of asmsymbols in ppu supported
     * asmsymbollist global is removed and moved into a new class
       tasmlibrarydata that will hold the info of a .a file which

compiler/cgbase.pas

@@ -520,7 +520,7 @@ implementation
 {$endif}
       begin
 {$ifdef MEMDEBUG}
-         d:=tmemdebug.create('asmlist');
+         d:=tmemdebug.create(current_module.modulename^+' - asmlists');
 {$endif}
          exprasmlist.free;
          codesegment.free;
@@ -655,7 +655,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-08-18 20:06:23  peter
+  Revision 1.27  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.26  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu

compiler/comphook.pas

@@ -143,10 +143,11 @@ implementation
 
   uses
 {$ifdef delphi}
-   dmisc
+   dmisc,
 {$else}
-   dos
+   dos,
 {$endif}
+   cutils
    ;
 
 {****************************************************************************
@@ -217,10 +218,10 @@ begin
 {$endif Delphi}
      if (status.currentline>0) and (status.currentline mod 100=0) then
 {$ifdef FPC}
-       WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
+       WriteLn(status.currentline,' ',DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
 {$else}
   {$ifndef Delphi}
-       WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
+       WriteLn(status.currentline,' ',DStr(memavail shr 10),' Kb Free');
   {$endif Delphi}
 {$endif}
    end
@@ -355,7 +356,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.19  2002-05-18 13:34:06  peter
+  Revision 1.20  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.19  2002/05/18 13:34:06  peter
     * readded missing revisions
 
   Revision 1.18  2002/05/16 19:46:35  carl

compiler/cutils.pas

@@ -67,6 +67,7 @@ interface
     function tostr(i : longint) : string;
     function int64tostr(i : int64) : string;
     function tostr_with_plus(i : longint) : string;
+    function DStr(l:longint):string;
     procedure valint(S : string;var V : longint;var code : integer);
     {# Returns true if the string s is a number }
     function is_number(const s : string) : boolean;
@@ -374,6 +375,23 @@ uses
        end;
 
 
+    function DStr(l:longint):string;
+      var
+        TmpStr : string[32];
+        i : longint;
+      begin
+        Str(l,TmpStr);
+        i:=Length(TmpStr);
+        while (i>3) do
+         begin
+           dec(i,3);
+           if TmpStr[i]<>'-' then
+            insert('.',TmpStr,i+1);
+         end;
+        DStr:=TmpStr;
+      end;
+
+
     function trimbspace(const s:string):string;
     {
       return s with all leading spaces and tabs removed
@@ -803,7 +821,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.21  2002-07-26 11:16:35  jonas
+  Revision 1.22  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.21  2002/07/26 11:16:35  jonas
     * fixed (actual and potential) range errors
 
   Revision 1.20  2002/07/07 11:13:34  carl

compiler/fmodule.pas

@@ -455,7 +455,6 @@ uses
         stringdispose(exefilename);
         stringdispose(outputpath);
         stringdispose(path);
-        stringdispose(modulename);
         stringdispose(realmodulename);
         stringdispose(mainsource);
         stringdispose(asmprefix);
@@ -464,7 +463,7 @@ uses
         localincludesearchpath.free;
         locallibrarysearchpath.free;
 {$ifdef MEMDEBUG}
-        d:=tmemdebug.create('symtable');
+        d:=tmemdebug.create(modulename^+' - symtable');
 {$endif}
         if assigned(globalsymtable) then
           globalsymtable.free;
@@ -474,12 +473,13 @@ uses
         d.free;
 {$endif}
 {$ifdef MEMDEBUG}
-        d:=tmemdebug.create('librarydata');
+        d:=tmemdebug.create(modulename^+' - librarydata');
 {$endif}
         librarydata.free;
 {$ifdef MEMDEBUG}
         d.free;
 {$endif}
+        stringdispose(modulename);
         inherited Destroy;
       end;
 
@@ -603,7 +603,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.27  2002-08-16 15:31:08  peter
+  Revision 1.28  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.27  2002/08/16 15:31:08  peter
     * fixed possible crashes with current_scanner
 
   Revision 1.26  2002/08/12 16:46:04  peter

compiler/symdef.pas

@@ -821,10 +821,6 @@ implementation
          fillchar(localrttilab,sizeof(localrttilab),0);
       end;
 
-{$ifdef MEMDEBUG}
-   var
-       manglenamesize : longint;
-{$endif}
 
     constructor tstoreddef.ppuloaddef(ppufile:tcompilerppufile);
       begin
@@ -3441,17 +3437,49 @@ implementation
            end;
          aliasnames.free;
          if assigned(parast) then
-           parast.free;
+          begin
+{$ifdef MEMDEBUG}
+            memprocparast.start;
+{$endif MEMDEBUG}
+            parast.free;
+{$ifdef MEMDEBUG}
+            memprocparast.stop;
+{$endif MEMDEBUG}
+          end;
          if assigned(localst) and (localst.symtabletype<>staticsymtable) then
-           localst.free;
+          begin
+{$ifdef MEMDEBUG}
+            memproclocalst.start;
+{$endif MEMDEBUG}
+            localst.free;
+{$ifdef MEMDEBUG}
+            memproclocalst.start;
+{$endif MEMDEBUG}
+          end;
          if (proccalloption=pocall_inline) and assigned(code) then
-           tnode(code).free;
+          begin
+{$ifdef MEMDEBUG}
+            memprocnodetree.start;
+{$endif MEMDEBUG}
+            tnode(code).free;
+{$ifdef MEMDEBUG}
+            memprocnodetree.start;
+{$endif MEMDEBUG}
+          end;
          if assigned(regvarinfo) then
            dispose(pregvarinfo(regvarinfo));
          if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
          if assigned(_mangledname) then
-           stringdispose(_mangledname);
+          begin
+{$ifdef MEMDEBUG}
+            memmanglednames.start;
+{$endif MEMDEBUG}
+            stringdispose(_mangledname);
+{$ifdef MEMDEBUG}
+            memmanglednames.stop;
+{$endif MEMDEBUG}
+          end;
          inherited destroy;
       end;
 
@@ -5509,7 +5537,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.91  2002-08-25 19:25:20  peter
+  Revision 1.92  2002-09-05 19:29:42  peter
+    * memdebug enhancements
+
+  Revision 1.91  2002/08/25 19:25:20  peter
     * sym.insert_in_data removed
     * symtable.insertvardata/insertconstdata added
     * removed insert_in_data call from symtable.insert, it needs to be

compiler/symsym.pas

@@ -527,11 +527,25 @@ implementation
     destructor tstoredsym.destroy;
       begin
         if assigned(_mangledname) then
-         stringdispose(_mangledname);
+         begin
+{$ifdef MEMDEBUG}
+           memmanglednames.start;
+{$endif MEMDEBUG}
+           stringdispose(_mangledname);
+{$ifdef MEMDEBUG}
+           memmanglednames.stop;
+{$endif MEMDEBUG}
+         end;
         if assigned(defref) then
          begin
+{$ifdef MEMDEBUG}
+           membrowser.start;
+{$endif MEMDEBUG}
            defref.freechain;
            defref.free;
+{$ifdef MEMDEBUG}
+           membrowser.stop;
+{$endif MEMDEBUG}
          end;
         inherited destroy;
       end;
@@ -2482,7 +2496,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2002-09-05 14:51:42  peter
+  Revision 1.61  2002-09-05 19:29:45  peter
+    * memdebug enhancements
+
+  Revision 1.60  2002/09/05 14:51:42  peter
     * internalerror instead of crash in getprocdef
 
   Revision 1.59  2002/09/03 16:26:27  daniel

compiler/symtable.pas

@@ -1048,7 +1048,7 @@ implementation
               else if (varalign>1) and (dataalignment<2) then
                dataalignment:=2;
             end;
-           dataalignment:=max(dataalignment,aktalignment.maxCrecordalign);
+           dataalignment:=min(dataalignment,aktalignment.maxCrecordalign);
          end
         else
          varalign:=vardef.alignment;
@@ -2299,7 +2299,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  2002-08-25 19:25:21  peter
+  Revision 1.70  2002-09-05 19:29:45  peter
+    * memdebug enhancements
+
+  Revision 1.69  2002/08/25 19:25:21  peter
     * sym.insert_in_data removed
     * symtable.insertvardata/insertconstdata added
     * removed insert_in_data call from symtable.insert, it needs to be

compiler/symtype.pas

@@ -27,6 +27,9 @@ interface
     uses
       { common }
       cutils,
+{$ifdef MEMDEBUG}
+      cclasses,
+{$endif MEMDEBUG}
       { global }
       globtype,globals,
       { symtable }
@@ -140,6 +143,16 @@ interface
     procedure resolvesym(var sym:pointer);
     procedure resolvedef(var def:pointer);
 
+{$ifdef MEMDEBUG}
+    var
+      membrowser,
+      memrealnames,
+      memmanglednames,
+      memprocparast,
+      memproclocalst,
+      memprocnodetree : tmemdebug;
+{$endif MEMDEBUG}
+
 
 implementation
 
@@ -212,7 +225,13 @@ implementation
 
     destructor tsym.destroy;
       begin
+{$ifdef MEMDEBUG}
+        memrealnames.start;
+{$endif MEMDEBUG}
         stringdispose(_realname);
+{$ifdef MEMDEBUG}
+        memrealnames.stop;
+{$endif MEMDEBUG}
         inherited destroy;
       end;
 
@@ -525,10 +544,37 @@ implementation
          sym:=nil;
       end;
 
+{$ifdef MEMDEBUG}
+initialization
+  membrowser:=TMemDebug.create('BrowserRefs');
+  membrowser.stop;
+  memrealnames:=TMemDebug.create('Realnames');
+  memrealnames.stop;
+  memmanglednames:=TMemDebug.create('Manglednames');
+  memmanglednames.stop;
+  memprocparast:=TMemDebug.create('ProcParaSt');
+  memprocparast.stop;
+  memproclocalst:=TMemDebug.create('ProcLocalSt');
+  memproclocalst.stop;
+  memprocnodetree:=TMemDebug.create('ProcNodeTree');
+  memprocnodetree.stop;
+
+finalization
+  membrowser.free;
+  memrealnames.free;
+  memmanglednames.free;
+  memprocparast.free;
+  memproclocalst.free;
+  memprocnodetree.free;
+{$endif MEMDEBUG}
+
 end.
 {
   $Log$
-  Revision 1.21  2002-08-18 20:06:28  peter
+  Revision 1.22  2002-09-05 19:29:46  peter
+    * memdebug enhancements
+
+  Revision 1.21  2002/08/18 20:06:28  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu