* fixed io-error handling

rtl/i386/i386.inc

@@ -688,12 +688,7 @@ begin
    begin
      l:=InOutRes;
      InOutRes:=0;
-     If ErrorProc<>Nil then
-       TErrorProc(Errorproc)(l,pointer(addr));
-{$ifndef RTLLITE}
-     writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
-{$endif}
-     Halt(byte(l));
+     HandleError(l,get_frame);
    end;
   asm
         popal
@@ -704,7 +699,10 @@ end;
 
 {
   $Log$
-  Revision 1.35  1998-12-15 22:42:53  peter
+  Revision 1.36  1998-12-18 17:21:32  peter
+    * fixed io-error handling
+
+  Revision 1.35  1998/12/15 22:42:53  peter
     * removed temp symbols
 
   Revision 1.34  1998/11/30 15:27:28  pierre

rtl/inc/system.inc

@@ -27,6 +27,7 @@
 {$i textrec.inc}
 
 Procedure HandleError (Errno : Longint); forward;
+Procedure HandleError (Errno : longint;frame : longint); forward;
 
 type
   FileFunc = Procedure(var t : TextRec);
@@ -39,7 +40,6 @@ const
   Seed3 : Cardinal = 0;
 
 { For Error Handling.}
-  DoError   : Boolean = FALSE;
   ErrorBase : Longint = 0;
 
 {****************************************************************************
@@ -276,16 +276,8 @@ end;
 *****************************************************************************}
 
 procedure int_overflow;[public,alias:'FPC_OVERFLOW'];
-var
-  addr : longint;
 begin
-   addr:=get_caller_addr(get_frame);
-   If ErrorProc<>Nil then
-     TErrorProc (ErrorProc)(215,Pointer(Addr));
-{$ifndef RTLLITE}
-   Writeln('Overflow at 0x',HexStr(addr,8));
-{$endif}
-   HandleError(215);
+  HandleError(215,get_frame);
 end;
 
 
@@ -322,7 +314,6 @@ begin
   exitcode:=Errno;
   erroraddr:=pointer(addr);
   errorbase:=get_caller_frame(frame);
-  DoError:=true;
   halt(errorcode);
 end;
 
@@ -343,7 +334,6 @@ begin
   exitcode:=w;
   erroraddr:=pointer(get_caller_addr(get_frame));
   errorbase:=get_caller_frame(get_frame);
-  DoError:=true;
   halt(errorcode);
 end;
 
@@ -379,16 +369,6 @@ End;
 
 
 Procedure do_exit;[Public,Alias:'FPC_DO_EXIT'];
-{
-  Don't call this direct, the call is generated by the compiler
-  and by the halt procedure.
-  NOTICE: (CEC - 14/Aug/1998)
-  The order of calling this routine must not be changed, especially
-  regarding doerror, doerror should only be set by handlerror
-  and runerror and nowhere else, as certain system units require
-  exit procedures to clean up, and they rely on this behavior as not
-  to call themselves recursively.
-}
 var
   current_exit : Procedure;
 Begin
@@ -399,7 +379,7 @@ Begin
      exitProc:=nil;
      current_exit();
    End;
-  If DoError Then
+  If erroraddr<>nil Then
    Begin
      Writeln('Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
      dump_stack(ErrorBase);
@@ -488,7 +468,10 @@ end;
 
 {
   $Log$
-  Revision 1.47  1998-12-15 22:43:03  peter
+  Revision 1.48  1998-12-18 17:21:33  peter
+    * fixed io-error handling
+
+  Revision 1.47  1998/12/15 22:43:03  peter
     * removed temp symbols
 
   Revision 1.46  1998/12/10 23:59:56  peter

rtl/linux/syslinux.pp

@@ -95,7 +95,6 @@ Implementation
 Procedure Halt(ErrNum: Byte);
 Begin
   ExitCode:=Errnum;
-  ErrorAddr:=nil;
   Do_Exit;
 {$ifdef i386}
   asm
@@ -731,7 +730,10 @@ End.
 
 {
   $Log$
-  Revision 1.19  1998-12-15 22:43:08  peter
+  Revision 1.20  1998-12-18 17:21:34  peter
+    * fixed io-error handling
+
+  Revision 1.19  1998/12/15 22:43:08  peter
     * removed temp symbols
 
   Revision 1.18  1998/11/16 10:21:32  peter