(return nil)))
(setf (getf (condition-assigned-slots res) (condition-slot-name hslot))
(find-slot-default class hslot))))
-
res))
\f
;;;; DEFINE-CONDITION
;;; regression tests cheerfully passed because they assumed that
;;; unFBOUNDPness meant they were running on an system which didn't
;;; support the extension.)
-(define-condition unsupported-operator (cell-error) ()
- (:report
- (lambda (condition stream)
- (format stream
- "unsupported on this platform (OS, CPU, whatever): ~S"
- (cell-error-name condition)))))
+(define-condition unsupported-operator (simple-error) ())
+
\f
;;; (:ansi-cl :function remove)
;;; (:ansi-cl :section (a b c))
;;; FIXME: this is not the right place for this.
(defun print-reference (reference stream)
(ecase (car reference)
+ (:amop
+ (format stream "AMOP")
+ (format stream ", ")
+ (destructuring-bind (type data) (cdr reference)
+ (ecase type
+ (:generic-function (format stream "Generic Function ~S" data))
+ (:section (format stream "Section ~{~D~^.~}" data)))))
(:ansi-cl
(format stream "The ANSI Standard")
(format stream ", ")
(destructuring-bind (type data) (cdr reference)
(ecase type
(:node (format stream "Node ~S" data))
- (:variable (format stream "Variable ~S" data)))))
- ;; FIXME: other documents (e.g. AMOP, Franz documentation :-)
+ (:variable (format stream "Variable ~S" data))
+ (:function (format stream "Function ~S" data)))))
+ ;; FIXME: other documents (e.g. CLIM, Franz documentation :-)
))
(define-condition reference-condition ()
((references :initarg :references :reader reference-condition-references)))
(def!method print-object :around ((o reference-condition) s)
(call-next-method)
(unless (or *print-escape* *print-readably*)
- (when *print-condition-references*
+ (when (and *print-condition-references*
+ (reference-condition-references o))
(format s "~&See also:~%")
(pprint-logical-block (s nil :per-line-prefix " ")
(do* ((rs (reference-condition-references o) (cdr rs))
(print-reference r s)
(unless (null (cdr rs))
(terpri s)))))))
-
+
(define-condition duplicate-definition (reference-condition warning)
((name :initarg :name :reader duplicate-definition-name))
(:report (lambda (c s)
:reader package-error-format-arguments))
(:report
(lambda (condition stream)
- (let ((control (package-error-format-control condition))
- (*print-pretty* nil))
+ (let ((control (package-error-format-control condition)))
(if control
- (format stream "Package lock on ~S violated when ~?."
- (package-error-package condition)
- control
- (package-error-format-arguments condition))
- (format stream "Package lock on ~S violated."
- (package-error-package condition))))))
+ (apply #'format stream
+ (format nil "~~@<Lock on package ~A violated when ~A.~~:@>"
+ (package-name (package-error-package condition))
+ control)
+ (package-error-format-arguments condition))
+ (format stream "~@<Lock on package ~A violated.~:@>"
+ (package-name (package-error-package condition)))))))
;; no :default-initargs -- reference-stuff provided by the
;; signalling form in target-package.lisp
#!+sb-doc
"Subtype of SB-EXT:PACKAGE-LOCK-VIOLATION. An error of this type is
signalled when an operation on a package violates a package lock."))
-
(define-condition symbol-package-locked-error (package-lock-violation)
((symbol :initarg :symbol :reader package-locked-error-symbol))
#!+sb-doc
;;;; setup of CONDITION machinery, only because that makes it easier to
;;;; get cold init to work.
+;;; OAOOM warning: see cross-condition.lisp
+(define-condition encapsulated-condition (condition)
+ ((condition :initarg :condition :reader encapsulated-condition)))
+
(define-condition values-type-error (type-error)
()
(:report
(reader-impossible-number-error-error condition))))))
(define-condition timeout (serious-condition) ())
+
+;;; Single stepping conditions
+
+(define-condition step-condition ()
+ ((form :initarg :form :reader step-condition-form))
+ #!+sb-doc
+ (:documentation "Common base class of single-stepping conditions.
+STEP-CONDITION-FORM holds a string representation of the form being
+stepped."))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-form 'function)
+ "Form associated with the STEP-CONDITION.")
+
+(define-condition step-form-condition (step-condition)
+ ((source-path :initarg :source-path :reader step-condition-source-path)
+ (pathname :initarg :pathname :reader step-condition-pathname))
+ #!+sb-doc
+ (:documentation "Condition signalled by code compiled with
+single-stepping information when about to execute a form.
+STEP-CONDITION-FORM holds the form, STEP-CONDITION-PATHNAME holds the
+pathname of the original file or NIL, and STEP-CONDITION-SOURCE-PATH
+holds the source-path to the original form within that file or NIL.
+Associated with this condition are always the restarts STEP-INTO,
+STEP-NEXT, and STEP-CONTINUE."))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-source-path 'function)
+ "Source-path of the original form associated with the
+STEP-FORM-CONDITION or NIL."
+ (fdocumentation 'step-condition-pathname 'function)
+ "Pathname of the original source-file associated with the
+STEP-FORM-CONDITION or NIL.")
+
+(define-condition step-result-condition (step-condition)
+ ((result :initarg :result :reader step-condition-result)))
+
+#!+sb-doc
+(setf (fdocumentation 'step-condition-result 'function)
+ "Return values associated with STEP-VALUES-CONDITION as a list,
+or the variable value associated with STEP-VARIABLE-CONDITION.")
+
+(define-condition step-values-condition (step-result-condition)
+ ()
+ #!+sb-doc
+ (:documentation "Condition signalled by code compiled with
+single-stepping information after executing a form.
+STEP-CONDITION-FORM holds the form, and STEP-CONDITION-RESULT holds
+the values returned by the form as a list. No associated restarts."))
+
+(define-condition step-variable-condition (step-result-condition)
+ ()
+ #!+sb-doc
+ (:documentation "Condition signalled by code compiled with
+single-stepping information when referencing a variable.
+STEP-CONDITION-FORM hold the symbol, and STEP-CONDITION-RESULT holds
+the value of the variable. No associated restarts."))
+
\f
;;;; restart definitions
"Transfer control and VALUE to a restart named USE-VALUE, or return NIL if
none exists."))
+;;; single-stepping restarts
+
+(macrolet ((def (name doc)
+ #!-sb-doc (declare (ignore doc))
+ `(defun ,name (condition)
+ #!+sb-doc ,doc
+ (invoke-restart (find-restart-or-control-error ',name condition)))))
+ (def step-continue
+ "Transfers control to the STEP-CONTINUE restart associated with
+the condition, continuing execution without stepping. Signals a
+CONTROL-ERROR if the restart does not exist.")
+ (def step-next
+ "Transfers control to the STEP-NEXT restart associated with the
+condition, executing the current form without stepping and continuing
+stepping with the next form. Signals CONTROL-ERROR is the restart does
+not exists.")
+ (def step-into
+ "Transfers control to the STEP-INTO restart associated with the
+condition, stepping into the current form. Signals a CONTROL-ERROR is
+the restart does not exist."))
+
(/show0 "condition.lisp end of file")
projects / sbcl.git / blobdiff