home *** CD-ROM | disk | FTP | other *** search
- (***************************************************************************
-
- $RCSfile: Errors.mod $
- Description: Error handling and reporting
-
- Created by: fjc (Frank Copeland)
- $Revision: 1.14 $
- $Author: fjc $
- $Date: 1995/06/04 23:22:41 $
-
- Copyright © 1994, Frank Copeland.
- This file is part of the Oberon-A Library.
- See Oberon-A.doc for conditions of use and distribution.
-
- ***************************************************************************)
-
- <* STANDARD- *>
-
- MODULE Errors;
-
- IMPORT SYS := SYSTEM, Kernel, e := Exec, i := Intuition, OAErrs;
-
- CONST
-
- (* Error codes understood by this module. *)
-
- outOfMem * = 95;
- invariant * = 96;
- preCondition * = 97;
- postCondition * = 98;
- notImplemented * = 99;
- noLibrary * = 100;
-
- VAR
- installed : BOOLEAN;
-
- (*------------------------------------*)
- PROCEDURE Report (msg1 : LONGINT; msg2 : e.LSTRPTR);
-
- VAR es : i.EasyStruct;
-
- <*$CopyArrays-*>
- BEGIN (* Report *)
- es.structSize := SIZE (i.EasyStruct);
- es.flags := {};
- es.title := OAErrs.GetString (OAErrs.title);
- es.gadgetFormat := OAErrs.GetString (OAErrs.haltButton);
- IF Kernel.errModule = "" THEN
- es.textFormat := SYS.ADR ("%s\n%s");
- IF i.EasyRequest
- ( NIL, SYS.ADR (es), NIL,
- OAErrs.GetString (msg1), msg2 )
- = 0
- THEN
- END
- ELSE
- es.textFormat := OAErrs.GetString (OAErrs.posFormat);
- IF i.EasyRequest
- ( NIL, SYS.ADR (es), NIL,
- OAErrs.GetString (msg1),
- SYS.ADR (Kernel.errModule), Kernel.errLine, Kernel.errCol,
- msg2 )
- = 0
- THEN
- END
- END;
- END Report;
-
-
- (*------------------------------------*)
- PROCEDURE Abort * (msg : ARRAY OF CHAR);
-
- <*$CopyArrays-*>
- BEGIN (* Abort *)
- Report (OAErrs.abort, SYS.ADR (msg));
- HALT (20)
- END Abort;
-
-
- (*------------------------------------*)
- PROCEDURE Assert * (condition : BOOLEAN; msg : ARRAY OF CHAR);
-
- <*$CopyArrays-*>
- BEGIN (* Assert *)
- IF ~condition THEN
- Report (OAErrs.assert, SYS.ADR (msg));
- HALT (20)
- END
- END Assert;
-
- (*------------------------------------*)
- PROCEDURE* PutCh ();
-
- <*$EntryExitCode-*>
- BEGIN (* PutCh *)
- SYS.INLINE (16C0H, (* MOVE.B D0,(A3)+ *)
- 4E75H) (* RTS *)
- END PutCh;
-
- (*------------------------------------*)
- PROCEDURE* ReportRC (VAR rc : LONGINT);
-
- VAR msg, fmt : e.LSTRPTR; str : ARRAY 80 OF CHAR;
-
- BEGIN (* ReportRC *)
- IF (rc >= 20) THEN
- OAErrs.OpenCatalog (NIL, "");
- msg := OAErrs.GetString (rc);
- IF msg = NIL THEN
- fmt := OAErrs.GetString (OAErrs.unknown);
- msg := SYS.ADR (str);
- e.OldRawDoFmtL (fmt^, rc, PutCh, msg)
- END;
- Report (OAErrs.runtimeError, msg);
- OAErrs.CloseCatalog
- END;
- Kernel.RemoveTrapHandler()
- END ReportRC;
-
-
- PROCEDURE Init*;
- BEGIN (* Init *)
- IF ~installed THEN
- Kernel.InstallTrapHandler();
- Kernel.SetCleanup (ReportRC);
- installed := TRUE
- END
- END Init;
-
- BEGIN
- installed := FALSE
- END Errors.
-