(***************************************************************************

     $RCSfile: Errors.mod $
  Description: Error handling and reporting

   Created by: fjc (Frank Copeland)
    $Revision: 1.2 $
      $Author: fjc $
        $Date: 1994/05/12 20:08:14 $

  Copyright © 1994, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

  Log entries are at the end of the file.

***************************************************************************)

MODULE Errors;

(* $P- allow non-portable code *)
(* $L+ use absolute long addressing for global variables *)

IMPORT SYS := SYSTEM, T := Types, E := Exec, IU := IntuiUtil;

VAR
  Report * : PROCEDURE (msg1, msg2, msg3 : ARRAY OF CHAR);
  OldCleanup : PROCEDURE (rc : LONGINT);
  Traps : ARRAY 26 OF T.STRPTR;

CONST
  Line1 = "Oberon-A Error Handler";


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE* DefaultReport (msg1, msg2, msg3 : ARRAY OF CHAR);

  VAR bodyText : ARRAY 3 OF T.APTR;

BEGIN (* DefaultReport *)
  bodyText [0] := SYS.ADR (msg1);
  bodyText [1] := SYS.ADR (msg2);
  bodyText [2] := SYS.ADR (msg3);
  IU.MultiNotice (NIL, bodyText, 3);
END DefaultReport;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE Abort * (msg : ARRAY OF CHAR);

BEGIN (* Abort *)
  Report (Line1, msg, "Program terminating ...");
  HALT (20)
END Abort;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE Assert * (condition : BOOLEAN; msg : ARRAY OF CHAR);

BEGIN (* Assert *)
  IF ~condition THEN Abort (msg) END
END Assert;


(*------------------------------------*)
PROCEDURE* PutCh ();

BEGIN (* PutCh *)
  SYS.INLINE (16C0H)   (* MOVE.B D0,(A3)+ *)
END PutCh;

(* $L- access global variables through A4 *)

(*------------------------------------*)
PROCEDURE* ReportRC (rc : LONGINT);

  CONST RunTimeError = "Run-time error detected";

  VAR line3 : T.STRPTR; str : ARRAY 60 OF CHAR;

BEGIN (* ReportRC *)
  IF ((rc >= 102) & (rc <= 111)) OR ((rc >= 132) & (rc <= 147)) THEN
    IF rc <= 111 THEN
      line3 := Traps [rc - 102]
    ELSE
      line3 := Traps [rc - 122]
    END; (* ELSE *)
    Report (Line1, "Processor trap detected", line3^)
  ELSIF rc = 21 THEN
    Report (Line1, RunTimeError, "Failed to open mathffp.library")
  ELSIF rc = 22 THEN
    Report (Line1, RunTimeError, "Freeing unallocated memory")
  ELSIF rc = 23 THEN
    Report (Line1, RunTimeError, "Divide by zero")
  ELSIF rc = 30 THEN
    Report (Line1, RunTimeError, "String conversion: ~(2 <= base <= 16)")
  ELSIF rc = 100 THEN
    Report (Line1, RunTimeError, "Failed to open shared library")
  ELSIF rc > 20 THEN
    E.Base.RawDoFmt ("Error code = %ld", rc, PutCh, str);
    Report (Line1, "Abnormal program exit", str);
  END; (* ELSE *)
  IF rc > 20 THEN rc := 20 END;
  IF OldCleanup # NIL THEN OldCleanup (rc) END;
END ReportRC;


BEGIN (* Errors *)
  Report := DefaultReport;
  Traps [0]  := SYS.ADR ("Trap #2 : Bus Error");
  Traps [1]  := SYS.ADR ("Trap #3 : Address Error");
  Traps [2]  := SYS.ADR ("Trap #4 : Illegal Instruction");
  Traps [3]  := SYS.ADR ("Trap #5 : Divide by zero");
  Traps [4]  := SYS.ADR ("Trap #6 : CHK instruction");
  Traps [5]  := SYS.ADR ("Trap #7 : TRAPV instruction");
  Traps [6]  := SYS.ADR ("Trap #8 : Privilege violation");
  Traps [7]  := SYS.ADR ("Trap #9 : Trace bit trap");
  Traps [8]  := SYS.ADR ("Trap #10 : Line 1010 emulator");
  Traps [9]  := SYS.ADR ("Trap #11 : Line 1111 emulator");
  Traps [10] := SYS.ADR ("Trap #32 : Compiler index check failed");
  Traps [11] := SYS.ADR ("Trap #33 : Compiler type check failed");
  Traps [12] := SYS.ADR ("Trap #34 : Memory allocation failed");
  Traps [13] := SYS.ADR ("Trap #35 : Compiler case check failed");
  Traps [14] := SYS.ADR ("Trap #36 : Unspecified user trap");
  Traps [15] := SYS.ADR ("Trap #37 : Unspecified user trap");
  Traps [16] := SYS.ADR ("Trap #38 : Unspecified user trap");
  Traps [17] := SYS.ADR ("Trap #39 : Unspecified user trap");
  Traps [18] := SYS.ADR ("Trap #40 : Unspecified user trap");
  Traps [19] := SYS.ADR ("Trap #41 : Unspecified user trap");
  Traps [20] := SYS.ADR ("Trap #42 : Unspecified user trap");
  Traps [21] := SYS.ADR ("Trap #43 : Unspecified user trap");
  Traps [22] := SYS.ADR ("Trap #44 : Unspecified user trap");
  Traps [23] := SYS.ADR ("Trap #45 : Unspecified user trap");
  Traps [24] := SYS.ADR ("Trap #46 : Unspecified user trap");
  Traps [25] := SYS.ADR ("Trap #47 : Unspecified user trap");
  SYS.SETCLEANUP (ReportRC, OldCleanup);
END Errors.

(***************************************************************************

  $Log: Errors.mod $
  Revision 1.2  1994/05/12  20:08:14  fjc
  - Prepared for release

  Revision 1.1  1994/01/15  21:39:12  fjc
  - Start of revision control

***************************************************************************)