diff --git a/compiler/comphook.pas b/compiler/comphook.pas index 69e7efcaf3..a8828b142c 100644 --- a/compiler/comphook.pas +++ b/compiler/comphook.pas @@ -89,6 +89,10 @@ const implementation +{$ifdef USEEXCEPT} + uses tpexcept; +{$endif USEEXCEPT} + {**************************************************************************** Helper Routines ****************************************************************************} @@ -126,7 +130,11 @@ end; { predefined handler when then compiler stops } procedure def_stop; begin +{$ifndef USEEXCEPT} Halt(1); +{$else USEEXCEPT} + Halt(1); +{$endif USEEXCEPT} end; @@ -245,7 +253,11 @@ end; end. { $Log$ - Revision 1.8 1998-09-15 10:49:32 pierre + Revision 1.9 1998-10-26 17:15:16 pierre + + added two level of longjump to + allow clean freeing of used memory on errors + + Revision 1.8 1998/09/15 10:49:32 pierre merged from fixes branch Revision 1.7.2.1 1998/09/15 10:30:17 pierre diff --git a/compiler/compiler.pas b/compiler/compiler.pas index 49d332a8cf..912faa1c98 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -94,21 +94,20 @@ uses function Compile(const cmd:string):longint; - implementation var CompilerInited : boolean; -{$ifdef USEEXCEPT} - recoverpos : jmp_buf; -{$endif USEEXCEPT} - {$ifdef USEEXCEPT} + procedure RecoverStop;{$ifndef FPC}far;{$endif} begin - LongJmp(recoverpos,1); + if assigned(recoverpospointer) then + LongJmp(recoverpospointer^,1) + else + Halt(1); end; {$endif USEEXCEPT} @@ -121,11 +120,11 @@ procedure DoneCompiler; begin if not CompilerInited then exit; + CompilerInited:=false; { Free memory } DoneSymtable; DoneGlobals; linker.done; - CompilerInited:=false; doneparser; DoneImport; {$ifdef UseBrowser} @@ -168,6 +167,7 @@ function Compile(const cmd:string):longint; var starttime : real; {$ifdef USEEXCEPT} + recoverpos : jmp_buf; olddo_stop : tstopprocedure; {$endif} {$IfDef Extdebug} @@ -199,10 +199,11 @@ begin {$endif} {$ifdef USEEXCEPT} - olddo_stop:=do_stop; - do_stop:=recoverstop; if setjmp(recoverpos)=0 then begin + olddo_stop:=do_stop; + recoverpospointer:=@recoverpos; + do_stop:=recoverstop; {$endif USEEXCEPT} starttime:=getrealtime; parser.compile(inputdir+inputfile+inputextension,false); @@ -215,7 +216,9 @@ begin { Stop the compiler, frees also memory } DoneCompiler; {$ifdef USEEXCEPT} - end; + end + else + DoneCompiler; { Stop is always called, so we come here when a program is compiled or not } do_stop:=olddo_stop; {$endif USEEXCEPT} @@ -239,7 +242,11 @@ end; end. { $Log$ - Revision 1.12 1998-10-09 16:36:02 pierre + Revision 1.13 1998-10-26 17:15:17 pierre + + added two level of longjump to + allow clean freeing of used memory on errors + + Revision 1.12 1998/10/09 16:36:02 pierre * some memory leaks specific to usebrowser define fixed * removed tmodule.implsymtable (was like tmodule.localsymtable) diff --git a/compiler/parser.pas b/compiler/parser.pas index 151df18a92..3c6e464962 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -25,6 +25,17 @@ {$endif} unit parser; +{ Use exception catching so the compiler goes futher after a Stop } +{$ifdef i386} + {$define USEEXCEPT} +{$endif} + +{$ifdef TP} + {$ifdef DPMI} + {$undef USEEXCEPT} + {$endif} +{$endif} + interface procedure compile(const filename:string;compile_system:boolean); @@ -41,6 +52,9 @@ unit parser; {$ifdef UseBrowser} browser, {$endif UseBrowser} +{$ifdef UseExcept} + tpexcept,compiler, +{$endif UseExcept} tree,scanner,pbase,pdecl,psystem,pmodules; @@ -144,6 +158,10 @@ unit parser; oldaktoptprocessor : tprocessors; oldaktasmmode : tasmmode; +{$ifdef USEEXCEPT} + recoverpos : jmp_buf; + oldrecoverpos : pjmp_buf; +{$endif useexcept} {$ifdef usebrowser} {$ifdef dummydebug} hp : pmodule; @@ -254,6 +272,12 @@ unit parser; { If the compile level > 1 we get a nice "unit expected" error message if we are trying to use a program as unit.} +{$ifdef USEEXCEPT} + if setjmp(recoverpos)=0 then + begin + oldrecoverpos:=recoverpospointer; + recoverpospointer:=@recoverpos; +{$endif USEEXCEPT} if (token=_UNIT) or (compile_level>1) then begin current_module^.is_unit:=true; @@ -262,6 +286,12 @@ unit parser; else proc_program(token=_LIBRARY); +{$ifdef USEEXCEPT} + recoverpospointer:=oldrecoverpos; + end + else + recoverpospointer:=oldrecoverpos; +{$endif USEEXCEPT} { clear memory } {$ifdef Splitheap} if testsplit then @@ -384,7 +414,11 @@ unit parser; end. { $Log$ - Revision 1.58 1998-10-16 08:50:02 peter + Revision 1.59 1998-10-26 17:15:18 pierre + + added two level of longjump to + allow clean freeing of used memory on errors + + Revision 1.58 1998/10/16 08:50:02 peter * reset_gdb_info -> reset_global_def becuase it also resets rangenr ! Revision 1.57 1998/10/08 17:17:23 pierre diff --git a/compiler/tpexcept.pas b/compiler/tpexcept.pas index a91ec4a936..28e9a1cab6 100644 --- a/compiler/tpexcept.pas +++ b/compiler/tpexcept.pas @@ -39,6 +39,8 @@ type {$endif TP} end; + pjmp_buf = ^jmp_buf; + {$ifdef TP} function setjmp(var rec : jmp_buf) : integer; procedure longjmp(const rec : jmp_buf;return_value : integer); @@ -47,6 +49,8 @@ type procedure longjmp(const rec : jmp_buf;return_value : longint); {$endif TP} + var + recoverpospointer : pjmp_buf; implementation @@ -331,7 +335,11 @@ implementation end. { $Log$ - Revision 1.2 1998-08-28 10:57:03 peter + Revision 1.3 1998-10-26 17:15:19 pierre + + added two level of longjump to + allow clean freeing of used memory on errors + + Revision 1.2 1998/08/28 10:57:03 peter * removed warnings Revision 1.1 1998/08/10 10:18:36 peter