* current_module old scanner tagged as invalid if unit is recompiled

  + added ppheap for better info on tracegetmem of heaptrc
    (adds line column and file index)
  * several memory leaks removed ith help of heaptrc !!

compiler/aasm.pas

@@ -602,7 +602,8 @@ uses
     destructor tai_label.done;
 
       begin
-         if (l^.is_used) then
+         if (l^.refcount>0) then
+         { can now be disposed by a tai_labeled instruction !! }
            l^.is_set:=false
          else
            dispose(l);
@@ -795,8 +796,10 @@ uses
               lab2str:=target_asm.labelprefix+tostr(l^.nb);
            end;
          { inside the WriteTree we must not count the refs PM }
+{$ifndef HEAPTRC}
          if countlabelref then
            inc(l^.refcount);
+{$endif HEAPTRC}
          l^.is_used:=true;
       end;
 
@@ -875,7 +878,13 @@ uses
 end.
 {
   $Log$
-  Revision 1.20  1998-10-06 17:16:31  pierre
+  Revision 1.21  1998-10-08 17:17:07  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.20  1998/10/06 17:16:31  pierre
     * some memory leaks fixed (thanks to Peter for heaptrc !)
 
   Revision 1.19  1998/10/01 20:19:11  jonas

compiler/browser.pas

@@ -353,7 +353,7 @@ implementation
                 begin
                    if hp^.modulename^=upper(ss) then
                      begin
-                        symt:=hp^.symtable;
+                        symt:=hp^.globalsymtable;
                         break;
                      end;
                    hp:=pmodule(hp^.next);
@@ -476,7 +476,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  1998-09-28 16:57:12  pierre
+  Revision 1.11  1998-10-08 17:17:09  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.10  1998/09/28 16:57:12  pierre
     * changed all length(p^.value_str^) into str_length(p)
       to get it work with and without ansistrings
     * changed sourcefiles field of tmodule to a pointer

compiler/cg386add.pas

@@ -170,6 +170,7 @@ implementation
                     ungetiftemp(p^.left^.location.reference);
 
                     { does not hurt: }
+                    clear_location(p^.left^.location);
                     p^.left^.location.loc:=LOC_MEM;
                     p^.left^.location.reference:=href;
                  end;
@@ -602,6 +603,7 @@ implementation
                                         hregister:=getregister32;
                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
                                           newreference(p^.left^.location.reference),hregister)));
+                                        clear_location(p^.left^.location);
                                         p^.left^.location.loc:=LOC_REGISTER;
                                         p^.left^.location.register:=hregister;
                                         set_location(p^.location,p^.left^.location);
@@ -612,6 +614,7 @@ implementation
                                         hregister:=getregister32;
                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
                                           newreference(p^.right^.location.reference),hregister)));
+                                        clear_location(p^.right^.location);
                                         p^.right^.location.loc:=LOC_REGISTER;
                                         p^.right^.location.register:=hregister;
                                       end;
@@ -735,6 +738,7 @@ implementation
                                     newreference(p^.left^.location.reference),hregister)));
                                end;
                           end;
+                        clear_location(p^.location);
                         p^.location.loc:=LOC_REGISTER;
                         p^.location.register:=hregister;
                      end
@@ -934,6 +938,7 @@ implementation
                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(p^.location.reference),
                                hregister)));
                           end;
+                        clear_location(p^.left^.location);
                         p^.location.loc:=LOC_REGISTER;
                         p^.location.register:=hregister;
                      end;
@@ -1066,6 +1071,7 @@ implementation
                                 gten : flags:=F_AE;
                           end;
                         end;
+                       clear_location(p^.left^.location);
                        p^.location.loc:=LOC_FLAGS;
                        p^.location.resflags:=flags;
                        cmpop:=false;
@@ -1278,7 +1284,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  1998-09-28 16:57:13  pierre
+  Revision 1.15  1998-10-08 17:17:10  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.14  1998/09/28 16:57:13  pierre
     * changed all length(p^.value_str^) into str_length(p)
       to get it work with and without ansistrings
     * changed sourcefiles field of tmodule to a pointer

compiler/cg386cnv.pas

@@ -384,6 +384,7 @@ implementation
                  else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
                     newreference(p^.left^.location.reference),hregister)));
              end;
+           clear_location(p^.location);
            p^.location.loc:=LOC_REGISTER;
            p^.location.register:=hregister;
            maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
@@ -545,6 +546,7 @@ implementation
     procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
 
       begin
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.register:=getregister32;
          inc(p^.left^.location.reference.offset);
@@ -562,6 +564,7 @@ implementation
 
       begin
          del_reference(p^.left^.location.reference);
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.register:=getregister32;
          exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
@@ -571,6 +574,7 @@ implementation
     procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
 
       begin
+         clear_location(p^.location);
          p^.location.loc:=LOC_REFERENCE;
          clear_reference(p^.location.reference);
          if p^.left^.location.loc=LOC_REGISTER then
