Browse Source

+ Modifications for exception support in sysutils. Mainly added
RaiseList function.

michael 25 years ago
parent
commit
bc8a454afd
3 changed files with 36 additions and 12 deletions
  1. 10 8
      rtl/inc/except.inc
  2. 17 2
      rtl/inc/objpash.inc
  3. 9 2
      rtl/inc/systemh.inc

+ 10 - 8
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

+ 17 - 2
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
 
-}
+}

+ 9 - 2
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
 
-}
+}