* removed a lot of memory leaks when an error is encountered (caused by

procinfo and pstringcontainers). There are still plenty left though :)

compiler/cobjects.pas

@@ -388,6 +388,26 @@ unit cobjects;
        end;
 {$endif BUFFEREDFILE}
 
+{$ifdef fixLeaksOnError}
+    PStackItem = ^TStackItem;
+    TStackItem = record
+      next: PStackItem;
+      data: pointer;
+    end;
+
+    PStack = ^TStack;
+    TStack = object
+      constructor init;
+      destructor done;
+      procedure push(p: pointer);
+      function pop: pointer;
+      function top: pointer;
+      function isEmpty: boolean;
+     private
+      head: PStackItem;
+    end;
+{$endif fixLeaksOnError}
+
     function getspeedvalue(const s : string) : longint;
 
     { releases the string p and assignes nil to p }
@@ -448,6 +468,63 @@ unit cobjects;
         show;
       end;
 
+{*****************************************************************************
+                                 Stack
+*****************************************************************************}
+
+
+
+{$ifdef fixLeaksOnError}
+constructor TStack.init;
+begin
+  head := nil;
+end;
+
+procedure TStack.push(p: pointer);
+var s: PStackItem;
+begin
+  new(s);
+  s^.data := p;
+  s^.next := head;
+  head := s;
+end;
+
+function TStack.pop: pointer;
+var s: PStackItem;
+begin
+  pop := top;
+  if assigned(head) then
+    begin
+      s := head^.next;
+      dispose(head);
+      head := s;
+    end
+end;
+
+function TStack.top: pointer;
+begin
+  if not isEmpty then
+    top := head^.data
+  else top := NIL;
+end;
+
+function TStack.isEmpty: boolean;
+begin
+  isEmpty := head = nil;
+end;
+
+destructor TStack.done;
+var temp: PStackItem;
+begin
+  while head <> nil do
+    begin
+      temp := head^.next;
+      dispose(head);
+      head := temp;
+    end;
+end;
+{$endif fixLeaksOnError}
+
 
 {$ifndef OLDSPEEDVALUE}
 
@@ -2318,7 +2395,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.50  2000-01-07 01:14:23  peter
+  Revision 1.51  2000-01-11 17:16:04  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.50  2000/01/07 01:14:23  peter
     * updated copyright to 2000
 
   Revision 1.49  1999/12/22 01:01:48  peter

compiler/compiler.pas

@@ -322,13 +322,24 @@ begin
   Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
 {$endif newcg}
 {$endif EXTDEBUG}
+{$ifdef fixLeaksOnError}
+ {$ifdef tp}
+  do_stop;
+ {$else tp}
+  do_stop();
+ {$endif tp}
+{$endif fixLeaksOnError}
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.44  2000-01-11 16:56:22  jonas
+  Revision 1.45  2000-01-11 17:16:04  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.44  2000/01/11 16:56:22  jonas
     - removed call to do_stop at the end of compile() since it obviously breaks the
       automatic compiling of units. Make cycle worked though! 8)
 

compiler/hcodegen.pas

@@ -164,7 +164,17 @@ implementation
 implementation
 
      uses
-        systems,globals,files,strings,cresstr;
+        systems,globals,files,strings,cresstr
+{$ifdef fixLeaksOnError}
+        ,comphook
+{$endif fixLeaksOnError}
+
+        ;
+
+{$ifdef fixLeaksOnError}
+     var procinfoStack: TStack;
+         hcodegen_old_do_stop: tstopprocedure;
+{$endif fixLeaksOnError}
 
 {*****************************************************************************
             override the message calls to set codegenerror
@@ -321,12 +331,19 @@ implementation
            so it must not be reset to zero before this storage !}
          { new procinfo }
          new(procinfo,init);
+{$ifdef fixLeaksOnError}
+         procinfoStack.push(procinfo);
+{$endif fixLeaksOnError}
       end;
 
 
 
     procedure codegen_doneprocedure;
       begin
+{$ifdef fixLeaksOnError}
+         if procinfo <> procinfoStack.pop then
+           writeln('problem with procinfoStack!');
+{$endif fixLeaksOnError}
          dispose(procinfo,done);
          procinfo:=nil;
       end;
@@ -401,11 +418,40 @@ implementation
          typ:=p;
       end;
 {$endif newcg}
