+ added two level of longjump to

allow clean freeing of used memory on errors

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

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)
 

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

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