RBBS in a Box Volume 1 #3.1/RBBSIABOX31.cdr/fasm/errhan.pas

Pascal/Delphi Source File | 1990-09-29 | 5.5 KB | 170 lines

(*[72457,2131]
ERRHAN.PAS     03-Oct-85 5145

    Keywords: IBM ERROR PCDOS 3.01 HANDLER INTERRUPT

    This program demonstrates a run-time error handler for Turbo version 3.01A.
    It allows control to return to the program after a run-time error, and
    provides a global variable containing information about what the error was.
    For PCDOS Turbo 3.01A (plain vanilla) only, but could be modified for
    others (there is one absolute address that would require change).
*)

  {
  Demonstrates a run-time error handler for PCDOS Turbo version 3.01A.
  Captures run-time errors with the built-in Turbo facility, but also
  allows returning to the executing program after the error occurs. A
  global variable ErrorResult can be polled to determine whether an error
  has occurred, and which type.

  Some errors do not allow graceful recovery, and for these the program
  will just halt.

  Note that it is possible to avoid all run-time errors by appropriate
  checking of values prior to performing operations. The "preventative"
  method is recommended over the techniques provided here, but these
  techniques may be handy for special cases.

  Written 10/2/85, Kim Kokkonen, TurboPower Software.
  408-378-3672, CompuServe 72457,2131.
  }

  {$R+}

PROGRAM ErrorTest;
  VAR
    ErrorResult : Byte;

    {the following variables are for the purpose of demonstration only}
    x, y, z : Real;
    i, j, k : Integer;
    s : STRING[255];
    a : ARRAY[1..10] OF Integer;
    v : 1..10;

  PROCEDURE Error(ErrNo, ErrAddr : Integer);
      {-errors interrupt to this procedure, not to be called directly}
    VAR
      ErrType, ErrNum : Byte;
      ErrOfs : Integer;
    BEGIN
      ErrType := Hi(ErrNo);
      IF ErrType = 0 THEN BEGIN
        {^C, just exit without an address printed}
        Halt(1);
      END ELSE IF ErrType = 1 THEN BEGIN
        {I/O error,let turbo handle it}
        {using the $I- directive and polling IOResult gives full control}
      END ELSE BEGIN
        {runtime error, return when possible to calling scope}
        {ErrOfs is number of bytes to skip on return to calling scope}
        ErrNum := Lo(ErrNo);
        CASE ErrNum OF
          4 : ErrOfs := 7;
          $10 : BEGIN
                  {recovery is unreliable, prevention is a better answer}
                  WriteLn('string length exceeds 255');
                  Halt(2);
                END;
          $11 : ErrOfs := 8;
          $F0 : BEGIN
                  {no way to gracefully recover}
                  WriteLn('overlay file not found');
                  Halt(2);
                END;
          $FF : BEGIN
                  {no way to gracefully recover}
                  {prevention is straightforward using memavail}
                  WriteLn('heap/stack collision');
                  Halt(2);
                END;
        ELSE
          ErrOfs := 3;
        END;
        {this global variable is accessed to handle error types}
        ErrorResult := ErrNum;
        INLINE(
          $8B/$46/$04/        {MOV   AX,[BP+04]   ;get erraddr              }
          $03/$46/< ErrOfs/   {ADD   AX,errofs[BP];compute return address   }
          $8B/$E5/            {MOV   SP,BP        ;restore stack            }
          $5D/                {POP   BP                                     }
          $50/                {PUSH  AX           ;return address on stack  }
          $31/$C0/            {XOR   AX,AX        ;required for string instr}
          $A3/$88/$01/        {MOV   [188],AX     ;required for further errs}
          $C2/$02/$00         {RET   0002         ;return and realign stack }
          );
      END;
    END;                      {error}

  PROCEDURE HandleError;
      {-print error message or do whatever is necessary}
    BEGIN
      CASE ErrorResult OF
        1 : WriteLn('floating point overflow');
        2 : WriteLn('floating point division by zero');
        3 : WriteLn('negative Sqrt argument');
        4 : WriteLn('integer divide by zero or negative Ln argument');
        $11 : WriteLn('string index out of range');
        $90 : WriteLn('array index out of range');
        $91 : WriteLn('scalar or subrange assignment out of range');
        $92 : WriteLn('integer assignment out of range');
      END;
      {reset to find next error}
      ErrorResult := 0;
    END;                      {handleerror}

  PROCEDURE SetupErrorHandler;
    BEGIN
      errorptr := Ofs(Error);
      ErrorResult := 0;
    END;                      {setuperrorhandler}

  BEGIN
    SetupErrorHandler;

    {string index error}
    i := 256;
    s := 'hello';
    s := Copy(s, i, 1);
    IF ErrorResult <> 0 THEN HandleError;

    {array index error, only caught with $R+}
    i := 20;
    a[i] := 10;
    IF ErrorResult <> 0 THEN HandleError;

    {subrange assignment error}
    i := 20;
    v := i;
    IF ErrorResult <> 0 THEN HandleError;

    {integer range error}
    x := -65536.0;
    i := Trunc(x);
    IF ErrorResult <> 0 THEN HandleError;

    {negative Ln error}
    y := -3.0;
    z := Ln(y);
    IF ErrorResult <> 0 THEN HandleError;

    {floating point divide by zero error}
    y := 0;
    x := 1;
    z := x/y;
    IF ErrorResult <> 0 THEN HandleError;

    {integer divide by zero error}
    i := 0;
    j := 1;
    k := j DIV i;
    IF ErrorResult <> 0 THEN HandleError;

    {floating point overflow error}
    x := 1.0E20;
    y := 1.0E-20;
    z := x/y;
    IF ErrorResult <> 0 THEN HandleError;

  END.