+
+{$ifdef fixLeaksOnError}
+procedure hcodegen_do_stop; {$ifdef tp} far; {$endif tp}
+var p: pprocinfo;
+begin
+  p := pprocinfo(procinfoStack.pop);
+  while p <> nil Do
+    begin
+      dispose(p,done);
+      p := pprocinfo(procinfoStack.pop);
+    end;
+  procinfoStack.done;
+  do_stop := hcodegen_old_do_stop;
+{$ifdef tp}
+  do_stop;
+{$else tp}
+  do_stop();
+{$endif tp}
+end;
+
+begin
+  hcodegen_old_do_stop := do_stop;
+  do_stop := {$ifdef tp}@{$endif}hcodegen_do_stop;
+  procinfoStack.init;
+{$endif fixLeaksOnError}
 end.
 
 {
   $Log$
-  Revision 1.53  2000-01-07 01:14:27  peter
+  Revision 1.54  2000-01-11 17:16:04  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.53  2000/01/07 01:14:27  peter
     * updated copyright to 2000
 
   Revision 1.52  1999/12/09 23:18:04  pierre

compiler/pbase.pas

@@ -25,7 +25,11 @@ unit pbase;
   interface
 
     uses
-       cobjects,tokens,globals,symtable;
+       cobjects,tokens,globals,symtable
+{$ifdef fixLeaksOnError}
+       ,comphook
+{$endif fixLeaksOnError}
+       ;
 
     const
        { true, if we are after an assignement }
@@ -53,6 +57,12 @@ unit pbase;
        { true, if we should ignore an equal in const x : 1..2=2 }
        ignore_equal : boolean;
 
+{$ifdef fixLeaksOnError}
+    { not worth it to make a pstack, there's only one data field (a pointer). }
+    { in the interface, because pmodules and psub also use it for their names }
+    var strContStack: TStack;
+        pbase_old_do_stop: tstopprocedure;
+{$endif fixLeaksOnError}
 
     function tokenstring(i : ttoken):string;
 
@@ -156,11 +166,39 @@ unit pbase;
          idlist:=sc;
       end;
 
+{$ifdef fixLeaksOnError}
+procedure pbase_do_stop; {$ifdef tp} far; {$endif tp}
+var names: PStringContainer;
+begin
+  names := PStringContainer(strContStack.pop);
+  while names <> nil do
+    begin
+      dispose(names,done);
+      names := PStringContainer(strContStack.pop);
+    end;
+  strContStack.done;
+  do_stop := pbase_old_do_stop;
+{$ifdef tp}
+  do_stop;
+{$else tp}
+  do_stop();
+{$endif tp}
+end;
+
+begin
+  strContStack.init;
+  pbase_old_do_stop := do_stop;
+  do_stop := {$ifndef tp}@{$endif}pbase_do_stop;
+{$endif fixLeaksOnError}
 end.
 
 {
   $Log$
-  Revision 1.28  2000-01-07 01:14:28  peter
+  Revision 1.29  2000-01-11 17:16:04  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.28  2000/01/07 01:14:28  peter
     * updated copyright to 2000
 
   Revision 1.27  1999/11/06 14:34:21  peter

compiler/pdecl.pas

@@ -134,6 +134,9 @@ unit pdecl;
             begin
              { read identifiers }
                sc:=idlist;
+{$ifdef fixLeaksOnError}
+               strContStack.push(sc);
+{$endif fixLeaksOnError}
              { read type declaration, force reading for value and const paras }
                if (token=_COLON) or (varspez=vs_value) then
                 begin
@@ -248,6 +251,10 @@ unit pdecl;
 
                    end;
                 end;
+{$ifdef fixLeaksOnError}
+               if PStringContainer(strContStack.pop) <> sc then
+                  writeln('problem with strContStack in pdecl (1)');
+{$endif fixLeaksOnError}
                dispose(sc,done);
                tokenpos:=storetokenpos;
             end;
@@ -304,6 +311,10 @@ unit pdecl;
                      st^.defowner^.owner^.insert(new(pvarsym,init(s,tt)));
                   end;
              end;
+{$ifdef fixLeaksOnError}
+             if strContStack.pop <> sc then
+               writeln('problem with strContStack in pdecl (2)');
+{$endif fixLeaksOnError}
            dispose(sc,done);
            tokenpos:=filepos;
         end;
@@ -345,6 +356,9 @@ unit pdecl;
            begin
              C_name:=orgpattern;
              sc:=idlist;
+{$ifdef fixLeaksOnError}
+             strContStack.push(sc);
+{$endif fixLeaksOnError}
              consume(_COLON);
              if (m_gpc in aktmodeswitches) and
                 not(is_record or is_object or is_threadvar) and
@@ -372,6 +386,10 @@ unit pdecl;
                   s:=sc^.get_with_tokeninfo(tokenpos);
                   if not sc^.empty then
                    Message(parser_e_absolute_only_one_var);
+{$ifdef fixLeaksOnError}
+                   if strContStack.pop <> sc then
+                     writeln('problem with strContStack in pdecl (3)');
+{$endif fixLeaksOnError}
                   dispose(sc,done);
                   aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,tt));
 {$ifdef INCLUDEOK}
@@ -392,6 +410,10 @@ unit pdecl;
                 s:=sc^.get_with_tokeninfo(declarepos);
                 if not sc^.empty then
                  Message(parser_e_absolute_only_one_var);
+{$ifdef fixLeaksOnError}
+                 if strContStack.pop <> sc then
+                   writeln('problem with strContStack in pdecl (4)');
+{$endif fixLeaksOnError}
                 dispose(sc,done);
                 { parse the rest }
                 if token=_ID then
@@ -506,6 +528,10 @@ unit pdecl;
                    s:=sc^.get_with_tokeninfo(declarepos);
                    if not sc^.empty then
                     Message(parser_e_absolute_only_one_var);
+{$ifdef fixLeaksOnError}
+                   if strContStack.pop <> sc then
+                     writeln('problem with strContStack in pdecl (5)');
+{$endif fixLeaksOnError}
                    dispose(sc,done);
                    { defaults }
                    is_dll:=false;
@@ -1182,7 +1208,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.177  2000-01-10 11:14:19  peter
+  Revision 1.178  2000-01-11 17:16:05  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.177  2000/01/10 11:14:19  peter
     * fixed memory leak with options, you must use StopOptions instead of
       Stop
     * fixed memory leak with forward resolving, make_ref is now false

compiler/pmodules.pas

@@ -57,7 +57,6 @@ unit pmodules;
 {$endif GDB}
        scanner,pbase,psystem,pdecl,psub,parser;
 
-
     procedure create_objectfile;
       begin
         { create the .s file and assemble it }
@@ -935,7 +934,11 @@ unit pmodules;
       end;
 
       var
+{$ifdef fixLeaksOnError}
+         names  : Pstringcontainer;
+{$else fixLeaksOnError}
          names  : Tstringcontainer;
+{$endif fixLeaksOnError}
          st     : psymtable;
          unitst : punitsymtable;
 {$ifdef GDB}
@@ -1157,11 +1160,22 @@ unit pmodules;
          { Compile the unit }
          codegen_newprocedure;
          gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
+{$ifdef fixLeaksOnError}
+         new(names,init);
+         strContStack.push(names);
+         names^.insert('INIT$$'+current_module^.modulename^);
+         names^.insert(target_os.cprefix+current_module^.modulename^+'_init');
+         compile_proc_body(names^,true,false);
+         if names <> PstringContainer(strContStack.pop) then
+           writeln('Problem with strContStack in pmodules (1)');
+         dispose(names,done);
+{$else fixLeaksOnError}
          names.init;
          names.insert('INIT$$'+current_module^.modulename^);
          names.insert(target_os.cprefix+current_module^.modulename^+'_init');
          compile_proc_body(names,true,false);
          names.done;
+{$endif fixLeaksOnError}
          codegen_doneprocedure;
 
          { avoid self recursive destructor call !! PM }
@@ -1176,11 +1190,22 @@ unit pmodules;
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
+{$ifdef fixLeaksOnError}
+              new(names,init);
+              strContStack.push(names);
+              names^.insert('FINALIZE$$'+current_module^.modulename^);
+              names^.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
+              compile_proc_body(names^,true,false);
+              if names <> PstringContainer(strContStack.pop) then
+                writeln('Problem with strContStack in pmodules (2)');
+              dispose(names,done);
+{$else fixLeaksOnError}
               names.init;
               names.insert('FINALIZE$$'+current_module^.modulename^);
               names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
               compile_proc_body(names,true,false);
               names.done;
+{$endif fixLeaksOnError}
               codegen_doneprocedure;
            end;
 
@@ -1328,7 +1353,11 @@ unit pmodules;
       var
          st    : psymtable;
          hp    : pmodule;
+{$ifdef fixLeaksOnError}
+         names : Pstringcontainer;
+{$else fixLeaksOnError}
          names : Tstringcontainer;
+{$endif fixLeaksOnError}
       begin
          DLLsource:=islibrary;
          IsExe:=true;
@@ -1435,16 +1464,32 @@ unit pmodules;
           from the bootstrap code.}
          codegen_newprocedure;
          gen_main_procsym('main',potype_proginit,st);
