home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon-a / source / library / errors.mod < prev    next >
Text File  |  1995-06-29  |  3KB  |  133 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Errors.mod $
  4.   Description: Error handling and reporting
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.14 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:22:41 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE Errors;
  20.  
  21. IMPORT SYS := SYSTEM, Kernel, e := Exec, i := Intuition, OAErrs;
  22.  
  23. CONST
  24.  
  25.   (* Error codes understood by this module. *)
  26.  
  27.   outOfMem *       =  95;
  28.   invariant *      =  96;
  29.   preCondition *   =  97;
  30.   postCondition *  =  98;
  31.   notImplemented * =  99;
  32.   noLibrary *      = 100;
  33.  
  34. VAR
  35.   installed : BOOLEAN;
  36.  
  37. (*------------------------------------*)
  38. PROCEDURE Report (msg1 : LONGINT; msg2 : e.LSTRPTR);
  39.  
  40.   VAR es : i.EasyStruct;
  41.  
  42. <*$CopyArrays-*>
  43. BEGIN (* Report *)
  44.   es.structSize := SIZE (i.EasyStruct);
  45.   es.flags := {};
  46.   es.title := OAErrs.GetString (OAErrs.title);
  47.   es.gadgetFormat := OAErrs.GetString (OAErrs.haltButton);
  48.   IF Kernel.errModule = "" THEN
  49.     es.textFormat := SYS.ADR ("%s\n%s");
  50.     IF i.EasyRequest
  51.       ( NIL, SYS.ADR (es), NIL,
  52.         OAErrs.GetString (msg1), msg2 )
  53.       = 0
  54.     THEN
  55.     END
  56.   ELSE
  57.     es.textFormat := OAErrs.GetString (OAErrs.posFormat);
  58.     IF i.EasyRequest
  59.       ( NIL, SYS.ADR (es), NIL,
  60.         OAErrs.GetString (msg1),
  61.         SYS.ADR (Kernel.errModule), Kernel.errLine, Kernel.errCol,
  62.         msg2 )
  63.       = 0
  64.     THEN
  65.     END
  66.   END;
  67. END Report;
  68.  
  69.  
  70. (*------------------------------------*)
  71. PROCEDURE Abort * (msg : ARRAY OF CHAR);
  72.  
  73. <*$CopyArrays-*>
  74. BEGIN (* Abort *)
  75.   Report (OAErrs.abort, SYS.ADR (msg));
  76.   HALT (20)
  77. END Abort;
  78.  
  79.  
  80. (*------------------------------------*)
  81. PROCEDURE Assert * (condition : BOOLEAN; msg : ARRAY OF CHAR);
  82.  
  83. <*$CopyArrays-*>
  84. BEGIN (* Assert *)
  85.   IF ~condition THEN
  86.     Report (OAErrs.assert, SYS.ADR (msg));
  87.     HALT (20)
  88.   END
  89. END Assert;
  90.  
  91. (*------------------------------------*)
  92. PROCEDURE* PutCh ();
  93.  
  94. <*$EntryExitCode-*>
  95. BEGIN (* PutCh *)
  96.   SYS.INLINE (16C0H,   (* MOVE.B D0,(A3)+ *)
  97.               4E75H)   (* RTS             *)
  98. END PutCh;
  99.  
  100. (*------------------------------------*)
  101. PROCEDURE* ReportRC (VAR rc : LONGINT);
  102.  
  103.   VAR msg, fmt : e.LSTRPTR; str : ARRAY 80 OF CHAR;
  104.  
  105. BEGIN (* ReportRC *)
  106.   IF (rc >= 20) THEN
  107.     OAErrs.OpenCatalog (NIL, "");
  108.     msg := OAErrs.GetString (rc);
  109.     IF msg = NIL THEN
  110.       fmt := OAErrs.GetString (OAErrs.unknown);
  111.       msg := SYS.ADR (str);
  112.       e.OldRawDoFmtL (fmt^, rc, PutCh, msg)
  113.     END;
  114.     Report (OAErrs.runtimeError, msg);
  115.     OAErrs.CloseCatalog
  116.   END;
  117.   Kernel.RemoveTrapHandler()
  118. END ReportRC;
  119.  
  120.  
  121. PROCEDURE Init*;
  122. BEGIN (* Init *)
  123.   IF ~installed THEN
  124.     Kernel.InstallTrapHandler();
  125.     Kernel.SetCleanup (ReportRC);
  126.     installed := TRUE
  127.   END
  128. END Init;
  129.  
  130. BEGIN
  131.   installed := FALSE
  132. END Errors.
  133.