Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP5FIX87.ZIP/TP5FIX87.PAS

Pascal/Delphi Source File | 1989-06-11 | 5.7 KB | 148 lines

(*   This simple unit takes care of two lingering problems in TP5:

   1) when running a TP5 program from the DOS environment, only an error
      number is displayed, rather than a text message;
   2) when using a math coprocessor, the error address is not correct.

     The first problem simply requires linking to the ExitProc handler,
      recovering the error message and address if one occurs, and printing
      a text message.

     The second problem is caused by the curious behavior of the x87 and
      Borland laziness.  On a floating point error, the 20 bit address of
      the instruction causing the error is stored in the x87.  Note that
      the segment and offset of the address is NOT stored.  The Borland
      error handler makes no attempt to compute the address in their format
      (segment and offset relative to the beginning of the main program), and
      consequently does not always report the correct address.  This unit
      computes and reports the 20 bit offset of the erroneous instruction
      relative to the start of the main program.  This address is what is
      required to find the error if the error is in the unit containing the
      main program.  If the address is not in this unit, the MAP file produced
      by the compiler must be used to compute the address relative to the
      start of the offending unit.

      Joe Ahlgren    RBBS 703-241-7980

*)

unit TP5FIX87;

  interface

  implementation

{$F+}
  var
    ExitSave: pointer;
  const
    MaxArray = 40;
  type
    ErrorRecordType = record
                    ErrorNumber: byte;
                    ErrorTitle: string[35];
                    end;
    ErrorArrayType = array [1..MaxArray] of ErrorRecordType;
  const
    ErrorArray: ErrorArrayType =
 (  (ErrorNumber: 002; ErrorTitle: 'File not found'),
    (ErrorNumber: 003; ErrorTitle: 'Path not found'),
    (ErrorNumber: 004; ErrorTitle: 'Too many open files'),
    (ErrorNumber: 005; ErrorTitle: 'File access denied'),
    (ErrorNumber: 006; ErrorTitle: 'Invalid file handle'),
    (ErrorNumber: 012; ErrorTitle: 'Invalid file access code'),
    (ErrorNumber: 015; ErrorTitle: 'Invalid drive number'),
    (ErrorNumber: 016; ErrorTitle: 'Cannot remove current directory'),
    (ErrorNumber: 017; ErrorTitle: 'Cannot rename across drives'),
    (ErrorNumber: 100; ErrorTitle: 'Disk read error'),
    (ErrorNumber: 101; ErrorTitle: 'Disk write error'),
    (ErrorNumber: 102; ErrorTitle: 'File not assigned'),
    (ErrorNumber: 103; ErrorTitle: 'File not open'),
    (ErrorNumber: 104; ErrorTitle: 'File not open for input'),
    (ErrorNumber: 105; ErrorTitle: 'File not open for output'),
    (ErrorNumber: 106; ErrorTitle: 'Invalid numeric format'),
    (ErrorNumber: 150; ErrorTitle: 'Disk is write protected'),
    (ErrorNumber: 151; ErrorTitle: 'Unknown unit'),
    (ErrorNumber: 152; ErrorTitle: 'Drive not ready'),
    (ErrorNumber: 153; ErrorTitle: 'Unknown command'),
    (ErrorNumber: 154; ErrorTitle: 'CRC error in data'),
    (ErrorNumber: 155; ErrorTitle: 'Bad drive request structure length'),
    (ErrorNumber: 156; ErrorTitle: 'Disk seek error'),
    (ErrorNumber: 157; ErrorTitle: 'Unknown media type'),
    (ErrorNumber: 158; ErrorTitle: 'Sector not found'),
    (ErrorNumber: 159; ErrorTitle: 'Printer out of paper'),
    (ErrorNumber: 160; ErrorTitle: 'Device write fault'),
    (ErrorNumber: 161; ErrorTitle: 'Device read fault'),
    (ErrorNumber: 162; ErrorTitle: 'Hardware failure'),
    (ErrorNumber: 200; ErrorTitle: 'Division by zero'),
    (ErrorNumber: 201; ErrorTitle: 'Range check error'),
    (ErrorNumber: 202; ErrorTitle: 'Stack overflow error'),
    (ErrorNumber: 203; ErrorTitle: 'Heap overflow error'),
    (ErrorNumber: 204; ErrorTitle: 'Invalid pointer operation'),
    (ErrorNumber: 205; ErrorTitle: 'Floating point overflow'),
    (ErrorNumber: 206; ErrorTitle: 'Floating point underflow'),
    (ErrorNumber: 207; ErrorTitle: 'Invalid floating point operation'),
    (ErrorNumber: 208; ErrorTitle: 'Overlay manager not installed'),
    (ErrorNumber: 209; ErrorTitle: 'Overlay file read error'),
    (ErrorNumber: 255; ErrorTitle: 'User Break') );

  type HexType = String[4];
    type
      St16 = string[16];
    const
      HexDigits:St16 = '0123456789abcdef';
  function Hex(x: word): HexType;
    var
      k: integer;
      s: HexType;
    begin
      s:='';
      for k:=1 to 4 do
        begin
        s:=HexDigits[(x and $000f)+1]+s;
        x:=x shr 4;
        end;
      Hex:=s;
    end;

  procedure FPerrorExit;
    var
      ec,j,k: word;
      s: string[10];
      msg,msg2: string[80];
      ExitArray: array [1..2] of word absolute ErrorAddr;
      ErrorAddr87: LongInt;
      IP87: array [0..1] of word absolute ErrorAddr87;
      Diagnose87: array [-5..6] of word absolute SaveInt75;
    begin
      ExitProc:=ExitSave;
      if ExitCode > 0 then
        begin
        ec:=ExitCode;
        Str(ec,msg);
        k:=0;
        for j:=1 to MaxArray do
          if ErrorArray[j].ErrorNumber = ec then
            k:=j;
        if k <> 0 then
          msg:=msg+' '+ErrorArray[k].ErrorTitle
         else
          msg:=msg+' ?';
        msg:=' Error '+msg+' at '+Hex(ExitArray[2])+':'+Hex(exitArray[1]);
        ErrorAddr87:=Diagnose87[4] and $f000;
        ErrorAddr87:=ErrorAddr87*$10 + Diagnose87[3] -
                        LongInt(Prefixseg+$10)*$10;
        IP87[1]:=IP87[1] and $000f;
        msg2:=' loaded at '+Hex(PrefixSeg+16) + ', 87 IP=' +
                  HexDigits[IP87[1]+1] + Hex(IP87[0]);
        WriteLn(msg);
        WriteLn(msg2);
        end;
    end;


    begin
    ExitSave:=ExitProc;
    ExitProc:=@FPerrorExit;
    end.