From bc8a454afdd218f3e7a17c34e3795815ff00acda Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Thu, 22 Jun 2000 18:05:56 +0000
Subject: [PATCH] + Modifications for exception support in sysutils. Mainly
 added    RaiseList function.

---
 rtl/inc/except.inc  | 18 ++++++++++--------
 rtl/inc/objpash.inc | 19 +++++++++++++++++--
 rtl/inc/systemh.inc | 11 +++++++++--
 3 files changed, 36 insertions(+), 12 deletions(-)

diff --git a/rtl/inc/except.inc b/rtl/inc/except.inc
index b4f7f4e78e..e678140788 100644
--- a/rtl/inc/except.inc
+++ b/rtl/inc/except.inc
@@ -34,13 +34,6 @@ Type
     next      : PExceptAddr;
   end;
 
-  PExceptObject = ^TExceptObject;
-  TExceptObject = record
-    FObject : TObject;
-    Addr,
-    Frame   : pointer;
-    Next    : PExceptObject;
-  end;
 
   TExceptObjectClass = Class of TObject;
 
@@ -51,6 +44,11 @@ Var
   ExceptAddrStack   : PExceptAddr;
   ExceptObjectStack : PExceptObject;
 
+Function RaiseList : PExceptObject;
+
+begin
+  RaiseList:=ExceptObjectStack;
+end;
 
 Function PushExceptAddr (Ft: Longint): PJmp_buf ;
   [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters;
@@ -246,7 +244,11 @@ begin
 end;
 {
   $Log$
-  Revision 1.19  2000-05-04 12:25:53  pierre
+  Revision 1.20  2000-06-22 18:05:56  michael
+  + Modifications for exception support in sysutils. Mainly added
+     RaiseList function.
+
+  Revision 1.19  2000/05/04 12:25:53  pierre
    * Use saveregisters for PushExcept..
 
   Revision 1.18  2000/04/24 11:11:50  peter
diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc
index e364555c5c..b01e3d9135 100644
--- a/rtl/inc/objpash.inc
+++ b/rtl/inc/objpash.inc
@@ -148,9 +148,20 @@
 
        TExceptProc = Procedure (Obj : TObject; Addr,Frame: Pointer);
 
+       { Exception object stack }
+       PExceptObject = ^TExceptObject;
+       TExceptObject = record
+         FObject : TObject;
+         Addr,
+         Frame   : pointer;
+         Next    : PExceptObject;
+       end;
+
        Const
           ExceptProc : TExceptProc = Nil;
 
+       Function RaiseList : PExceptObject;
+
 
 {*****************************************************************************
                               Variant Type
@@ -222,7 +233,11 @@
        end;
 {
   $Log$
-  Revision 1.10  2000-05-14 18:47:53  florian
+  Revision 1.11  2000-06-22 18:05:56  michael
+  + Modifications for exception support in sysutils. Mainly added
+     RaiseList function.
+
+  Revision 1.10  2000/05/14 18:47:53  florian
     * TVarRec with Int64/QWord stuff extended
 
   Revision 1.9  2000/04/24 11:11:50  peter
@@ -247,4 +262,4 @@
     * classes vmt changed to only positive addresses
     * sharedlib creation is working
 
-}
+}
\ No newline at end of file
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index 55e7584a02..e8c490a592 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -418,6 +418,9 @@ Type
   TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
   TAbstractErrorProc = Procedure;
   TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno,erroraddr:longint);
+
+
+
 const
   BackTraceStrFunc  : TBackTraceStrFunc = @SysBackTraceStr;
   ErrorProc         : TErrorProc = nil;
@@ -440,7 +443,11 @@ const
 
 {
   $Log$
-  Revision 1.83  2000-06-11 07:02:30  peter
+  Revision 1.84  2000-06-22 18:05:56  michael
+  + Modifications for exception support in sysutils. Mainly added
+     RaiseList function.
+
+  Revision 1.83  2000/06/11 07:02:30  peter
     * UniqueAnsiString -> UniqueString for Delphi compatibility
 
   Revision 1.82  2000/05/14 18:46:54  florian
@@ -517,4 +524,4 @@ const
   Revision 1.62  1999/08/19 11:16:13  peter
     * settextbuf size is now longint
 
-}
+}
\ No newline at end of file