diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 569de4c79a..3472916ffd 100644 --- a/compiler/cobjects.pas +++ b/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 diff --git a/compiler/compiler.pas b/compiler/compiler.pas index 4bbe986097..33a24500a8 100644 --- a/compiler/compiler.pas +++ b/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) diff --git a/compiler/hcodegen.pas b/compiler/hcodegen.pas index 5b608ae697..3634ad6a71 100644 --- a/compiler/hcodegen.pas +++ b/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 diff --git a/compiler/pbase.pas b/compiler/pbase.pas index 35a0725198..8b9cfd1fd6 100644 --- a/compiler/pbase.pas +++ b/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 diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 81a5b8da9e..eddbb6fb31 100644 --- a/compiler/pdecl.pas +++ b/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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index e9a847b4fa..d45a4e9a3e 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/psub.pas b/compiler/psub.pas index a074eadaa2..2d9a29acfd 100644 --- a/compiler/psub.pas +++ b/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 diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 19fa2f0787..320e984ca4 100644 --- a/compiler/ptype.pas +++ b/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