@@ -603,6 +607,7 @@ implementation
       begin
          { this is a type conversion which copies the data, so we can't }
          { return a reference                                             }
+         clear_location(p^.location);
          p^.location.loc:=LOC_MEM;
 
          { first get the memory for the string }
@@ -641,6 +646,9 @@ implementation
          p^.left:=p;
          loadstring(p);
          p^.left:=nil; { reset left tree, which is empty }
+         { p^.right is not disposed for typeconv !! PM }
+         disposetree(p^.right);
+         p^.right:=nil;
       end;
 
     procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
@@ -694,6 +702,7 @@ implementation
          else
            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
 
+         clear_location(p^.location);
          p^.location.loc:=LOC_FPU;
       end;
 
@@ -732,6 +741,7 @@ implementation
          { better than an add on all processors }
          exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
 
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.register:=rreg;
       end;
@@ -750,6 +760,7 @@ implementation
                  del_reference(p^.left^.location.reference);
               end;
          end;
+         clear_location(p^.location);
          p^.location.loc:=LOC_FPU;
       end;
 
@@ -827,6 +838,7 @@ implementation
          if popeax then
            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
 
+         clear_location(p^.location);
          p^.location.loc:=LOC_FPU;
       end;
 
@@ -861,6 +873,7 @@ implementation
            end;
          exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
 
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.register:=hregister;
       end;
@@ -868,7 +881,8 @@ implementation
 
      procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
 
-     begin
+       begin
+          clear_location(p^.location);
           p^.location.loc:=LOC_REGISTER;
           del_reference(hp^.location.reference);
           p^.location.register:=getregister32;
@@ -890,6 +904,7 @@ implementation
          getlabel(truelabel);
          getlabel(falselabel);
          secondpass(hp);
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          del_reference(hp^.location.reference);
          case hp^.resulttype^.size of
@@ -994,6 +1009,7 @@ implementation
      var
         hregister : tregister;
      begin
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          del_reference(hp^.location.reference);
          case hp^.location.loc of
@@ -1042,8 +1058,8 @@ implementation
         emitcall('FPC_SET_LOAD_SMALL',true);
         maybe_loadesi;
         popusedregisters(pushedregs);
+        clear_location(p^.location);
         p^.location.loc:=LOC_MEM;
-        stringdispose(p^.location.reference.symbol);
         p^.location.reference:=href;
       end;
 
@@ -1054,6 +1070,7 @@ implementation
          hr : preference;
 
       begin
+         clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          getlabel(l1);
          getlabel(l2);
@@ -1137,6 +1154,7 @@ implementation
              end;
          else
           begin
+            clear_location(p^.location);
             p^.location.loc:=LOC_REGISTER;
             internalerror(12121);
           end;
@@ -1216,6 +1234,7 @@ implementation
          { save all used registers }
          pushusedregisters(pushed,$ff);
          secondpass(p^.left);
+         clear_location(p^.location);
          p^.location.loc:=LOC_FLAGS;
          p^.location.resflags:=F_NE;
 
@@ -1312,7 +1331,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  1998-10-06 17:16:40  pierre
+  Revision 1.28  1998-10-08 17:17:11  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.27  1998/10/06 17:16:40  pierre
     * some memory leaks fixed (thanks to Peter for heaptrc !)
 
   Revision 1.26  1998/10/02 07:20:35  florian

compiler/cg386inl.pas

@@ -446,6 +446,8 @@ implementation
              exit;
 
            dummycoll.paratyp:=vs_const;
+           disposetree(p^.left);
+           p^.left:=nil;
            { second arg }
            hp:=node;
            node:=node^.right;
@@ -460,6 +462,7 @@ implementation
                   );
                 if codegenerror then
                   exit;
+                disposetree(hp);
                 hp:=node;
                 node:=node^.right;
                 hp^.right:=nil;
@@ -478,6 +481,7 @@ implementation
                   );
                 if codegenerror then
                   exit;
+                disposetree(hp);
                 hp:=node;
                 node:=node^.right;
                 hp^.right:=nil;
@@ -492,6 +496,8 @@ implementation
            secondcallparan(hp,@dummycoll,false
              ,false,0
              );
+           disposetree(hp);
+             
            if codegenerror then
              exit;
 
@@ -933,7 +939,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  1998-10-05 21:33:15  peter
+  Revision 1.12  1998-10-08 17:17:12  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.11  1998/10/05 21:33:15  peter
     * fixed 161,165,166,167,168
 
   Revision 1.10  1998/10/05 12:32:44  peter

compiler/cg386set.pas

@@ -85,7 +85,7 @@ implementation
          opsize     : topsize;
          setparts   : array[1..8] of Tsetpart;
          i,numparts : byte;
-         href,href2 : Treference;
+         {href,href2 : Treference;}
          l,l2       : plabel;
 
          function analizeset(Aset:pconstset;is_small:boolean):boolean;
