diff --git a/compiler/aasm.pas b/compiler/aasm.pas index 8c003ad67b..ebfcb62398 100644 --- a/compiler/aasm.pas +++ b/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 diff --git a/compiler/browser.pas b/compiler/browser.pas index 2546db7f2b..ea22619158 100644 --- a/compiler/browser.pas +++ b/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 diff --git a/compiler/cg386add.pas b/compiler/cg386add.pas index 9165c0b697..cc9dd0a863 100644 --- a/compiler/cg386add.pas +++ b/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 diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index f16dd27be6..cc28e49281 100644 --- a/compiler/cg386cnv.pas +++ b/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 diff --git a/compiler/cg386inl.pas b/compiler/cg386inl.pas index d49b3cec4a..b2a36c3cb7 100644 --- a/compiler/cg386inl.pas +++ b/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 diff --git a/compiler/cg386set.pas b/compiler/cg386set.pas index f794640564..cd924a8796 100644 --- a/compiler/cg386set.pas +++ b/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 diff --git a/compiler/cg68kadd.pas b/compiler/cg68kadd.pas index 0d5e20eda2..8e4fec055f 100644 --- a/compiler/cg68kadd.pas +++ b/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 diff --git a/compiler/compiler.pas b/compiler/compiler.pas index b9da3d21e2..27991c2886 100644 --- a/compiler/compiler.pas +++ b/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 diff --git a/compiler/files.pas b/compiler/files.pas index 622b9700d3..f68eb41b76 100644 --- a/compiler/files.pas +++ b/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 diff --git a/compiler/i386.pas b/compiler/i386.pas index 7a28cc7ca1..5f3e6d44a6 100644 --- a/compiler/i386.pas +++ b/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 diff --git a/compiler/parser.pas b/compiler/parser.pas index ec32128993..ac8f4c2cf3 100644 --- a/compiler/parser.pas +++ b/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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 332ff7af66..cc33848e46 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/pp.pas b/compiler/pp.pas index e580e9d29d..24390023af 100644 --- a/compiler/pp.pas +++ b/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 diff --git a/compiler/ppheap.pas b/compiler/ppheap.pas new file mode 100644 index 0000000000..c33a655c32 --- /dev/null +++ b/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. + + diff --git a/compiler/scandir.inc b/compiler/scandir.inc index cee1f7c45d..c62a54a5b6 100644 --- a/compiler/scandir.inc +++ b/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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 723602cae5..c9d95f974a 100644 --- a/compiler/scanner.pas +++ b/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 diff --git a/compiler/symsym.inc b/compiler/symsym.inc index bf3f25bc84..328b271213 100644 --- a/compiler/symsym.inc +++ b/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 diff --git a/compiler/symsymh.inc b/compiler/symsymh.inc index 24b8e09a2a..a6ab9682c2 100644 --- a/compiler/symsymh.inc +++ b/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 diff --git a/compiler/tree.pas b/compiler/tree.pas index cb10133547..9f26674607 100644 --- a/compiler/tree.pas +++ b/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 diff --git a/compiler/verbose.pas b/compiler/verbose.pas index b1bdf25487..ac47f6a3e0 100644 --- a/compiler/verbose.pas +++ b/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