home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / EASYEXCE.I < prev    next >
Encoding:
Text File  |  1990-12-17  |  4.4 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE EasyExceptions;
  2. ⓪ (*$Y+,R-,H+*)
  3. ⓪ 
  4. ⓪ (*
  5. ⓪!* Laufzeitfehler-Behandlung für Megamax Modula-2
  6. ⓪!* Programmiert von Thomas Tempelmann nach einem Vorschlag von K. John Gough
  7. ⓪!*
  8. ⓪!* 24.09.90: installiert nun auch bei residenten Modulen den Handler neu,
  9. ⓪!*           falls er durch's Deinit schon wieder entfernt wurde.
  10. ⓪!* 01.03.90: Aufgeräumt
  11. ⓪!* 05.07.89: IllegalCall nun als eigener Fehler
  12. ⓪!*)
  13. ⓪ 
  14. ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADR;
  15. ⓪ FROM HdlError IMPORT ReleaseCatcher, GetErrorMsg, SysCatchErrors;
  16. ⓪ FROM ErrBase IMPORT RaiseError, ErrResp, RtnCond;
  17. ⓪ FROM SysTypes IMPORT ExcDesc;
  18. ⓪ FROM PrgCtrl IMPORT Accessory, CatchProcessTerm, TermCarrier;
  19. ⓪ IMPORT MOSGlobals;
  20. ⓪ FROM SysBuffers IMPORT HdlErrorStack;
  21. ⓪ FROM SysUtil2 IMPORT JumpBuf, SetJump, LongJump;
  22. ⓪ FROM SystemError IMPORT OutOfMemory;
  23. ⓪ 
  24. ⓪ TYPE Exception = LONGINT;
  25. ⓪ 
  26. ⓪%PtrContext = POINTER TO Context;
  27. ⓪%Context = RECORD
  28. ⓪1prev: PtrContext;
  29. ⓪1buf: JumpBuf;
  30. ⓪/END;
  31. ⓪ 
  32. ⓪ VAR ID: INTEGER;
  33. ⓪$installed: BOOLEAN;
  34. ⓪$jmpPtr: PtrContext;
  35. ⓪$normalReturn: Exception;
  36. ⓪$wsp: MOSGlobals.MemArea;
  37. ⓪ 
  38. ⓪ 
  39. ⓪ PROCEDURE catch (errNo: INTEGER; msg: ARRAY OF CHAR; causer: ErrResp;
  40. ⓪1cont: RtnCond; VAR excData: ExcDesc ): BOOLEAN;
  41. ⓪"VAR tmp: PtrContext;
  42. ⓪"BEGIN
  43. ⓪$IF (jmpPtr # NIL) & (errNo # MOSGlobals.UserBreak) THEN
  44. ⓪&LongJump (jmpPtr^.buf, errNo);
  45. ⓪$END;
  46. ⓪$RETURN TRUE (* Diese Fehler werden nicht durch dies Modul behandelt *)
  47. ⓪"END catch;
  48. ⓪ 
  49. ⓪ 
  50. ⓪ PROCEDURE install (): BOOLEAN;
  51. ⓪"BEGIN
  52. ⓪$RETURN SysCatchErrors (catch, wsp)
  53. ⓪"END install;
  54. ⓪ 
  55. ⓪ PROCEDURE release;
  56. ⓪"BEGIN
  57. ⓪$installed:= FALSE;
  58. ⓪$ReleaseCatcher (catch)
  59. ⓪"END release;
  60. ⓪ 
  61. ⓪ 
  62. ⓪ PROCEDURE Call (p: PROC; VAR result: Exception);
  63. ⓪"VAR res: INTEGER; con: Context;
  64. ⓪"BEGIN
  65. ⓪$IF ~installed THEN
  66. ⓪&IF ~install () THEN
  67. ⓪(result:= MOSGlobals.OutOfMemory;
  68. ⓪(RETURN
  69. ⓪&END
  70. ⓪$END;
  71. ⓪$con.prev:= jmpPtr;
  72. ⓪$jmpPtr:= ADR (con);
  73. ⓪$res:= SetJump (jmpPtr^.buf);
  74. ⓪$IF res = 0 THEN
  75. ⓪&p;
  76. ⓪&result:= normalReturn
  77. ⓪$ELSE
  78. ⓪&result:= res
  79. ⓪$END;
  80. ⓪$jmpPtr:= jmpPtr^.prev;
  81. ⓪$IF ~installed THEN release END
  82. ⓪"END Call;
  83. ⓪ 
  84. ⓪ 
  85. ⓪ PROCEDURE Raise (reason: Exception);
  86. ⓪"BEGIN
  87. ⓪$RaiseError (SHORT (reason), '', callerCaused, mayContinue)
  88. ⓪"END Raise;
  89. ⓪ 
  90. ⓪ PROCEDURE New (VAR id: Exception);
  91. ⓪"BEGIN
  92. ⓪$id:= ID;
  93. ⓪$INC (ID);
  94. ⓪$IF ID > MAX (INTEGER) THEN
  95. ⓪&ID:= 2
  96. ⓪$END
  97. ⓪"END New;
  98. ⓪ 
  99. ⓪ PROCEDURE StdErrNo (id: Exception): INTEGER;
  100. ⓪"BEGIN
  101. ⓪$IF id = normalReturn THEN
  102. ⓪&RETURN 0
  103. ⓪$ELSE
  104. ⓪&RETURN SHORT (id)
  105. ⓪$END
  106. ⓪"END StdErrNo;
  107. ⓪ 
  108. ⓪ PROCEDURE NormalReturn ()  : Exception;
  109. ⓪"BEGIN RETURN normalReturn END NormalReturn;
  110. ⓪ 
  111. ⓪ PROCEDURE RealValueError ()  : Exception;
  112. ⓪"BEGIN RETURN MOSGlobals.GenFPErr END RealValueError;
  113. ⓪ 
  114. ⓪ PROCEDURE CaseSelectError () : Exception;
  115. ⓪"BEGIN RETURN MOSGlobals.CaseSelectErr END CaseSelectError;
  116. ⓪ 
  117. ⓪ PROCEDURE StringOverflow ()  : Exception;
  118. ⓪"BEGIN RETURN MOSGlobals.StringOverflow END StringOverflow;
  119. ⓪ 
  120. ⓪ PROCEDURE RangeError ()    : Exception;
  121. ⓪"BEGIN RETURN MOSGlobals.OutOfRange END RangeError;
  122. ⓪ 
  123. ⓪ PROCEDURE Overflow ()      : Exception;
  124. ⓪"BEGIN RETURN MOSGlobals.Overflow END Overflow;
  125. ⓪ 
  126. ⓪ PROCEDURE DivByZero ()     : Exception;
  127. ⓪"BEGIN RETURN MOSGlobals.DivByZero END DivByZero;
  128. ⓪ 
  129. ⓪ PROCEDURE StackOverflow () : Exception;
  130. ⓪"BEGIN RETURN MOSGlobals.OutOfStack END StackOverflow;
  131. ⓪ 
  132. ⓪ PROCEDURE StorageError ()  : Exception;
  133. ⓪"BEGIN RETURN MOSGlobals.OutOfMemory END StorageError;
  134. ⓪ 
  135. ⓪ PROCEDURE IOError ()       : Exception;
  136. ⓪"BEGIN RETURN MOSGlobals.FileSystemErr END IOError;
  137. ⓪ 
  138. ⓪ 
  139. ⓪ VAR termHdl: TermCarrier;
  140. ⓪ 
  141. ⓪ BEGIN
  142. ⓪"jmpPtr:= NIL;
  143. ⓪"ID:= 1; (* ID darf nicht Null sein! *)
  144. ⓪"New (normalReturn);
  145. ⓪"wsp.bottom:= ADR (HdlErrorStack);
  146. ⓪"wsp.length:= SIZE (HdlErrorStack);
  147. ⓪"IF NOT Accessory () THEN
  148. ⓪$(* damit ganz normal bei Prozeßende der
  149. ⓪%* SysCatchErrors wieder freigegeben wird: *)
  150. ⓪$CatchProcessTerm (termHdl, release, wsp);
  151. ⓪$IF NOT install () THEN
  152. ⓪&OutOfMemory
  153. ⓪$END;
  154. ⓪$installed:= TRUE
  155. ⓪"END;
  156. ⓪ END EasyExceptions.
  157. ⓪ ə
  158. (* $FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$00000EDB$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70$FFEF7B70Ç$00000EDBT.......T.....T.T.......T.......T.......T.......T.......T.......T.......T.......$0000033B$0000032C$00000337$000005B0$000005C3$000005E1$000006C9$0000070A$FFE67A63$00000C9D$00000EDB$00000033$000005A1$00000ED0$00000EF3$00000EE2¼Çé*)
  159.