@@ -209,18 +209,19 @@ implementation
             else
               p^.location.resflags:=F_E;
 
-            reset_reference(href);
+            {reset_reference(href);}
             getlabel(l);
-            href.symbol:=stringdup(lab2str(l));
+            {href.symbol:=stringdup(lab2str(l));}
 
             for i:=1 to numparts do
              if setparts[i].range then
               begin
                 { Check if left is in a range }
                 { Get a label to jump over the check }
-                reset_reference(href2);
+                {reset_reference(href2);}
                 getlabel(l2);
-                href.symbol:=stringdup(lab2str(l2));
+                {shouldn't it be href2 here ??
+                href.symbol:=stringdup(lab2str(l2));}
                 if setparts[i].start=setparts[i].stop-1 then
                  begin
                    case p^.left^.location.loc of
@@ -784,7 +785,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  1998-09-17 09:42:20  peter
+  Revision 1.18  1998-10-08 17:17:14  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.17  1998/09/17 09:42:20  peter
     + pass_2 for cg386
     * Message() -> CGMessage() for pass_1/pass_2
 

compiler/cg68kadd.pas

@@ -265,6 +265,7 @@ implementation
                                 ungetiftemp(p^.left^.location.reference);
 
                                 { does not hurt: }
+                                clear_location(p^.left^.location);
                                 p^.left^.location.loc:=LOC_MEM;
                                 p^.left^.location.reference:=href;
                              end;
@@ -1263,7 +1264,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1998-09-28 16:57:16  pierre
+  Revision 1.7  1998-10-08 17:17:15  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.6  1998/09/28 16:57:16  pierre
     * changed all length(p^.value_str^) into str_length(p)
       to get it work with and without ansistrings
     * changed sourcefiles field of tmodule to a pointer

compiler/compiler.pas

@@ -162,11 +162,15 @@ var
   olddo_stop : tstopprocedure;
 {$endif}
 {$IfDef Extdebug}
-  EntryMemAvail : longint;
+{$ifdef FPC}
+  EntryMemUsed : longint;
+{$endif FPC}
 {$EndIf}
 begin
 {$ifdef EXTDEBUG}
-  EntryMemAvail:=MemAvail;
+{$ifdef FPC}
+  EntryMemUsed:=system.HeapSize-MemAvail;
+{$endif FPC}
 {$endif}
 
 { Initialize the compiler }
@@ -207,7 +211,9 @@ begin
   do_stop:=olddo_stop;
 {$endif USEEXCEPT}
 {$ifdef EXTDEBUG}
