+ applied patch for ref. counted exceptions by Johannes Berg

rtl/inc/except.inc

@@ -55,6 +55,28 @@ begin
 end;
 {$ENDIF}
 
+function AcquireExceptionObject: Pointer;
+begin
+  If ExceptObjectStack=nil then begin
+    runerror(0); // which error?
+  end else begin
+    Inc(ExceptObjectStack^.refcount);
+    AcquireExceptionObject := ExceptObjectStack^.FObject;
+  end;
+end;
+
+procedure ReleaseExceptionObject;
+begin
+  If ExceptObjectStack=nil then begin
+    runerror(0); // which error?
+  end else begin
+    if ExceptObjectStack^.refcount = 0 then begin
+      runerror(0); // which error?
+    end;
+    Dec(ExceptObjectStack^.refcount);
+  end;
+end;
+
 {$ifndef HAS_ADDR_STACK_ON_STACK}
 Function fpc_PushExceptAddr (Ft: Longint): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
@@ -122,6 +144,7 @@ begin
   ExceptObjectStack^.FObject:=Obj;
   ExceptObjectStack^.Addr:=AnAddr;
   ExceptObjectStack^.Frame:=AFrame;
+  ExceptObjectStack^.refcount := 0;
 end;
 
 {$ifdef hascompilerproc}
@@ -197,7 +220,11 @@ begin
   else
     begin
        { we need to return the exception object to dispose it }
-       fpc_PopObjectStack:=ExceptObjectStack^.FObject;
+       if ExceptObjectStack^.refcount = 0 then begin
+         fpc_PopObjectStack:=ExceptObjectStack^.FObject;
+       end else begin
+         fpc_PopObjectStack:=nil;
+       end;
        hp:=ExceptObjectStack;
        ExceptObjectStack:=ExceptObjectStack^.next;
        dispose(hp);
@@ -236,6 +263,7 @@ begin
 {$endif}
   If ExceptAddrStack=Nil then
     DoUnHandledException;
+  ExceptObjectStack^.refcount := 0;
   longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
 end;
 
@@ -283,7 +311,10 @@ begin
 end;
 {
   $Log$
-  Revision 1.11  2003-09-06 21:56:29  marco
+  Revision 1.12  2003-10-06 15:59:20  florian
+    + applied patch for ref. counted exceptions by Johannes Berg
+
+  Revision 1.11  2003/09/06 21:56:29  marco
    * one VIRTUALPASCAL
 
   Revision 1.10  2003/05/01 08:05:23  florian

rtl/inc/objpash.inc

@@ -209,6 +209,7 @@
          Addr,
          Frame   : pointer;
          Next    : PExceptObject;
+         refcount: Longint;
        end;
 
     Const
@@ -217,6 +218,27 @@
 
     Function RaiseList : PExceptObject;
 
+    { @abstract(increase exception reference count)
+      When leaving an except block, the exception object is normally
+      freed automatically. To avoid this, call this function.
+      If within the exception object you decide that you don't need
+      the exception after all, call @link(ReleaseExceptionObject).
+      Otherwise, if the reference count is > 0, the exception object 
+      goes into your "property" and you need to free it manually.
+      The effect of this function is countered by re-raising an exception
+      via "raise;", this zeroes the reference count again.
+      Calling this method is only valid within an except block.
+      @return(pointer to the exception object) }
+    function AcquireExceptionObject: Pointer;
+
+    { @abstract(decrease exception reference count)
+      After calling @link(AcquireExceptionObject) you can call this method
+      to decrease the exception reference count again.
+      If the reference count is > 0, the exception object 
+      goes into your "property" and you need to free it manually.
+      Calling this method is only valid within an except block. }
+    procedure ReleaseExceptionObject;
+
 {*****************************************************************************
                               Array of const support
 *****************************************************************************}
@@ -271,7 +293,10 @@
 
 {
   $Log$
-  Revision 1.16  2003-03-17 20:55:58  peter
+  Revision 1.17  2003-10-06 15:59:20  florian
+    + applied patch for ref. counted exceptions by Johannes Berg
+
+  Revision 1.16  2003/03/17 20:55:58  peter
     * ClassType changed to class method
 
   Revision 1.15  2002/09/26 14:43:24  florian