#(#! (lisp::in-package "SERROR" :use (lisp::quote ("SLOOP" "LISP")))#! (lisp::export (lisp::quote (serror::def-error-type serror::cond-error serror::cond-any-error serror::condition-case serror::error-name serror::error-string serror::error-continue-string serror::error-format-args)) "SERROR") #(serror::error-condition (lisp::ignore) "CATCH-TAG" lisp::catch lisp::quote lisp::return-from serror::cond-error-continue lisp::unwind-protect lisp::progn lisp::vector-push-extend lisp::function lisp::lambda lisp::if lisp::or serror::*catch-error-stack* (lisp::incf (lisp::the lisp::fixnum (lisp::fill-pointer serror::*catch-error-stack*)) -1) lisp::cond ((lisp::t (lisp::format lisp::t "should not get here"))) lisp::multiple-value-bind lisp::block lisp::let ((serror::*catch-error* lisp::t)) (lisp::quote :any-error) serror::inf-signal serror::*show-all-debug-info* :name :string :function :continue-string :format-args :error-handler-args serror::*catch-error* :any-error serror::*error-handler-function* :old-definition "~a-tester" lisp::eval-when (lisp::compile lisp::eval lisp::load) lisp::defun lisp::deftype lisp::list #0=(lisp::quote lisp::and) #1=(lisp::quote serror::error-condition) #2=(lisp::quote lisp::satisfies) :wrong-type-arg lisp::and lisp::satisfies serror::|WTA-tester| "The first index, ~S, to the array~%~S is too large." serror::|SUBSCRIPT-OUT-OF-BOUNDS-tester| :error serror::|ERROR-tester| :wrong-type-argument serror::|WRONG-TYPE-ARGUMENT-tester| :too-few-arguments serror::|TOO-FEW-ARGUMENTS-tester| :too-many-arguments serror::|TOO-MANY-ARGUMENTS-tester| :unexpected-keyword serror::|UNEXPECTED-KEYWORD-tester| :invalid-form serror::|INVALID-FORM-tester| :unbound-variable serror::|UNBOUND-VARIABLE-tester| :invalid-variable serror::|INVALID-VARIABLE-tester| :undefined-function serror::|UNDEFINED-FUNCTION-tester| :invalid-function serror::|INVALID-FUNCTION-tester| serror::cond-error lisp::typep system::simple-backtrace system::backtrace system::break-vs lisp::fifth serror::make-error-condition (system::%init . #((system::*make-special (lisp::quote serror::*error-handler-function*)) (lisp::or (lisp::boundp (lisp::quote serror::*error-handler-function*)) (lisp::setq serror::*error-handler-function* (lisp::quote system::universal-error-handler))) (lisp::or (lisp::get serror::*error-handler-function* :old-definition) (lisp::setf (lisp::get serror::*error-handler-function* :old-definition) (lisp::symbol-function serror::*error-handler-function*))) (system::define-structure (lisp::quote serror::error-condition) (lisp::quote serror::error-) (lisp::quote lisp::nil) (lisp::quote lisp::nil) (lisp::quote lisp::t) (lisp::quote ((serror::name lisp::nil lisp::t lisp::nil 0) (lisp::string lisp::nil lisp::t lisp::nil 1) (lisp::function lisp::nil lisp::t lisp::nil 2) (serror::continue-string lisp::nil lisp::t lisp::nil 3) (serror::format-args lisp::nil lisp::t lisp::nil 4) (serror::error-handler-args lisp::nil lisp::t lisp::nil 5))) (lisp::quote serror::copy-error-condition) (lisp::quote lisp::nil) (lisp::quote lisp::nil) (lisp::quote lisp::nil) (lisp::quote (serror::make-error-condition)) (lisp::quote 6) (lisp::quote serror::error-condition-p) (lisp::quote lisp::nil)) (system::mf (lisp::quote serror::make-error-condition) 0) (system::*make-special (lisp::quote serror::*catch-error*)) (system::putprop (lisp::quote serror::*catch-error*) "If t errors will throw to :any-error tag" #3=(lisp::quote system::variable-documentation)) (lisp::setq serror::*catch-error* lisp::nil) (system::*make-special (lisp::quote serror::*disable-catch-error*)) (system::putprop (lisp::quote serror::*disable-catch-error*) "If t only regular error handler will be used" #3#) (lisp::setq serror::*disable-catch-error* lisp::nil) (system::*make-special (lisp::quote serror::*catch-error-stack*)) (system::putprop (lisp::quote serror::*catch-error-stack*) "If t only regular error handler will be used" #3#) (lisp::setq serror::*catch-error-stack* (lisp::make-array 30 :fill-pointer 0)) (system::*make-special (lisp::quote serror::*show-all-debug-info*)) (system::putprop (lisp::quote serror::*show-all-debug-info*) "Set to t if not running interactively" (lisp::quote system::variable-documentation)) (lisp::or (lisp::boundp (lisp::quote serror::*show-all-debug-info*)) (lisp::setq serror::*show-all-debug-info* lisp::nil)) (system::putprop (lisp::quote serror::cond-error) "If a condition is signalled during evaluation of body-form, The first of VARIABLES is bound to the condition, and the clauses are evaluated like cond clauses. Note if the conditions involve lexical variables other than VARIABLES, there will be a new lexical closure cons'd each time through this!! eg: (cond-error (er) (1+ u) ((null u) (princ er) (princ \"null arg to u\")) ((symbolp u) (princ \"symbol arg\")) (t 0))" #4=(lisp::quote system::function-documentation)) (system::putprop (lisp::quote serror::cond-error) (lisp::quote 2) #5=(lisp::quote system::pretty-print-format)) (system::mm (lisp::quote serror::cond-error) 1) (system::putprop (lisp::quote serror::cond-any-error) "If a condition is signalled during evaluation of body-form, The first of VARIABLES is bound to the condition, and the clauses are evaluated like cond clauses, If the cond falls off the end, then the error is signaled at this point in the stack. For the moment the rest of the VARIABLES are ignored. eg: (cond-error (er) (1+ u) ((null u) (princ er) (princ \"null arg to u\")) ((symbolp u) (princ \"symbol arg\")) (t 0))" #4#) (system::putprop (lisp::quote serror::cond-any-error) (lisp::quote 2) #5#) (system::mm (lisp::quote serror::cond-any-error) 2) (system::mfvfun (lisp::quote system::universal-error-handler) 3 16384) (system::mf (lisp::quote serror::inf-signal) 4) (system::putprop (lisp::quote serror::def-error-type) (lisp::quote 2) #5#) (system::mm (lisp::quote serror::def-error-type) 5) (system::mf (lisp::quote serror::|WTA-tester|) 6) (system::putprop (lisp::quote serror::wta) (lisp::quote (lisp::deftype serror::wta lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|WTA-tester|))))) #6=(lisp::quote system::deftype-form)) (system::mf (lisp::quote #7=#:g1387) 7) (system::putprop (lisp::quote serror::wta) (lisp::symbol-function (lisp::quote #7#)) #8=(lisp::quote system::deftype-definition)) (system::putprop (lisp::quote serror::wta) lisp::nil #9=(lisp::quote system::type-documentation)) (system::mf (lisp::quote serror::|SUBSCRIPT-OUT-OF-BOUNDS-tester|) 8) (system::putprop (lisp::quote serror::subscript-out-of-bounds) (lisp::quote (lisp::deftype serror::subscript-out-of-bounds lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|SUBSCRIPT-OUT-OF-BOUNDS-tester|))))) #6#) (system::mf (lisp::quote #10=#:g1388) 9) (system::putprop (lisp::quote serror::subscript-out-of-bounds) (lisp::symbol-function (lisp::quote #10#)) #8#) (system::putprop (lisp::quote serror::subscript-out-of-bounds) lisp::nil #9#) (system::mf (lisp::quote serror::|ERROR-tester|) 10) (system::putprop (lisp::quote lisp::error) (lisp::quote (lisp::deftype lisp::error lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|ERROR-tester|))))) #6#) (system::mf (lisp::quote #11=#:g1389) 11) (system::putprop (lisp::quote lisp::error) (lisp::symbol-function (lisp::quote #11#)) #8#) (system::putprop (lisp::quote lisp::error) lisp::nil #9#) (system::mf (lisp::quote serror::|WRONG-TYPE-ARGUMENT-tester|) 12) (system::putprop (lisp::quote serror::wrong-type-argument) (lisp::quote (lisp::deftype serror::wrong-type-argument lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|WRONG-TYPE-ARGUMENT-tester|))))) #6#) (system::mf (lisp::quote #12=#:g1390) 13) (system::putprop (lisp::quote serror::wrong-type-argument) (lisp::symbol-function (lisp::quote #12#)) #8#) (system::putprop (lisp::quote serror::wrong-type-argument) lisp::nil #9#) (system::mf (lisp::quote serror::|TOO-FEW-ARGUMENTS-tester|) 14) (system::putprop (lisp::quote serror::too-few-arguments) (lisp::quote (lisp::deftype serror::too-few-arguments lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|TOO-FEW-ARGUMENTS-tester|))))) #6#) (system::mf (lisp::quote #13=#:g1391) 15) (system::putprop (lisp::quote serror::too-few-arguments) (lisp::symbol-function (lisp::quote #13#)) #8#) (system::putprop (lisp::quote serror::too-few-arguments) lisp::nil #9#) (system::mf (lisp::quote serror::|TOO-MANY-ARGUMENTS-tester|) 16) (system::putprop (lisp::quote serror::too-many-arguments) (lisp::quote (lisp::deftype serror::too-many-arguments lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|TOO-MANY-ARGUMENTS-tester|))))) #6#) (system::mf (lisp::quote #14=#:g1392) 17) (system::putprop (lisp::quote serror::too-many-arguments) (lisp::symbol-function (lisp::quote #14#)) #8#) (system::putprop (lisp::quote serror::too-many-arguments) lisp::nil #9#) (system::mf (lisp::quote serror::|UNEXPECTED-KEYWORD-tester|) 18) (system::putprop (lisp::quote serror::unexpected-keyword) (lisp::quote (lisp::deftype serror::unexpected-keyword lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|UNEXPECTED-KEYWORD-tester|))))) #6#) (system::mf (lisp::quote #15=#:g1393) 19) (system::putprop (lisp::quote serror::unexpected-keyword) (lisp::symbol-function (lisp::quote #15#)) #8#) (system::putprop (lisp::quote serror::unexpected-keyword) lisp::nil #9#) (system::mf (lisp::quote serror::|INVALID-FORM-tester|) 20) (system::putprop (lisp::quote serror::invalid-form) (lisp::quote (lisp::deftype serror::invalid-form lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|INVALID-FORM-tester|))))) #6#) (system::mf (lisp::quote #16=#:g1394) 21) (system::putprop (lisp::quote serror::invalid-form) (lisp::symbol-function (lisp::quote #16#)) #8#) (system::putprop (lisp::quote serror::invalid-form) lisp::nil #9#) (system::mf (lisp::quote serror::|UNBOUND-VARIABLE-tester|) 22) (system::putprop (lisp::quote lisp::unbound-variable) (lisp::quote (lisp::deftype lisp::unbound-variable lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|UNBOUND-VARIABLE-tester|))))) #6#) (system::mf (lisp::quote #17=#:g1395) 23) (system::putprop (lisp::quote lisp::unbound-variable) (lisp::symbol-function (lisp::quote #17#)) #8#) (system::putprop (lisp::quote lisp::unbound-variable) lisp::nil #9#) (system::mf (lisp::quote serror::|INVALID-VARIABLE-tester|) 24) (system::putprop (lisp::quote serror::invalid-variable) (lisp::quote (lisp::deftype serror::invalid-variable lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|INVALID-VARIABLE-tester|))))) #6#) (system::mf (lisp::quote #18=#:g1396) 25) (system::putprop (lisp::quote serror::invalid-variable) (lisp::symbol-function (lisp::quote #18#)) #8#) (system::putprop (lisp::quote serror::invalid-variable) lisp::nil #9#) (system::mf (lisp::quote serror::|UNDEFINED-FUNCTION-tester|) 26) (system::putprop (lisp::quote lisp::undefined-function) (lisp::quote (lisp::deftype lisp::undefined-function lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|UNDEFINED-FUNCTION-tester|))))) #6#) (system::mf (lisp::quote #19=#:g1397) 27) (system::putprop (lisp::quote lisp::undefined-function) (lisp::symbol-function (lisp::quote #19#)) #8#) (system::putprop (lisp::quote lisp::undefined-function) lisp::nil #9#) (system::mf (lisp::quote serror::|INVALID-FUNCTION-tester|) 28) (system::putprop (lisp::quote serror::invalid-function) (lisp::quote (lisp::deftype serror::invalid-function lisp::nil (lisp::list #0# #1# (lisp::list #2# (lisp::quote serror::|INVALID-FUNCTION-tester|))))) #6#) (system::mf (lisp::quote #20=#:g1398) 29) (system::putprop (lisp::quote serror::invalid-function) (lisp::symbol-function (lisp::quote #20#)) #8#) (system::putprop (lisp::quote serror::invalid-function) lisp::nil #9#) (system::mm (lisp::quote serror::condition-case) 30)))) )