+{$ifdef fixLeaksOnError}
+         new(names,init);
+         strContStack.push(names);
+         names^.insert('program_init');
+         names^.insert('PASCALMAIN');
+         names^.insert(target_os.cprefix+'main');
+ {$ifdef m68k}
+         if target_info.target=target_m68k_PalmOS then
+           names^.insert('PilotMain');
+ {$endif m68k}
+         compile_proc_body(names^,true,false);
+         if names <> PstringContainer(strContStack.pop) then
+           writeln('Problem with strContStack in pmodules (1)');
+         dispose(names,done);
+{$else fixLeaksOnError}
          names.init;
          names.insert('program_init');
          names.insert('PASCALMAIN');
          names.insert(target_os.cprefix+'main');
-{$ifdef m68k}
+ {$ifdef m68k}
          if target_info.target=target_m68k_PalmOS then
            names.insert('PilotMain');
-{$endif}
+ {$endif m68k}
          compile_proc_body(names,true,false);
          names.done;
+{$endif fixLeaksOnError}
 
          { avoid self recursive destructor call !! PM }
          aktprocsym^.definition^.localst:=nil;
@@ -1471,11 +1516,22 @@ unit pmodules;
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
+{$ifdef fixLeaksOnError}
+              new(names,init);
+              strContStack.push(names);
+              names^.insert('FINALIZE$$'+current_module^.modulename^);
+              names^.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
+              compile_proc_body(names^,true,false);
+              if names <> PstringContainer(strContStack.pop) then
+                writeln('Problem with strContStack in pmodules (1)');
+              dispose(names,done);
+{$else fixLeaksOnError}
               names.init;
               names.insert('FINALIZE$$'+current_module^.modulename^);
               names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
               compile_proc_body(names,true,false);
               names.done;
