Copyright (C) 1994, Digital Equipment Corp.
Many of the routines in the RTHooks interface are exported directly by other modules of the runtime:
PushEFrame, PopEFrame are in Thread LockMutex, UnlockMutex are in Thread Allocate*, Dispose* are in RTAllocator
UNSAFE MODULE----------------------------------------------------------------- RAISE ---; IMPORT RT0, RTException, RTMisc, Text, Word; <*UNUSED*> VAR copyright := ARRAY [0..36] OF TEXT { " SRC Modula-3 Non-commercial License", "", "SRC Modula-3 is distributed by Digital Equipment Corporation ('DIGITAL'),", "a corporation of the Commonwealth of Massachusetts. DIGITAL hereby grants", "to you a non-transferable, non-exclusive, royalty free worldwide license", "to use, copy, modify, prepare integrated and derivative works of and", "distribute SRC Modula-3 for non-commercial purposes, subject to your", "agreement to the following terms and conditions:", "", " - The SRC Modula-3 Non-commercial License shall be included in the code", " and must be retained in all copies of SRC Modula-3 (full or partial;", " original, modified, derivative, or otherwise):", "", " - You acquire no ownership right, title, or interest in SRC Modula-3", " except as provided herein.", "", " - You agree to make available to DIGITAL all improvements,", " enhancements, extensions, and modifications to SRC Modula-3 which", " are made by you or your sublicensees and distributed to others and", " hereby grant to DIGITAL an irrevocable, fully paid, worldwide, and", " non-exclusive license under your intellectual property rights,", " including patent and copyright, to use and sublicense, without", " limititation, these modifications.", "", " - SRC Modula-3 is a research work which is provided 'as is',", " and DIGITAL disclaims all warranties", " with regard to this software, including all implied warranties of", " merchantability and fitness of purpose. In no event shall DIGITAL be", " liable for any special, direct, indirect, or consequential damages or", " any damages whatsoever resulting from loss of use, data or profits,", " whether in an action of contract, negligence or other tortious action,", " arising out of or in connection with the use or performance of this", " software. ", "", "", " Copyright (C) 1990 Digital Equipment Corporation", " All Rights Reserved" }; RTHooks
PROCEDURE----------------------------------------------- builtin TEXT operations ---Raise (exception: ADDRESS; arg: ADDRESS) RAISES ANY = BEGIN RTException.Raise (exception, arg); END Raise; PROCEDUREResumeRaise (info: ADDRESS) RAISES ANY = TYPE Info = UNTRACED REF RECORD exception, arg: ADDRESS END; VAR p := LOOPHOLE (info, Info); BEGIN RTException.ResumeRaise (p.exception, p.arg); END ResumeRaise;
PROCEDURE-------------------------------------------------------- runtime errors ---Concat (a, b: TEXT): TEXT = BEGIN RETURN Text.Cat (a, b); END Concat;
CONST msgs = ARRAY [0..9] OF TEXT { (* 0 *) "ASSERT failed", (* 1 *) "Value out of range", (* 2 *) "Subscript out of range", (* 3 *) "Incompatible array shapes", (* 4 *) "Attempt to dereference NIL", (* 5 *) "NARROW failed", (* 6 *) "Function did not return a value", (* 7 *) "Unhandled value in CASE statement", (* 8 *) "Unhandled type in TYPECASE statement", (* 9 *) "Stack overflow" }; PROCEDUREReportFault (module: ADDRESS(*RT0.ModulePtr*); info: INTEGER)= VAR line : INTEGER := Word.RightShift (info, 4); code : INTEGER := Word.And (info, 16_f); mi : RT0.ModulePtr := module; file : RT0.String := NIL; msg : TEXT := "bad error code!"; BEGIN IF (0 <= code) AND (code <= LAST (msgs)) THEN msg := msgs[code]; END; IF (mi # NIL) THEN file := mi.file; END; RTMisc.FatalErrorS (file, line, msg); END ReportFault; BEGIN END RTHooks.