Fresh Fish 9/FreshFishVol9-CD1.bin/useful/dev/obero/oberon-a/source/library/errors.mod

Text File | 1995-03-08 | 5.8 KB | 207 lines

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

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

   Created by: fjc (Frank Copeland)
    $Revision: 1.12 $
      $Author: fjc $
        $Date: 1995/03/08 20:35:51 $

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

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

<* STANDARD- *> <* MAIN- *> <*$ LongVars+ *> <*$ NilChk- *>

MODULE Errors;

IMPORT SYS := SYSTEM, Kernel, e := Exec, d := Dos, i := Intuition;

CONST

  (* Error codes understood by this module. *)

  (*
  noMemory *       =  95;
  invariant *      =  96;
  *)
  preCondition *   =  97;
  postCondition *  =  98;
  notImplemented * =  99;
  noLibrary *      = 100;

VAR
  Traps : ARRAY 26 OF e.LSTRPTR;

CONST
  Title = "Oberon-A Error Handler";


(*------------------------------------*)
PROCEDURE* Report (msg1, msg2 : ARRAY OF CHAR);

  VAR
    output : d.FileHandlePtr; es : i.EasyStruct;
    msg3 : ARRAY 80 OF CHAR;

  (*------------------------------------*)
  PROCEDURE WriteStr (str : ARRAY OF CHAR);
  <*$CopyArrays-*>
  BEGIN (* WriteStr *)
    SYS.PUTREG (0, d.Write (output, str, SYS.STRLEN (str)))
  END WriteStr;

  (*------------------------------------*)
  PROCEDURE WriteLn;
  BEGIN (* WriteLn *)
    SYS.PUTREG (0, d.Write (output, "\n", 1))
  END WriteLn;

<*$CopyArrays-*>
BEGIN (* Report *)
  IF i.base.libNode.version >= 37 THEN
    es.structSize := SIZE (i.EasyStruct);
    es.flags := {};
    es.title := SYS.ADR (Title);
    es.gadgetFormat := SYS.ADR ("Halt program");
    IF Kernel.errModule = "" THEN
      es.textFormat := SYS.ADR ("%s\n%s");
      IF i.EasyRequest
        ( NIL, SYS.ADR (es), NIL,
          SYS.ADR (msg1), SYS.ADR (msg2),
          NIL ) = 0
      THEN
      END
    ELSE
      es.textFormat := SYS.ADR ("%s\nModule %s, line %ld, col %ld\n%s");
      IF i.EasyRequest
        ( NIL, SYS.ADR (es), NIL,
          SYS.ADR (msg1),
          SYS.ADR (Kernel.errModule), Kernel.errLine, Kernel.errCol,
          SYS.ADR (msg2),
          NIL ) = 0
      THEN
      END
    END;
  ELSE
    output := d.Output();
    IF output # NIL THEN
      WriteStr (Title); WriteLn;
      WriteStr (msg1); WriteLn;
      WriteStr (msg2); WriteLn;
    END
  END
END Report;


(*------------------------------------*)
PROCEDURE Abort * (msg : ARRAY OF CHAR);

<*$CopyArrays-*>
BEGIN (* Abort *)
  Report ("Errors.Abort", msg);
  HALT (20)
END Abort;


(*------------------------------------*)
PROCEDURE Assert * (condition : BOOLEAN; msg : ARRAY OF CHAR);

<*$CopyArrays-*>
BEGIN (* Assert *)
  IF ~condition THEN
    Report ("Errors.Assert", msg);
    HALT (20)
  END
END Assert;

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

<*$EntryExitCode-*>
BEGIN (* PutCh *)
  SYS.INLINE (16C0H,   (* MOVE.B D0,(A3)+ *)
              4E75H)   (* RTS             *)
END PutCh;

<*$LongVars-*>

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

  CONST RunTimeError = "Run-time error detected";

  VAR line2 : e.LSTRPTR; str : ARRAY 80 OF CHAR;

BEGIN (* ReportRC *)
  Kernel.RemoveTrapHandler();
  IF (rc > 20) THEN
    IF rc = 21 THEN
      line2 := SYS.ADR ("Freeing unallocated memory")
    ELSIF rc = 22 THEN
      line2 := SYS.ADR ("Not enough memory")
    ELSIF rc = 23 THEN
      line2 := SYS.ADR ("Could not allocate user traps")
    ELSIF rc = 95 THEN
      line2 := SYS.ADR ("Not enough memory")
    ELSIF rc = 96 THEN
      line2 := SYS.ADR ("Invariant violated")
    ELSIF rc = 97 THEN
      line2 := SYS.ADR ("Pre-condition not satisfied")
    ELSIF rc = 98 THEN
      line2 := SYS.ADR ("Post-condition not satisfied")
    ELSIF rc = 99 THEN
      line2 := SYS.ADR ("Procedure or method not implemented")
    ELSIF rc = 100 THEN
      line2 := SYS.ADR ("Failed to open shared library")
    ELSIF (rc >= 102) & (rc <= 111) THEN
      line2 := Traps [rc - 102]
    ELSIF (rc >= 132) & (rc <= 147) THEN
      line2 := Traps [rc - 122]
    ELSE
      line2 := SYS.ADR (str);
      e.OldRawDoFmtL ("Error code = %ld", rc, PutCh, line2);
    END;
    Report (RunTimeError, line2^)
  END;
END ReportRC;


PROCEDURE Init*;
BEGIN (* Init *)
  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 : Compiler NIL check failed");
  Traps [13] := SYS.ADR ("Trap #35 : Compiler case check failed");
  Traps [14] := SYS.ADR ("Trap #36 : RETURN missing in function");
  Traps [15] := SYS.ADR ("Trap #37 : Compiler stack check failed");
  Traps [16] := SYS.ADR ("Trap #38 : Overflow/range check failed");
  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");
  Kernel.InstallTrapHandler();
  Kernel.SetCleanup (ReportRC);
END Init;

END Errors.