-  Comment(V_Info,'Memory Lost = '+tostr(EntryMemAvail-MemAvail));
+{$ifdef FPC}
+  Comment(V_Info,'Memory Lost = '+tostr(system.HeapSize-MemAvail+EntryMemUsed));
+{$endif FPC}
   Comment(V_Info,'Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
 {$endif EXTDEBUG}
 
@@ -224,7 +230,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  1998-10-06 17:16:46  pierre
+  Revision 1.10  1998-10-08 17:17:18  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.9  1998/10/06 17:16:46  pierre
     * some memory leaks fixed (thanks to Peter for heaptrc !)
 
   Revision 1.8  1998/09/01 09:00:27  peter

compiler/files.pas

@@ -102,10 +102,19 @@ unit files;
 
 
     type
+{$ifndef NEWMAP}
        tunitmap = array[0..maxunits-1] of pointer;
        punitmap = ^tunitmap;
 
        pmodule = ^tmodule;
+
+{$else NEWMAP}
+       pmodule = ^tmodule;
+
+       tunitmap = array[0..maxunits-1] of pmodule;
+       punitmap = ^tunitmap;
+{$endif NEWMAP}
+
        tmodule = object(tlinkedlist_item)
           ppufile       : pppufile; { the PPU file }
           crc,
@@ -186,7 +195,7 @@ unit files;
   implementation
 
   uses
-    dos,verbose,systems
+    dos,verbose,systems,scanner
 {$ifndef VER0_99_8}
     ,symtable
 {$endif}
@@ -228,6 +237,8 @@ unit files;
 
     destructor tinputfile.done;
       begin
+        if not closed then
+         close;
         stringdispose(path);
         stringdispose(name);
       { free memory }
@@ -307,6 +318,7 @@ unit files;
         if is_macro then
          begin
            Freemem(buf,maxbufsize);
+           buf:=nil;
            is_macro:=false;
            closed:=true;
            exit;
@@ -317,10 +329,13 @@ unit files;
             system.close(f);
            {$I+}
            i:=ioresult;
-           Freemem(buf,maxbufsize);
            closed:=true;
          end;
-        buf:=nil;
+        if assigned(buf) then
+          begin
+             Freemem(buf,maxbufsize);
+             buf:=nil;
+          end;
         bufstart:=0;
       end;
 
@@ -492,6 +507,11 @@ unit files;
          f^.ref_next:=files;
          f^.ref_index:=last_ref_index;
          files:=f;
+{$ifdef FPC}
+{$ifdef heaptrc}
+         writeln(stderr,f^.name^,' index ',current_module^.unit_index*100000+f^.ref_index);
+{$endif heaptrc}
+{$endif FPC}
       end;
 
 
@@ -779,6 +799,8 @@ unit files;
 
     procedure tmodule.reset;
       begin
+        if assigned(scanner) then
+          pscannerfile(scanner)^.invalid:=true;
 {$ifndef VER0_99_8}
         if assigned(globalsymtable) then
           begin
@@ -816,7 +838,8 @@ unit files;
         uses_imports:=false;
         do_assemble:=false;
         do_compile:=false;
-        sources_avail:=true;
+        { sources_avail:=true;
+        should not be changed PM }
         compiled:=false;
         in_implementation:=false;
         in_global:=true;
@@ -904,6 +927,8 @@ unit files;
          dispose(ppufile,done);
         if assigned(imports) then
          dispose(imports,done);
+        if assigned(scanner) then
+          pscannerfile(scanner)^.invalid:=true;
         if assigned(sourcefiles) then
          dispose(sourcefiles,done);
         used_units.done;
@@ -969,7 +994,13 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.53  1998-10-08 13:48:43  peter
+  Revision 1.54  1998-10-08 17:17:19  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.53  1998/10/08 13:48:43  peter
     * fixed memory leaks for do nothing source
     * fixed unit interdependency
 

compiler/i386.pas

@@ -315,6 +315,7 @@ unit i386;
     procedure clear_reference(var ref : treference);
 
     function newreference(const r : treference) : preference;
+    procedure disposereference(var r : preference);
 
     function reg2str(r : tregister) : string;
 
@@ -1069,6 +1070,15 @@ unit i386;
       end;
 
 
+    procedure disposereference(var r : preference);
+
+      begin
+         if assigned(r^.symbol) then
+           stringdispose(r^.symbol);
+         dispose(r);
+         r:=nil;
+      end;
+      
     function newreference(const r : treference) : preference;
       var
          p : preference;
@@ -1253,6 +1263,7 @@ unit i386;
            begin
               opxt:=top_const;
               op1:=pointer(_op1^.offset);
+              disposereference(_op1);
            end
          else
            begin
@@ -1317,6 +1328,7 @@ unit i386;
            begin
               opxt:=opxt+top_const shl 4;
               op2:=pointer(_op2^.offset);
+              disposereference(_op2);
            end
          else
            begin
@@ -1455,6 +1467,7 @@ unit i386;
            begin
               opxt:=opxt+top_const shl 4;
               op2:=pointer(_op2^.offset);
+              disposereference(_op2);
            end
          else
            begin
@@ -1507,6 +1520,7 @@ unit i386;
            begin
               opxt:=opxt+top_const;
               op1:=pointer(_op1^.offset);
+              disposereference(_op1);
            end
          else
            begin
@@ -1528,6 +1542,7 @@ unit i386;
            begin
               opxt:=top_const;
               op1:=pointer(_op1^.offset);
+              disposereference(_op1);
            end
          else
            begin
@@ -1539,6 +1554,7 @@ unit i386;
            begin
               opxt:=opxt+top_const shl 4;
               op2:=pointer(_op2^.offset);
+              disposereference(_op2);
            end
          else
            begin
@@ -1589,6 +1605,7 @@ unit i386;
            begin
               opxt:=opxt+top_const shl 4;
               op2:=pointer(_op2^.offset);
+              disposereference(_op2);
            end
          else
            begin
@@ -1707,7 +1724,13 @@ unit i386;
 end.
 {
   $Log$
-  Revision 1.11  1998-09-20 17:11:23  jonas
+  Revision 1.12  1998-10-08 17:17:20  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.11  1998/09/20 17:11:23  jonas
     * released REGALLOC
 
   Revision 1.10  1998/09/14 21:30:45  peter

compiler/parser.pas

@@ -41,7 +41,7 @@ unit parser;
 {$ifdef UseBrowser}
       browser,
 {$endif UseBrowser}
-      scanner,pbase,pdecl,psystem,pmodules;
+      tree,scanner,pbase,pdecl,psystem,pmodules;
 
 
     procedure initparser;
@@ -111,7 +111,8 @@ unit parser;
          oldpattern,
          oldorgpattern  : string;
          old_block_type : tblock_type;
-         oldcurrent_scanner : pscannerfile;
+         oldcurrent_scanner,prev_scanner,
+         scanner : pscannerfile;
        { symtable }
          oldmacros,
          oldrefsymtable,
@@ -210,7 +211,12 @@ unit parser;
 
        { reset the unit or create a new program }
          if assigned(current_module) then
-          current_module^.reset
+           begin
+              {current_module^.reset this is wrong !! }
+               scanner:=current_module^.scanner;
+               current_module^.reset;
+               current_module^.scanner:=scanner;
+           end
          else
           begin
             current_module:=new(pmodule,init(filename,false));
@@ -233,6 +239,7 @@ unit parser;
        { startup scanner, and save in current_module }
          current_scanner:=new(pscannerfile,Init(filename));
          current_scanner^.readtoken;
+         prev_scanner:=current_module^.scanner;
          current_module^.scanner:=current_scanner;
 
        { init code generator for a new module }
@@ -284,6 +291,15 @@ unit parser;
             dispose(current_module^.ppufile,done);
             current_module^.ppufile:=nil;
           end;
+       { free scanner }
+         dispose(current_scanner,done);
+       { restore previous scanner !! }
+         current_module^.scanner:=prev_scanner;
+         if assigned(prev_scanner) then
+           prev_scanner^.invalid:=true;
+(* Peter I do not agree here because
+   most time current_scanner is from another unit !! PM
+          end;
 
        { free scanner, but it can already be freed due a 2nd compile }
          if assigned(current_scanner) then
@@ -292,7 +308,7 @@ unit parser;
             current_scanner:=nil;
           end;
          current_module^.scanner:=nil;
-
+ *)
        { free macros }
 {!!! No check for unused macros yet !!! }
          dispose(macros,done);
@@ -366,6 +382,16 @@ unit parser;
               else
                 Browse.list_elements;
 {$endif UseBrowser}
+            if assigned(aktprocsym) then
+              begin
+                 if (aktprocsym^.owner=nil) then
+                   begin
+                      { init parts are not needed in units !! }
+                      if current_module^.is_unit then
+                        aktprocsym^.definition^.forwarddef:=false;
+                      dispose(aktprocsym,done);
+                   end;
+              end;
           end;
 
          dec(compile_level);
@@ -374,7 +400,13 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.56  1998-10-08 13:48:45  peter
+  Revision 1.57  1998-10-08 17:17:23  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.56  1998/10/08 13:48:45  peter
     * fixed memory leaks for do nothing source
     * fixed unit interdependency
 

compiler/pmodules.pas

@@ -1,3 +1,4 @@
+
 {
     $Id$
     Copyright (c) 1998 by Florian Klaempfl
@@ -182,6 +183,9 @@ unit pmodules;
       { init the map }
         new(current_module^.map);
         fillchar(current_module^.map^,sizeof(tunitmap),#0);
+{$ifdef NEWMAP}
+        current_module^.map^[0]:=current_module;
+{$endif NEWMAP}
         nextmapentry:=1;
       { load the used units from interface }
         current_module^.in_implementation:=false;
@@ -206,7 +210,11 @@ unit pmodules;
                  exit;
                end;
             { setup the map entry for deref }
+{$ifndef NEWMAP}
               current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
+{$else NEWMAP}
+              current_module^.map^[nextmapentry]:=loaded_unit;
+{$endif NEWMAP}
               inc(nextmapentry);
               if nextmapentry>maxunits then
                Message(unit_f_too_much_units);
@@ -248,7 +256,11 @@ unit pmodules;
                end;
 {$endif TEST_IMPL}
             { setup the map entry for deref }
+{$ifndef NEWMAP}
               current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
+{$else NEWMAP}
+              current_module^.map^[nextmapentry]:=loaded_unit;
+{$endif NEWMAP}
               inc(nextmapentry);
               if nextmapentry>maxunits then
                Message(unit_f_too_much_units);
@@ -257,13 +269,13 @@ unit pmodules;
          end;
 {$ifdef UseBrowser}
         if cs_browser in aktmoduleswitches then
-          punitsymtable(current_module^.symtable)^.load_symtable_refs;
+          punitsymtable(current_module^.globalsymtable)^.load_symtable_refs;
         if ((current_module^.flags and uf_has_browser)<>0) and
            (cs_local_browser in aktmoduleswitches) then
          begin
            current_module^.implsymtable:=new(psymtable,load);
            psymtable(current_module^.implsymtable)^.name:=
-              stringdup('implementation of '+psymtable(current_module^.symtable)^.name^);
+              stringdup('implementation of '+psymtable(current_module^.globalsymtable)^.name^);
            psymtable(current_module^.implsymtable)^.load_browser;
          end;
 {$endif UseBrowser}
@@ -280,6 +292,9 @@ unit pmodules;
         st : punitsymtable;
         old_current_ppu : pppufile;
         old_current_module,hp,hp2 : pmodule;
+        name : string;{ necessary because
+        current_module^.mainsource^ is reset in compile !! }
+        scanner : pscannerfile;
 
         procedure loadppufile;
         begin
@@ -299,16 +314,33 @@ unit pmodules;
                 current_module^.ppufile:=nil;
               end;
            { recompile the unit or give a fatal error if sources not available }
+             if not(current_module^.sources_avail) then
+               if (not current_module^.search_unit(current_module^.modulename^))
+                  and (length(current_module^.modulename^)>8) then
+                 current_module^.search_unit(copy(current_module^.modulename^,1,8));
              if not(current_module^.sources_avail) then
               Message1(unit_f_cant_compile_unit,current_module^.modulename^)
              else
               begin
+                if current_module^.in_second_compile then
+                  Message1(parser_d_compiling_second_time,current_module^.modulename^);
+                current_scanner^.tempcloseinputfile;
+                name:=current_module^.mainsource^;
+                if assigned(scanner) then
+                  scanner^.invalid:=true;
+                compile(name,compile_system);
+                if (not current_scanner^.invalid) then
+                 current_scanner^.tempopeninputfile;
+(*
                 if assigned(old_current_module^.scanner) then
                  begin
                    current_scanner^.tempcloseinputfile;
                    current_scanner:=nil;
                    { the current_scanner is always the same
                      as current_module^.scanner (PFV) }
+                     NO !!! unless you changed the code
+                     because it is only change in compile
+                     whereas current_module is changed here !!
                  end;
                 compile(current_module^.mainsource^,compile_system);
                 if (not old_current_module^.compiled) and
@@ -316,7 +348,7 @@ unit pmodules;
                  begin
                    current_scanner:=old_current_module^.scanner;
                    current_scanner^.tempopeninputfile;
-                 end;
+                 end; *)
               end;
            end
           else
@@ -386,14 +418,19 @@ unit pmodules;
              begin
                { remove the old unit }
                loaded_units.remove(hp);
+               scanner:=hp^.scanner;
                hp^.reset;
+               hp^.scanner:=scanner;
                current_module:=hp;
                current_module^.in_second_compile:=true;
                current_module^.do_compile:=true;
              end
             else
           { generates a new unit info record }
-             current_module:=new(pmodule,init(s,true));
+             begin
+                current_module:=new(pmodule,init(s,true));
+                scanner:=nil;
+             end;
             current_ppu:=current_module^.ppufile;
           { now we can register the unit }
             current_module^.loaded_from:=old_current_module;
@@ -680,7 +717,11 @@ unit pmodules;
                    loadunits;
                    { has it been compiled at a higher level ?}
                    if current_module^.compiled then
-                     exit;
+                     begin
+                        { this unit symtable is obsolete }
+                        dispose(unitst,done);
+                        exit;
+                     end;
                    unitst^.symtabletype:=globalsymtable;
                 end;
               { ... but insert the symbol table later }
@@ -740,6 +781,19 @@ unit pmodules;
          { Read the implementation units }
          parse_implementation_uses(unitst);
 
+         
+         if current_module^.compiled then
+           begin
+              { this unit symtable is obsolete }
+              dispose(unitst,done);
+              { avoid self recursive destructor call !! PM }
+              aktprocsym^.definition^.localst:=nil;
+              { absence does not matter here !! }
+              aktprocsym^.definition^.forwarddef:=false;
+              dispose(st,done);
+              exit;
+           end;
+           
          { All units are read, now give them a number }
          numberunits;
 
@@ -806,6 +860,10 @@ unit pmodules;
          { the last char should always be a point }
          consume(POINT);
 
+         { avoid self recursive destructor call !! PM }
+         aktprocsym^.definition^.localst:=nil;
+         { absence does not matter here !! }
+         aktprocsym^.definition^.forwarddef:=false;
          { test static symtable }
          st^.allsymbolsused;
 
@@ -833,7 +891,9 @@ unit pmodules;
              dellexlevel; }
 
          { remove static symtable here to save some mem ;) }
+{$ifndef UseBrowser}
          dispose(st,done);
+{$endif UseBrowser}
          current_module^.localsymtable:=nil;
 
          { tests, if all (interface) forwards are resolved }
@@ -882,6 +942,9 @@ unit pmodules;
          if current_module^.uses_imports then
           importlib^.generatelib;
 
+{$ifndef UseBrowser}
+         dispose(refsymtable,done);
+{$endif UseBrowser}
          { finish asmlist by adding segment starts }
          insertsegment;
 
@@ -974,11 +1037,12 @@ unit pmodules;
 {$endif}
          compile_proc_body(names,true,false);
          names.done;
-         codegen_doneprocedure;
 
          { avoid self recursive destructor call !! PM }
          aktprocsym^.definition^.localst:=nil;
 
+         codegen_doneprocedure;
+
          { consume the last point }
          consume(POINT);
 
@@ -1022,7 +1086,13 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.61  1998-10-08 13:48:47  peter
+  Revision 1.62  1998-10-08 17:17:25  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.61  1998/10/08 13:48:47  peter
     * fixed memory leaks for do nothing source
     * fixed unit interdependency
 

compiler/pp.pas

@@ -107,9 +107,11 @@ uses
 {$ifdef profile}
   profile,
 {$endif profile}
+{$ifdef FPC}
 {$ifdef heaptrc}
-  heaptrc,
+  ppheap,
 {$endif heaptrc}
+{$endif FPC}
   globals,compiler;
 
 {$ifdef useoverlay}
@@ -259,7 +261,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  1998-10-02 17:03:51  peter
+  Revision 1.33  1998-10-08 17:17:26  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.32  1998/10/02 17:03:51  peter
     * ifdef heaptrc for heaptrc
 
   Revision 1.31  1998/09/28 16:57:23  pierre

compiler/ppheap.pas

@@ -0,0 +1,45 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by FPC development team
+
+    Simple unit to add source line and column to each
+    memory allocation made with heaptrc unit
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+unit ppheap;
+
+  interface
+
+    uses heaptrc;
+
+  implementation
+
+    uses
+       globals,files;
+       
+    procedure ppextra_info(p : pointer);
+      begin
+         longint(p^):=aktfilepos.line;
+         plongint(cardinal(p)+4)^:=aktfilepos.column;
+         plongint(cardinal(p)+8)^:=current_module^.unit_index*100000+aktfilepos.fileindex;
+      end;
+      
+  begin
+     set_extra_info(12,ppextra_info);
+  end.
+  
+

compiler/scandir.inc

@@ -695,9 +695,15 @@ const
       end;
 
     procedure dir_wait(t:tdirectivetoken);
+      var had_info : boolean;
       begin
+        had_info:=(status.verbosity and V_Info)<>0;
+        { this message should allways appear !! }
+        status.verbosity:=status.verbosity or V_Info;
         Message(scan_i_press_enter);
         readln;
+        If not(had_info) then
+          status.verbosity:=status.verbosity and (not V_Info);
       end;
 
 
@@ -938,7 +944,13 @@ const
 
 {
   $Log$
-  Revision 1.35  1998-10-08 13:44:39  peter
+  Revision 1.36  1998-10-08 17:17:29  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.35  1998/10/08 13:44:39  peter
     * fixed $I %date% not in uppercase
 
   Revision 1.34  1998/09/28 16:57:24  pierre

compiler/scanner.pas

@@ -72,6 +72,7 @@ unit scanner;
           yylexcount     : longint;
           lastasmgetchar : char;
           preprocstack   : ppreprocstack;
+          invalid        : boolean; { flag if sourcefiles have been destroyed ! }
 
           constructor init(const fn:string);
           destructor done;
@@ -134,7 +135,10 @@ implementation
     var
       tokenidx:array[2..tokenidlen] of tokenidxrec;
 
-
+    const
+      { use any special name that is an invalid file name to avoid problems }
+      macro_special_name = '__##&&Macro&&##__';
+      
     procedure create_tokenidx;
     { create an index with the first and last token for every possible token
       length, so a search only will be done in that small part }
@@ -216,6 +220,7 @@ implementation
         lasttokenpos:=0;
         lasttoken:=_END;
         lastasmgetchar:=#0;
+        invalid:=false;
       { load block }
         if not openinputfile then
          Message1(scan_f_cannot_open_input,fn);
@@ -225,13 +230,17 @@ implementation
 
     destructor tscannerfile.done;
       begin
-        checkpreprocstack;
-      { close file, but only if we are the first compile }
-        if not current_module^.in_second_compile then
-         begin
-           if not inputfile^.closed then
-            closeinputfile;
-         end;
+        if not invalid then
+          begin
+             checkpreprocstack;
+           { close file, but only if we are the first compile }
+           { probably not necessary anymore with invalid flag PM }
+             if not current_module^.in_second_compile then
+              begin
+                if not inputfile^.closed then
+                 closeinputfile;
+              end;
+          end;
        end;
 
 
@@ -301,10 +310,18 @@ implementation
 
 
     procedure tscannerfile.nextfile;
+      var
+        to_dispose : pinputfile;
       begin
         if assigned(inputfile^.next) then
          begin
+           if inputfile^.is_macro then
+             to_dispose:=inputfile
+           else
+             to_dispose:=nil;
            inputfile:=inputfile^.next;
+           if assigned(to_dispose) then
+             dispose(to_dispose,done);
            restoreinputfile;
          end;
       end;
@@ -383,7 +400,8 @@ implementation
         dec(longint(inputpointer));
         tempcloseinputfile;
       { create macro 'file' }
-        hp:=new(pinputfile,init('Macro'));
+        { use special name to dispose after !! }
+        hp:=new(pinputfile,init(macro_special_name));
         addfile(hp);
         with inputfile^ do
          begin
@@ -1431,7 +1449,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  1998-10-08 13:45:25  peter
+  Revision 1.58  1998-10-08 17:17:30  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.57  1998/10/08 13:45:25  peter
     * EOF position is now correctly saved in aktfilepos
 
   Revision 1.56  1998/09/30 16:43:38  peter

compiler/symsym.inc

@@ -1596,8 +1596,9 @@
           begin
             if definition^.sym=nil then
              definition^.sym:=@self;
-            if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) then
-             precdef(definition)^.symtable^.name:=stringdup('record '+name);
+            if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) and
+               (definition^.sym=@self) then
+              precdef(definition)^.symtable^.name:=stringdup('record '+name);
           end;
       end;
 
@@ -1704,6 +1705,7 @@
     constructor tmacrosym.init(const n : string);
       begin
          inherited init(n);
+         typ:=macrosym;
          defined:=true;
          buftext:=nil;
          buflen:=0;
@@ -1719,7 +1721,13 @@
 
 {
   $Log$
-  Revision 1.51  1998-10-08 13:48:50  peter
+  Revision 1.52  1998-10-08 17:17:32  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.51  1998/10/08 13:48:50  peter
     * fixed memory leaks for do nothing source
     * fixed unit interdependency
 

compiler/symsymh.inc

@@ -29,7 +29,8 @@
        { possible types for symtable entries }
        tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
                   constsym,enumsym,typedconstsym,errorsym,syssym,
-                  labelsym,absolutesym,propertysym,funcretsym);
+                  labelsym,absolutesym,propertysym,funcretsym,
+                  macrosym);
                   { varsym_C,typedconstsym_C); }
 
        { this object is the base for all symbol objects }
