{$I-}
Program Error_proof;
{        Programmer : Doug Burger         1 May 87
         Purpose    : Set up a way for Turbo Pascal programs to
                      detect when a critical error occurs

  The following assembler code works as follows:
  Execution of the code begins when MS-DOS encounters a
  critical error, i.e. when the disk drive door is left open.

  1.  The return address (IP & CS), flags, and AX register are removed from
      the stack.  The address is the return point within the Int 21h code.
  2.  The error code in DI is converted into an MS-DOS System extended
      error code and put in AX.
  3.  The user's registers at the time of the original Int 21h call
      are restored.
  4.  The error code is put into a Turbo variable, whose address is
      added to the code in the initialization procedure.
  5.  FF is put into AL as an error flag similar to the older
      functions.
  6.  The Interrupt Flag is set; the Carry Flag is set as an error
      flag of the newer functions occurred.
  7.  Execution returns to the original caller of Int 21h.  The original
      flags are not returned in order for the Carry Flag to be effective.
}
const int24 : array[1..27] of byte = ($83,$C4,$08,  {   add  SP,8            }
                                     $8B,$C7,       {   mov  AX,DI           }
                                     $05,$13,$00,   {   add  AX,19d          }
                                     $5B,           {   pop  BX              }
                                     $59,           {   pop  CX              }
                                     $5A,           {   pop  DX              }
                                     $5E,           {   pop  SI              }
                                     $5F,           {   pop  DI              }
                                     $5D,           {   pop  BP              }
                                     $1F,           {   pop  DS              }
                                     $07,           {   pop  ES              }
                                     $A3,$00,$00,   {   mov  errcode,AX      }
                                     $B8,$FF,$00,   {   mov  AX,00FFh        }
                                     $FB,           {   sti                  }
                                     $F9,           {   stc                  }
                                     $CA,$02,$00);  {   ret  2               }

type registers = record
                    AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
                 end;

var errcode : integer;               { The MS-DOS error code will go here }
    old24seg,old24ofs : integer;

    outfile : text;
    errornum : integer;

Procedure Enable24;
var R : registers;
begin
   errcode:=0;
   R.AX:=$3524;                       { Get Interrupt Vector }
   intr($21,R);
   old24seg:=R.ES;                    { save the old vector for later restore }
   old24ofs:=R.BX;
   int24[18]:=ofs(errcode) and $FF;   { put the variable address in the code }
   int24[19]:=(ofs(errcode) and $FF00) shr 8;
   R.AX:=$2524;                       { set the Int 24h vector to new code }
   R.DS:=seg(int24);
   R.DX:=ofs(int24);
   intr($21,R);
end;

Procedure Disable24;
var R : registers;
begin
   R.AX:=$2524;                       { Set Interrupt Vector }
   R.DS:=old24seg;                    { Restore the orignal vectors }
   R.DX:=old24ofs;
   intr($21,R);
end;

Function Extended_Error:integer;
begin
   Extended_Error:=errcode;
   errcode:=0;
end;

begin
   ClrScr;
   Enable24;
   assign(outfile,'b:test');
   writeln('Critical Error Trapping':51);writeln;
   writeln('Open the drive door for failing the Open File call (Press RET)');
   readln;
   rewrite(outfile);
   errornum:=IOResult;
   if errornum<>0  then
   begin
      writeln('Create File failed');
      writeln('"Normal" error is ',errornum);
      writeln('Extended error code is ',Extended_Error);
      Disable24;
      halt;
   end;
   write(outfile,'This is a little something for the buffer.');
   writeln('Open the drive door for failing the Close File call (Press RET)');
   readln;
   close(outfile);
   errornum:=IOResult;
   if errornum<>0  then
   begin
      writeln('Close File failed');
      writeln('"Normal" error is ',errornum);
      writeln('Extended error code is ',Extended_Error);
   end;
   Disable24;
end.