+{$endif fixLeaksOnError}
               codegen_doneprocedure;
            end;
 
@@ -1561,7 +1617,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.179  2000-01-11 09:52:07  peter
+  Revision 1.180  2000-01-11 17:16:05  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.179  2000/01/11 09:52:07  peter
     * fixed placing of .sl directories
     * use -b again for base-file selection
     * fixed group writing for linux with smartlinking

compiler/psub.pas

@@ -45,7 +45,6 @@ procedure parse_var_proc_directives(var sym : psym);
 procedure parse_object_proc_directives(var sym : pprocsym);
 procedure read_proc;
 
-
 implementation
 
 uses
@@ -1797,6 +1796,9 @@ begin
    oldprocinfo:=procinfo;
 { create a new procedure }
    new(names,init);
+{$ifdef fixLeaksOnError}
+   strContStack.push(names);
+{$endif fixLeaksOnError}
    codegen_newprocedure;
    with procinfo^ do
     begin
@@ -1908,6 +1910,10 @@ begin
        consume(_SEMICOLON);
      end;
 { close }
+{$ifdef fixLeaksOnError}
+   if names <> strContStack.pop then
+     writeln('problem with strContStack in psub!');
+{$endif fixLeaksOnError}
    dispose(names,done);
    codegen_doneprocedure;
 { Restore old state }
@@ -1933,7 +1939,11 @@ end.
 
 {
   $Log$
-  Revision 1.40  2000-01-07 01:14:31  peter
+  Revision 1.41  2000-01-11 17:16:06  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.40  2000/01/07 01:14:31  peter
     * updated copyright to 2000
 
   Revision 1.39  1999/12/22 01:01:52  peter

compiler/ptype.pas

@@ -333,6 +333,9 @@ uses
                          end
                        else varspez:=vs_value;
                        sc:=idlist;
+{$ifdef fixLeaksOnError}
+                       strContStack.push(sc);
+{$endif fixLeaksOnError}
                        if token=_COLON then
                          begin
                             consume(_COLON);
@@ -367,6 +370,10 @@ uses
                          hp2^.paratype:=tt;
                          propertyparas^.insert(hp2);
                        until false;
+{$ifdef fixLeaksOnError}
+                       if strContStack.pop <> sc then
+                         writeln('problem with strContStack in ptype');
+{$endif fixLeaksOnError}
                        dispose(sc,done);
                      until not try_to_consume(_SEMICOLON);
                      dec(testcurobject);
@@ -1510,7 +1517,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.13  2000-01-07 01:14:34  peter
+  Revision 1.14  2000-01-11 17:16:06  jonas
+    * removed a lot of memory leaks when an error is encountered (caused by
+      procinfo and pstringcontainers). There are still plenty left though :)
+
+  Revision 1.13  2000/01/07 01:14:34  peter
     * updated copyright to 2000
 
   Revision 1.12  1999/11/30 10:40:52  peter