@@ -314,7 +315,13 @@
 
 {
   $Log$
-  Revision 1.2  1998-09-24 15:11:18  peter
+  Revision 1.3  1998-10-08 17:17:34  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.2  1998/09/24 15:11:18  peter
     * fixed enum for not GDB
 
   Revision 1.1  1998/09/23 12:03:57  peter

compiler/tree.pas

@@ -276,6 +276,7 @@ unit tree;
     procedure disposetree(p : ptree);
     procedure putnode(p : ptree);
     function getnode : ptree;
+    procedure clear_location(var loc : tlocation);
     procedure set_location(var destloc,sourceloc : tlocation);
     procedure swap_location(var destloc,sourceloc : tlocation);
     procedure set_file_line(from,_to : ptree);
@@ -430,6 +431,8 @@ unit tree;
            deletecaselabels(p^.greater);
          if assigned(p^.less) then
            deletecaselabels(p^.less);
+         freelabel(p^._at);
+         freelabel(p^.statement);
          dispose(p);
       end;
 
@@ -447,6 +450,10 @@ unit tree;
 
     procedure disposetree(p : ptree);
 
+      var
+         symt : psymtable;
+         i : longint;
+         
       begin
          if not(assigned(p)) then
            exit;
@@ -511,8 +518,16 @@ unit tree;
                    disposetree(p^.left);
                  if assigned(p^.right) then
                    disposetree(p^.right);
-                 if assigned(p^.withsymtable) then
-                   dispose(p^.withsymtable,done);
+                 symt:=p^.withsymtable;
+                 for i:=1 to p^.tablecount do
+                   begin
+                      if assigned(symt) then
+                        begin
+                           p^.withsymtable:=symt^.next;
+                           dispose(symt,done);
+                        end;
+                      symt:=p^.withsymtable;
+                   end;
               end;
             else internalerror(12);
          end;
@@ -1511,6 +1526,14 @@ unit tree;
            end;
       end;
 
+    procedure clear_location(var loc : tlocation);
+
+      begin
+        if assigned(loc.reference.symbol) then
+          stringdispose(loc.reference.symbol);
+        loc.loc:=LOC_INVALID;
+      end;
+
     {This is needed if you want to be able to delete the string with the nodes !!}
     procedure set_location(var destloc,sourceloc : tlocation);
 
@@ -1597,7 +1620,13 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.45  1998-10-05 21:33:33  peter
+  Revision 1.46  1998-10-08 17:17:37  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.45  1998/10/05 21:33:33  peter
     * fixed 161,165,166,167,168
 
   Revision 1.44  1998/09/28 16:57:28  pierre

compiler/verbose.pas

@@ -399,6 +399,11 @@ end;
 procedure InitVerbose;
 begin
 { Init }
+{$ifndef EXTERN_MSG}
+  msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
+{$else}
+  LoadMsgFile(exepath+'errore.msg');
+{$endif}
   FillChar(Status,sizeof(TCompilerStatus),0);
   status.verbosity:=V_Default;
   Status.MaxErrorCount:=50;
@@ -410,17 +415,17 @@ begin
    dispose(msg,Done);
 end;
 
-begin
-{$ifndef EXTERN_MSG}
-  msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
-{$else}
-  LoadMsgFile(exepath+'errore.msg');
-{$endif}
 end.
 
 {
   $Log$
-  Revision 1.23  1998-10-06 17:17:01  pierre
+  Revision 1.24  1998-10-08 17:17:39  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.23  1998/10/06 17:17:01  pierre
     * some memory leaks fixed (thanks to Peter for heaptrc !)
 
   Revision 1.22  1998/10/05 13:51:36  peter