PageRenderTime 59ms CodeModel.GetById 31ms RepoModel.GetById 0ms app.codeStats 0ms

/SK8/07-Objects/02-Object System Core/SK8-error-system.lisp

https://bitbucket.org/pablomarx/sk8r
Lisp | 391 lines | 135 code | 32 blank | 224 comment | 1 complexity | 5ca9a7bb10b6c2f5a76401c82f81021a MD5 | raw file
Possible License(s): MPL-2.0-no-copyleft-exception 
    

  1. ;;; SK8 Š 1997 by Apple Computer, Inc.
    2. 

  2. ;;; The code in this file is protected under the terms of the current SK8 License.
    3. 

  3. ;;; For information on this license, see http://sk8.research.apple.com
    4. 

  4. ;;; Apple Computer, Inc. -- Apple Research Laboratories
    5. 

  5. 

  6. 

  7. (in-package :SK8DEV)
    8. 

  8. 

  9. #|
    10. 

  10.   Implementation of the SK8 error (condition) system:
    11. 

  11.  The CommonLisp spec says that error conditions are supposed to be signaled via a call
    12. 

  12.  to error, and not simply by calling signal. MCL gives us a hook for calls to error
    13. 

  13.  that are not handled, by letting us define an application-error method on our application
    14. 

  14.  class. If we assume that error conditions we are interested in are always signaled via error
    15. 

  15.  and that the MCL code that is running will not set up any handlers, then we can implement
    16. 

  16.  a SK8 condition system as follows:
    17. 

  17. 

  18.  In application-error, look up the condition being passed in to find the corresponding
    19. 

  19.  SK8 condition object. If one is found, SK8-Signal that SK8 condition, passing it the
    20. 

  20.  Lisp condition instance.
    21. 

  21. 

  22.  The lookup can be done by setting up a hash table that maps Lisp conditions to their
    23. 

  23.  corresponding SK8 conditions. The table is fixed and is built at SK8 build time. Only
    24. 

  24.  those SK8 condition objects will take a Lisp condition instance as an argument to
    25. 

  25.  SK8-Signal and each will have a definition of a method that copies property values from
    26. 

  26.  the Lisp condition instance to the SK8 condition object.
    27. 

  27. 

  28.  SK8-Signal looks a lot like the MCL implementation of Signal. It goes through a list in
    29. 

  29.  a global (like %handlers%) popping items and looking for one that refers to a condition
    30. 

  30.  that is an ancestor of the one being signalled. The elements of the list are unique conses
    31. 

  31.  that are catch tags, set where the condition handler is defined. The first one that is
    32. 

  32.  found is thrown to.
    33. 

  33. 

  34.  The on error form sets up a catch and pushes the catch tag on the global that is used
    35. 

  35.  for the purpose. To make threads work, the global must be separately bound in each thread.
    36. 

  36.  A SK8Script on error form compiles into code similar to handler-case. The generated code
    37. 

  37.  produces a cons containing the symbol name of the condition, binds the global, pushes it
    38. 

  38.  on the global and sets up a catch with the cons as the tag. It isn't necessary for the
    39. 

  39.  condition object to exist at SK8Script compile time if the name will be used as the
    40. 

  40.  object name.
    41. 

  41. 

  42. |#
    43. 

  43. 

  44. #| Here is the error hierarchy as was defined in SK8 0.9, for reference
    45. 

  45.     (SK8::Error                     SK8::Condition            errorID)
    46. 

  46.     (SK8::GeneralError              SK8::Error                strings objects)
    47. 

  47.     (SK8::ScriptSyntaxError         SK8::Error                input errorPosition description)
    48. 

  48.     (SK8::ArithmeticError           SK8::Error                operation operands)
    49. 

  49.     (SK8::ProgrammaticError         SK8::Error                )
    50. 

  50.     (SK8::GeneralProgrammaticError  SK8::ProgrammaticError    )
    51. 

  51.     (SK8::DisposedObjectError       SK8::ProgrammaticError     object)
    52. 

  52.     (SK8::EventModeError            SK8::ProgrammaticError     eventMode)
    53. 

  53.     (SK8::TypeMismatchError         SK8::ProgrammaticError     object expectedType)
    54. 

  54.     (SK8::PropertyTypeMismatchError SK8::TypeMismatchError     ownerObject propertyName)
    55. 

  55.     (SK8::ArgumentTypeMismatchError SK8::TypeMismatchError     handlerName argumentName)
    56. 

  56.     (SK8::FileSystemError           SK8::Error                )
    57. 

  57.     (SK8::FileError                 SK8::FileSystemError       file)
    58. 

  58.     (SK8::ProjectImproperlyClosedError SK8::FileError                 )
    59. 

  59.     (SK8::SystemError               SK8::Error                )
    60. 

  60.     (SK8::ConditionSystemError      SK8::SystemError           originalCondition response #~errorCause)
    61. 

  61.     (SK8::MemoryFullError           SK8::SystemError               )
    62. 

  62.     (SK8::UnknownError              SK8::SystemError           arguments)
    63. 

  63.     (SK8::CompilationError          SK8::Error                )))
    64. 

  64.     (SK8::UnboundVariableError      SK8::ProgrammaticError      variableName)
    65. 

  65.     (SK8::UndefinedHandlerError     SK8::ProgrammaticError      handlerName arguments)    
    66. 

  66.     (SK8::IncorrectArgumentsError   SK8::ProgrammaticError      arguments handlerName)    
    67. 

  67.     (SK8::IncorrectSubscriptsError  SK8::ProgrammaticError      array rank)
    68. 

  68.     (SK8::IndexOutOfBoundsError     SK8::ProgrammaticError      index array
    69. 

  69.     (SK8::CoercionError             SK8::ProgrammaticError      object type)
    70. 

  70.     (SK8::NotAHandlerError          SK8::ProgrammaticError      object)
    71. 

  71.     (SK8::CantChangeConstantError   SK8::ProgrammaticError      constantName)
    72. 

  72.     (SK8::DivisionByZeroError       SK8::ArithmeticError          )
    73. 

  73.     (SK8::ArithmeticOverflowError   SK8::ArithmeticError          )
    74. 

  74.     (SK8::OSHeapFullError           SK8::MemoryFullError          )
    75. 

  75.     (SK8::FileMemoryFullError       SK8::MemoryFullError          )
    76. 

  76.     (SK8::SK8HeapFullError          SK8::MemoryFullError          )
    77. 

  77.     (SK8::StackOverflowError        SK8::MemoryFullError          )
    78. 

  78.     (SK8::NumberMemoryFullError     SK8::MemoryFullError          )
    79. 

  79.     (SK8::FileNotFoundError         SK8::FileError               file)
    80. 

  80.     (SK8::EndOfFileError            SK8::FileError               file)
    81. 

  81.     (SK8::IllegalFilenameError      SK8::FileError               file)
    82. 

  82.     (SK8::IODriverError             SK8::SystemError              )
    83. 

  83.     (SK8::DiskError                 SK8::FileSystemError         disk)
    84. 

  84.     (SK8::ClockError                SK8::SystemError              )
    85. 

  85.     (SK8::SerialPortError           SK8::SystemError              )
    86. 

  86.     (SK8::AppleTalkError            SK8::SystemError              )
    87. 

  87.     (SK8::ScrapManagerError         SK8::SystemError              )
    88. 

  88.     (SK8::MemoryManagerError        SK8::SystemError              )
    89. 

  89.     (SK8::DirectoryError            SK8::FileSystemError         SK8::directory)
    90. 

  90.     (SK8::MenuManagerError          SK8::SystemError              )
    91. 

  91.     (SK8::ResourceError             SK8::SystemError              )
    92. 

  92.     (SK8::SoundManagerError         SK8::SystemError              )
    93. 

  93.     (SK8::PPCToolboxError           SK8::SystemError              )
    94. 

  94.     (SK8::AppleEventError           SK8::SystemError             oserr)
    95. 

  95.     (SK8::MovieError                SK8::SystemError              )
    96. 

  96.     (SK8::MovieDataHandlerError     SK8::MovieError               )
    97. 

  97.     (SK8::ComponentManagerError     SK8::SystemError              )
    98. 

  98.     (SK8::ImageCompressionError     SK8::SystemError              )
    99. 

  99.     (SK8::MovieSequenceGrabberError SK8::MovieError               )
    100. 

  100.     (SK8::MovieControllerError      SK8::MovieError               )
    101. 

  101. 

  102. |#
    103. 

  103. 

  104. ;; define the condition system
    105. 

  105. 

  106. (new object :objectname "Condition" :project sk8 :properties '(sk8::MCLCondition))
    107. 

  107. (new SK8:Condition :objectname "Error" :project SK8)
    108. 

  108. (new SK8:Error :objectname "GeneralError" :project SK8 :properties '(sk8::strings sk8::objects))
    109. 

  109. (new SK8:Error :objectname "ArithmeticError" :project SK8 :properties '(sk8::operation sk8::operands))
    110. 

  110. (new SK8:GeneralError :objectname "ProgrammaticError" :project SK8)
    111. 

  111. (new SK8:ProgrammaticError :objectname "GeneralProgrammaticError" :project SK8)
    112. 

  112. (new SK8:ProgrammaticError :objectname "DisposedObjectError" :project SK8 :properties '(sk8::object))
    113. 

  113. (new SK8:ProgrammaticError :objectname "EventModeError" :project SK8 :properties '(sk8::eventMode))
    114. 

  114. (new SK8:ProgrammaticError :objectname "TypeMismatchError" :project SK8 :properties '(sk8::object sk8::expectedType))
    115. 

  115. (new SK8:TypeMismatchError :objectname "PropertyTypeMismatchError" :project SK8 :properties '(sk8::ownerObject sk8::propertyName))
    116. 

  116. (new SK8:TypeMismatchError :objectname "ArgumentTypeMismatchError" :project SK8 :properties '(sk8::handlerName sk8::argumentName))
    117. 

  117. (new SK8:Error :objectname "FileSystemError" :project SK8)
    118. 

  118. (new SK8:FileSystemError :objectname "FileError" :project SK8 :properties '(sk8::file))
    119. 

  119. (new SK8:FileError :objectname "ProjectImproperlyClosedError" :project SK8)
    120. 

  120. (new SK8:Error :objectname "SystemError" :project SK8)
    121. 

  121. (new SK8:SystemError :objectname "MemoryFullError" :project SK8)
    122. 

  122. (new SK8:SystemError :objectname "UnknownError" :project SK8 :properties '(sk8::arguments))
    123. 

  123. (new SK8:Error :objectname "CompilationError" :project SK8)
    124. 

  124. (new SK8:ProgrammaticError :objectname "UnboundVariableError" :project SK8 :properties '(sk8::variableName))
    125. 

  125. (new SK8:ProgrammaticError :objectname "UndefinedHandlerError" :project SK8 :properties '(sk8::handlerName sk8::arguments))
    126. 

  126. (new SK8:ProgrammaticError :objectname "IncorrectArgumentsError" :project SK8 :properties '(sk8::arguments sk8::handlerName))
    127. 

  127. (new SK8:ProgrammaticError :objectname "IncorrectSubscriptsError" :project SK8 :properties '(sk8::array sk8::rank))
    128. 

  128. (new SK8:ProgrammaticError :objectname "IndexOutOfBoundsError" :project SK8 :properties '(sk8::index sk8::array))
    129. 

  129. (new SK8:ProgrammaticError :objectname "CoercionError" :project SK8 :properties '(sk8::object sk8::type))
    130. 

  130. (new SK8:ProgrammaticError :objectname "NotAHandlerError" :project SK8)
    131. 

  131. (new SK8:ProgrammaticError :objectname "CantChangeConstantError" :project SK8 :properties '(sk8::constantName))
    132. 

  132. (new SK8:ArithmeticError :objectname "DivisionByZeroError" :project SK8)
    133. 

  133. (new SK8:ArithmeticError :objectname "ArithmeticOverflowError" :project SK8)
    134. 

  134. (new SK8:MemoryFullError :objectname "OSHeapFullError" :project SK8)
    135. 

  135. (new SK8:MemoryFullError :objectname "FileMemoryFullError" :project SK8)
    136. 

  136. (new SK8:MemoryFullError :objectname "SK8HeapFullError" :project SK8)
    137. 

  137. (new SK8:MemoryFullError :objectname "StackOverflowError" :project SK8)
    138. 

  138. (new SK8:MemoryFullError :objectname "NumberMemoryFullError" :project SK8)
    139. 

  139. (new SK8:FileError :objectname "FileNotFoundError" :project SK8)
    140. 

  140. (new SK8:FileError :objectname "EndOfFileError" :project SK8)
    141. 

  141. (new SK8:FileError :objectname "IllegalFilenameError" :project SK8)
    142. 

  142. (new SK8:SystemError :objectname "IODriverError" :project SK8)
    143. 

  143. (new SK8:FileSystemError :objectname "DiskError" :project SK8 :properties '(sk8::disk))
    144. 

  144. (new SK8:SystemError :objectname "ClockError" :project SK8)
    145. 

  145. (new SK8:SystemError :objectname "SerialPortError" :project SK8)
    146. 

  146. (new SK8:SystemError :objectname "AppleTalkError" :project SK8)
    147. 

  147. (new SK8:SystemError :objectname "ScrapManagerError" :project SK8)
    148. 

  148. (new SK8:SystemError :objectname "MemoryManagerError" :project SK8)
    149. 

  149. (new SK8:FileSystemError :objectname "DirectoryError" :project SK8 :properties '(SK8::directory))
    150. 

  150. (new SK8:SystemError :objectname "MenuManagerError" :project SK8)
    151. 

  151. (new SK8:SystemError :objectname "ResourceError" :project SK8)
    152. 

  152. (new SK8:SystemError :objectname "SoundManagerError" :project SK8)
    153. 

  153. (new SK8:SystemError :objectname "PPCToolboxError" :project SK8)
    154. 

  154. (new SK8:SystemError :objectname "AppleEventError" :project SK8 :properties '(sk8::oserr))
    155. 

  155. (new SK8:SystemError :objectname "MovieError" :project SK8)
    156. 

  156. (new SK8:MovieError :objectname "MovieDataHandlerError" :project SK8)
    157. 

  157. (new SK8:SystemError :objectname "ComponentManagerError" :project SK8)
    158. 

  158. (new SK8:SystemError :objectname "ImageCompressionError" :project SK8)
    159. 

  159. (new SK8:MovieError :objectname "MovieSequenceGrabberError" :project SK8)
    160. 

  160. (new SK8:MovieError :objectname "MovieControllerError" :project SK8)
    161. 

  161. 

  162. 

  163. ;; map MCL conditions to corresponding SK8 conditions.
    164. 

  164. ;; The simplest way is to just set the MCLCondition property. That's enough to cause the SK8 error handling
    165. 

  165. ;; system to catch the error properly and to use the MCL report-condition to generate the error message.
    166. 

  166. ;; If you want the SK8Script error handler to have access to the condition's properties, you also have
    167. 

  167. ;; to set them from the MCL condition's corresponding instance variables.
    168. 

  168. ;; If that is not done in any of the following it is simply because I did not take the time to do it all.
    169. 

  169. ;; Feel free to contribute.
    170. 

  170. 

  171. (defmethod condition-to-sk8-condition ((c error))
    172. 

  172.   (new sk8:error :project sk8 :MCLCondition c))
    173. 

  173. 

  174. (defmethod condition-to-sk8-condition ((c type-error))
    175. 

  175.   (new sk8:TypeMismatchError :project sk8 :MCLCondition c))
    176. 

  176. 

  177. (defmethod condition-to-sk8-condition ((c program-error))
    178. 

  178.   (new sk8:ProgrammaticError :project sk8 :MCLCondition c))
    179. 

  179. 

  180. (defmethod condition-to-sk8-condition ((c simple-error))
    181. 

  181.   (new sk8:GeneralError :project sk8 :MCLCondition c))
    182. 

  182. 

  183. (defmethod condition-to-sk8-condition ((c simple-type-error))
    184. 

  184.   (new sk8:TypeMismatchError :project sk8 :MCLCondition c))
    185. 

  185. 

  186. (defmethod condition-to-sk8-condition ((c ccl::simple-program-error))
    187. 

  187.   (new sk8:ProgrammaticError :project sk8 :MCLCondition c))
    188. 

  188. 

  189. (defmethod condition-to-sk8-condition ((c ccl::compile-time-error))
    190. 

  190.   (new sk8:CompilationError :project sk8 :MCLCondition c))
    191. 

  191. 

  192. (defmethod condition-to-sk8-condition ((c end-of-file))
    193. 

  193.   (new sk8:EndOfFileError :project sk8 :MCLCondition c))
    194. 

  194. 

  195. (defmethod condition-to-sk8-condition ((c file-error))
    196. 

  196.   (new sk8:FileSystemError :project sk8 :MCLCondition c))
    197. 

  197. 

  198. (defmethod condition-to-sk8-condition ((c unbound-variable))
    199. 

  199.   (new sk8:UnboundVariableError :project sk8 :MCLCondition c))
    200. 

  200. 

  201. (defmethod condition-to-sk8-condition ((c undefined-function))
    202. 

  202.   (new sk8:UndefinedHandlerError :project sk8 :MCLCondition c))
    203. 

  203. 

  204. (defmethod condition-to-sk8-condition ((c ccl::undefined-function-call))
    205. 

  205.   (new sk8:UndefinedHandlerError :project sk8 :MCLCondition c))
    206. 

  206. 

  207. (defmethod condition-to-sk8-condition ((c arithmetic-error))
    208. 

  208.   (new sk8:ArithmeticError :project sk8 :MCLCondition c))
    209. 

  209. 

  210. (defmethod condition-to-sk8-condition ((c division-by-zero))
    211. 

  211.   (new sk8:DivisionByZeroError :project sk8 :MCLCondition c))
    212. 

  212. 

  213. (defmethod condition-to-sk8-condition ((c floating-point-overflow))
    214. 

  214.   (new sk8:ArithmeticOverflowError :project sk8 :MCLCondition c))
    215. 

  215. 

  216. (defmethod condition-to-sk8-condition ((c appleevent-error))
    217. 

  217.   (new sk8:AppleEventError :project sk8 :MCLCondition c))
    218. 

  218. 

  219. 

  220. #|
    221. 

  221. 

  222. type-error TypeMismatchError
    223. 

  223. program-error ProgrammaticError
    224. 

  224. 

  225. simple-error GeneralError
    226. 

  226.  simple-type-error TypeMismatchError
    227. 

  227.  ccl::simple-program-error ProgrammaticError
    228. 

  228.    simple-destructuring-error
    229. 

  229.    compile-time-program-error
    230. 

  230.    eval-program-error
    231. 

  231.  ccl::compile-time-error CompilationError
    232. 

  232. 

  233. control-error
    234. 

  234. package-error
    235. 

  235.   no-such-package
    236. 

  236.   unintern-conflict-error
    237. 

  237.   import-conflict-error
    238. 

  238.   use-package-conflict-error
    239. 

  239.   export-conflict-error
    240. 

  240.   package-name-conflict-error    simple-error
    241. 

  241. 

  242. stream-error
    243. 

  243.   end-of-file EndOfFileError
    244. 

  244. modify-read-only-buffer
    245. 

  245. file-error FileSystemError
    246. 

  246. cell-error
    247. 

  247.   unbound-variable  UnboundVariableError
    248. 

  248.   undefined-function  UndefinedHandlerError
    249. 

  249.   ccl::undefined-function-call    UndefinedHandlerError
    250. 

  250. 

  251. arithmetic-error ArithmeticError
    252. 

  252.   division-by-zero  DivisionByZeroError
    253. 

  253.   floating-point-underflow
    254. 

  254.   floating-point-overflow ArithmeticOverflowError
    255. 

  255.   inexact-result
    256. 

  256.   invalid-operation
    257. 

  257. 

  258. appleevent-error AppleEventError
    259. 

  259. 

  260. eval-cant-cope
    261. 

  261. 

  262. simple-reader-error
    263. 

  263. 

  264. |#
    265. 

  265. 

  266. #|
    267. 

  267. ;;; Build the heirarchy of condition objects.
    268. 

  268. (loop for (name from-obj mcl-error)
    269. 

  269.       in '(("Error"                        SK8:Condition         error)
    270. 

  270.            ("GeneralError"                 SK8:Error             simple-error)
    271. 

  271.            ("ScriptSyntaxError"            SK8:Error             simple-error)
    272. 

  272.            ("ArithmeticError"              SK8:Error             arithmetic-error)
    273. 

  273.            ("ProgrammaticError"            SK8:GeneralError      simple-error)
    274. 

  274.            ("GeneralProgrammaticError"     SK8:ProgrammaticError simple-error)
    275. 

  275.            ("DisposedObjectError"          SK8:ProgrammaticError simple-error)
    276. 

  276.            ("EventModeError"               SK8:ProgrammaticError simple-error)
    277. 

  277.            ("TypeMismatchError"            SK8:ProgrammaticError type-error)
    278. 

  278.            ("PropertyTypeMismatchError"    SK8:TypeMismatchError type-error)
    279. 

  279.            ("ArgumentTypeMismatchError"    SK8:TypeMismatchError type-error)
    280. 

  280.            ("FileSystemError"              SK8:Error             file-error)
    281. 

  281.            ("FileError"                    SK8:FileSystemError   file-error)
    282. 

  282.            ("ProjectImproperlyClosedError" SK8:FileError         simple-error)
    283. 

  283.            ("SystemError"                  SK8:Error             simple-error)
    284. 

  284.            ("ConditionSystemError"         SK8:SystemError       simple-error)
    285. 

  285.            ("MemoryFullError"              SK8:SystemError       simple-error)
    286. 

  286.            ("UnknownError"                 SK8:SystemError       error)
    287. 

  287.            ("CompilationError"             SK8:Error             CCL::compile-time-error)
    288. 

  288.            ("UnboundVariableError"         SK8:ProgrammaticError unbound-variable)
    289. 

  289.            ("UndefinedHandlerError"        SK8:ProgrammaticError ccl::undefined-function-call)
    290. 

  290.            ("IncorrectArgumentsError"      SK8:ProgrammaticError simple-error)
    291. 

  291.            ("IncorrectSubscriptsError"     SK8:ProgrammaticError simple-error)
    292. 

  292.            ("IndexOutOfBoundsError"        SK8:ProgrammaticError simple-error)
    293. 

  293.            ("CoercionError"                SK8:ProgrammaticError simple-error)
    294. 

  294.            ("NotAHandlerError"             SK8:ProgrammaticError CCL::undefined-function-call)
    295. 

  295.            ("CantChangeConstantError"      SK8:ProgrammaticError simple-error)
    296. 

  296.            ("DivisionByZeroError"          SK8:ArithmeticError   division-by-zero)
    297. 

  297.            ("ArithmeticOverflowError"      SK8:ArithmeticError   floating-point-error)
    298. 

  298.            ("OSHeapFullError"              SK8:MemoryFullError   simple-error)
    299. 

  299.            ("FileMemoryFullError"          SK8:MemoryFullError   simple-error)
    300. 

  300.            ("SK8HeapFullError"             SK8:MemoryFullError   simple-error)
    301. 

  301.            ("StackOverflowError"           SK8:MemoryFullError   simple-error)
    302. 

  302.            ("NumberMemoryFullError"        SK8:MemoryFullError   simple-error)
    303. 

  303.            ("FileNotFoundError"            SK8:FileError         simple-error)
    304. 

  304.            ("EndOfFileError"               SK8:FileError         end-of-file)
    305. 

  305.            ("IllegalFilenameError"         SK8:FileError         simple-error)
    306. 

  306.            ("IODriverError"                SK8:SystemError       simple-error)
    307. 

  307.            ("DiskError"                    SK8:FileSystemError   simple-error)
    308. 

  308.            ("ClockError"                   SK8:SystemError       simple-error)
    309. 

  309.            ("SerialPortError"              SK8:SystemError       simple-error)
    310. 

  310.            ("AppleTalkError"               SK8:SystemError       simple-error)
    311. 

  311.            ("ScrapManagerError"            SK8:SystemError       simple-error)
    312. 

  312.            ("MemoryManagerError"           SK8:SystemError       simple-error)
    313. 

  313.            ("DirectoryError"               SK8:FileSystemError   simple-error)
    314. 

  314.            ("MenuManagerError"             SK8:SystemError       simple-error)
    315. 

  315.            ("ResourceError"                SK8:SystemError       simple-error)
    316. 

  316.            ("SoundManagerError"            SK8:SystemError       simple-error)
    317. 

  317.            ("PPCToolboxError"              SK8:SystemError       simple-error)
    318. 

  318.            ("AppleEventError"              SK8:SystemError       appleevent-error)
    319. 

  319.            ("MovieError"                   SK8:SystemError       simple-error)
    320. 

  320.            ("MovieDataHandlerError"        SK8:MovieError        simple-error)
    321. 

  321.            ("ComponentManagerError"        SK8:SystemError       simple-error)
    322. 

  322.            ("ImageCompressionError"        SK8:SystemError       simple-error)
    323. 

  323.            ("MovieSequenceGrabberError"    SK8:MovieError        simple-error)
    324. 

  324.            ("MovieControllerError"         SK8:MovieError        simple-error))
    325. 

  325.       doing (new (symbol-value from-obj) :project sk8 :objectname name :mcl-error-class mcl-error))
    326. 

  326. |#
    327. 

  327. 

  328. (defvar %error-handlers% nil)
    329. 

  329. 

  330. ;;; The SK8 user function to signal a condition.
    331. 

  331. ;;; This mates with the on-condition compiler in compile-let-forms in skil-compiler.lisp.
    332. 

  332. ;;;
    333. 

  333. (define-handler sk8-signal (sk8:condition)
    334. 

  334.   (dolist (tag %error-handlers%)
    335. 

  335.     (loop for (cond fn) on tag by #'cddr
    336. 

  336.           doing 
    337. 

  337.           (when (and (symbolp cond) (boundp cond) (sk8:inheritsfrom me (symbol-value cond)))
    338. 

  338.             (cond ((null fn) (throw tag me)) ;; with-sk8-error-handler with one error clause
    339. 

  339.                   ((fixnump fn) (throw tag (cons fn me))) ;; with-sk8-error-handler with multiple error clause: generates one catch tag which dipatches on the index
    340. 

  340.                   (t (return (funcall fn me))))  ;; copied from CLOS condition system. Not used in SK8 yet so should never execute
    341. 

  341.             )))
    342. 

  342.   ;; Okay, no SK8 signal handlers.  Just return. If this is an an error, the default error handling will take it
    343. 

  343.   )
    344. 

  344. 

  345. (define-sk8-function sk8::sk8-error nil (type &rest args)
    346. 

  346.   (when (inheritsfrom type sk8:condition)
    347. 

  347.     (let ((cnd (apply #'new type :project sk8 args)))
    348. 

  348.       (sk8-signal cnd)
    349. 

  349.       ;; it is an error if it returns
    350. 

  350.       (error (with-output-to-string (s) (writeobject cnd s nil))))))
    351. 

  351. 

  352. ;; here is the form generated by the skil compiler for on error code. It is similar to handler-case
    353. 

  353. (defmacro sk8::with-sk8-error-handlers (form &rest clauses)
    354. 

  354.   (cond ((null clauses) form)
    355. 

  355.         ((null (cdr clauses))
    356. 

  356.          (let ((block   (gensym))
    357. 

  357.                (cluster (gensym)))
    358. 

  358.            (let ((type (caar clauses))
    359. 

  359.                  (body (cdar clauses)))
    360. 

  360.              `(block ,block
    361. 

  361.                 ((lambda (currentCondition) (declare (special currentCondition)) ,@body)
    362. 

  362.                  (let* ((,cluster (list ',type))
    363. 

  363.                         (%error-handlers% (cons ,cluster %error-handlers%)))
    364. 

  364.                    (declare (dynamic-extent ,cluster %error-handlers%))
    365. 

  365.                    (catch ,cluster (return-from ,block ,form))))))))
    366. 

  366.         (t (let ((block (gensym)) (cluster (gensym)) (val (gensym))
    367. 

  367.                  (index -1) handlers cases)
    368. 

  368.              (loop (unless clauses (return nil))
    369. 

  369.                    (setq index (1+ index))
    370. 

  370.                    (let* ((clause (pop clauses))
    371. 

  371.                           (type (car clause))
    372. 

  372.                           (body (cdr clause)))
    373. 

  373.                      (push `',type handlers)
    374. 

  374.                      (push index handlers)
    375. 

  375.                      (when (null clauses) (setq index t))
    376. 

  376.                      (push `(,index ((lambda (currentCondition) (declare (special currentCondition)) ,@body) ,val)) cases)))
    377. 

  377.              `(block ,block
    378. 

  378.                 (let ((,val (let* ((,cluster (list ,@(nreverse handlers)))
    379. 

  379.                                    (%error-handlers% (cons ,cluster %error-handlers%)))
    380. 

  380.                               (declare (dynamic-extent ,cluster %error-handlers%))
    381. 

  381.                               (catch ,cluster (return-from ,block ,form)))))
    382. 

  382.                   (case (pop ,val)
    383. 

  383.                     ,@(nreverse cases))))))))
    384. 

  384. 

  385. #|
    386. 

  386. 	Change History (most recent last):
    387. 

  387. 	2  	10/18/96	sidney  	Implement a SK8 error system
    388. 

  388. 	3  	10/18/96	sidney  	create the anonymous error objects in the SK8 project. Make sk8-error an error if it returns
    389. 

  389. 	4  	 2/27/97	Hernan  	
    390. 

  390. 	5  	 2/27/97	Hernan  	
    391. 

  391. |# ;(do not edit past this line!!)
    392. 

  392.