1.0.29.18: delete more debugging cruft that should never have been committed

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 07dca98..317d8bc 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -648,6 +648,11 @@
              "end of file on ~S"
              (stream-error-stream condition)))))
 
+(define-condition closed-stream-error (stream-error) ()
+  (:report
+   (lambda (condition stream)
+     (format stream "~S is closed" (stream-error-stream condition)))))
+
 (define-condition file-error (error)
   ((pathname :reader file-error-pathname :initarg :pathname))
   (:report
@@ -903,6 +908,9 @@
 (define-condition simple-reference-error (reference-condition simple-error)
   ())
 
+(define-condition simple-reference-warning (reference-condition simple-warning)
+  ())
+
 (define-condition duplicate-definition (reference-condition warning)
   ((name :initarg :name :reader duplicate-definition-name))
   (:report (lambda (c s)
@@ -946,12 +954,6 @@
                    '(:ansi-cl :function make-array)
                    '(:ansi-cl :function sb!xc:upgraded-array-element-type))))
 
-(define-condition displaced-to-array-too-small-error
-    (reference-condition simple-error)
-  ()
-  (:default-initargs
-      :references (list '(:ansi-cl :function adjust-array))))
-
 (define-condition type-warning (reference-condition simple-warning)
   ()
   (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
@@ -1093,6 +1095,36 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
                     "No traps are enabled? How can this be?"
                     stream))))))
 
+(define-condition invalid-array-index-error (type-error)
+  ((array :initarg :array :reader invalid-array-index-error-array)
+   (axis :initarg :axis :reader invalid-array-index-error-axis))
+  (:report
+   (lambda (condition stream)
+     (let ((array (invalid-array-index-error-array condition)))
+       (format stream "Index ~W out of bounds for ~@[axis ~W of ~]~S, ~
+                       should be nonnegative and <~W."
+               (type-error-datum condition)
+               (when (> (array-rank array) 1)
+                 (invalid-array-index-error-axis condition))
+               (type-of array)
+               ;; Extract the bound from (INTEGER 0 (BOUND))
+               (caaddr (type-error-expected-type condition)))))))
+
+(define-condition invalid-array-error (reference-condition type-error) ()
+  (:report
+   (lambda (condition stream)
+     (let ((*print-array* nil))
+       (format stream
+               "~@<Displaced array originally of type ~S has been invalidated ~
+                due its displaced-to array ~S having become too small to hold ~
+                it: the displaced array's dimensions have all been set to zero ~
+                to trap accesses to it.~:@>"
+               (type-error-expected-type condition)
+               (array-displacement (type-error-datum condition))))))
+  (:default-initargs
+      :references
+      (list '(:ansi-cl :function adjust-array))))
+
 (define-condition index-too-large-error (type-error)
   ()
   (:report
@@ -1177,6 +1209,14 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
                (simple-condition-format-arguments condition)
                (reader-impossible-number-error-error condition))))))
 
+(define-condition standard-readtable-modified-error (reference-condition error)
+  ((operation :initarg :operation :reader standard-readtable-modified-operation))
+  (:report (lambda (condition stream)
+             (format stream "~S would modify the standard readtable."
+                     (standard-readtable-modified-operation condition))))
+  (:default-initargs :references `((:ansi-cl :section (2 1 1 2))
+                                   (:ansi-cl :glossary "standard readtable"))))
+
 (define-condition timeout (serious-condition)
   ((seconds :initarg :seconds :initform nil :reader timeout-seconds))
   (:report (lambda (condition stream)
@@ -1276,8 +1316,9 @@ the values returned by the form as a list. No associated restarts."))
 \f
 ;;; A knob for muffling warnings, mostly for use while loading files.
 (defvar *muffled-warnings* 'uninteresting-redefinition
-  "A type that ought to specify a subtype of WARNING.  Whenever a warning
-is signaled, if the warning if of this type, it will be muffled.")
+  "A type that ought to specify a subtype of WARNING.  Whenever a
+warning is signaled, if the warning if of this type and is not
+handled by any other handler, it will be muffled.")
 \f
 ;;; Various STYLE-WARNING signaled in the system.
 ;; For the moment, we're only getting into the details for function