Browse Source

+ HandleErrorAddrFrame

pierre 25 years ago
parent
commit
dafcbea824
1 changed files with 17 additions and 12 deletions
  1. 17 12
      rtl/inc/system.inc

+ 17 - 12
rtl/inc/system.inc

@@ -459,25 +459,27 @@ begin
 end;
 end;
 
 
 
 
-Procedure HandleErrorFrame (Errno : longint;frame : longint);
-{
-  Procedure to handle internal errors, i.e. not user-invoked errors
-  Internal function should ALWAYS call HandleError instead of RunError.
-  Can be used for exception handlers to specify the frame
-}
-var
-  addr : longint;
+Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : longint);
 begin
 begin
-  addr:=get_caller_addr(frame);
   If pointer(ErrorProc)<>Nil then
   If pointer(ErrorProc)<>Nil then
     ErrorProc(Errno,pointer(addr));
     ErrorProc(Errno,pointer(addr));
   errorcode:=Errno;
   errorcode:=Errno;
   exitcode:=Errno;
   exitcode:=Errno;
   erroraddr:=pointer(addr);
   erroraddr:=pointer(addr);
-  errorbase:=get_caller_frame(frame);
+  errorbase:=frame;
   halt(errorcode);
   halt(errorcode);
 end;
 end;
 
 
+Procedure HandleErrorFrame (Errno : longint;frame : longint);
+{
+  Procedure to handle internal errors, i.e. not user-invoked errors
+  Internal function should ALWAYS call HandleError instead of RunError.
+  Can be used for exception handlers to specify the frame
+}
+begin
+  HandleErrorAddrFrame(Errno,get_caller_addr(frame),get_caller_frame(frame));
+end;
+
 
 
 Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
 Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
 {
 {
@@ -613,7 +615,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.84  2000-02-26 15:49:40  jonas
+  Revision 1.85  2000-03-14 07:31:57  pierre
+   + HandleErrorAddrFrame
+
+  Revision 1.84  2000/02/26 15:49:40  jonas
     + new str_real which is completely TP compatible regarding output
     + new str_real which is completely TP compatible regarding output
       format and which should have no rounding errors anymore
       format and which should have no rounding errors anymore
 
 
@@ -679,4 +684,4 @@ end;
   Revision 1.65  1999/07/28 12:58:22  peter
   Revision 1.65  1999/07/28 12:58:22  peter
     * fixed assert() to push/pop registers
     * fixed assert() to push/pop registers
 
 
-}
+}