+ Added support for ExceptProc+

rtl/inc/except.inc

@@ -117,7 +117,6 @@ begin
 {$ifdef excdebug}
   writeln ('In Popaddrstack');
 {$endif}
-
   If ExceptAddrStack=nil then
     begin
     writeln ('At end of ExceptionAddresStack');
@@ -133,7 +132,6 @@ begin
 {$ifdef excdebug}
   writeln ('In PopObjectstack');
 {$endif}
-
   If ExceptObjectStack=nil then
     begin
     writeln ('At end of ExceptionObjectStack');
@@ -149,12 +147,14 @@ begin
 {$ifdef excdebug}
   writeln ('In reraise');
 {$endif}
-
   PopAddrStack;
   If ExceptAddrStack=Nil then
     begin
-    writeln ('Re-Raise : At end of address chain.');
-    halt (1);
+    If ExceptProc<>Nil then
+      If ExceptObjectStack<>Nil then
+        TExceptPRoc(ExceptProc)(ExceptObjectStack^.FObject,
+                                ExceptObjectStack^.Addr);
+    RunError(217);
     end;
   longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
 end;

rtl/objpas/objpas.pp

@@ -75,9 +75,14 @@ unit objpas;
           function safecallexception(exceptobject : tobject;
             exceptaddr : pointer) : integer;virtual;
        end;
-
+       
+       TExceptProc = Procedure (Obj : TObject; Addr: Pointer);
+       
        var
           abstracterrorproc : pointer;
+       Const
+          ExceptProc : Pointer {TExceptProc} = Nil;
+          
 
   implementation
 
@@ -279,7 +284,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  1998-07-29 15:44:33  michael
+  Revision 1.5  1998-07-30 16:10:11  michael
+  + Added support for ExceptProc+
+
+  Revision 1.4  1998/07/29 15:44:33  michael
    included sysutils and math.pp as target. They compile now.
 
   Revision 1.3  1998/07/29 10:09:28  michael