0.pre7.124:
[sbcl.git] / src / code / interr.lisp
index 71e1783..231992d 100644 (file)
         ;; he ended up inside the system error-handling logic.
         (declare (ignorable name ,fp ,context ,sc-offsets))
         (let (,@(let ((offset -1))
-                  (mapcar #'(lambda (var)
-                              `(,var (sb!di::sub-access-debug-var-slot
-                                      ,fp
-                                      (nth ,(incf offset)
-                                           ,sc-offsets)
-                                      ,context)))
+                  (mapcar (lambda (var)
+                            `(,var (sb!di::sub-access-debug-var-slot
+                                    ,fp
+                                    (nth ,(incf offset)
+                                         ,sc-offsets)
+                                    ,context)))
                           required))
               ,@(when rest-pos
                   `((,(nth (1+ rest-pos) args)
-                     (mapcar #'(lambda (sc-offset)
-                                 (sb!di::sub-access-debug-var-slot
-                                  ,fp
-                                  sc-offset
-                                  ,context))
+                     (mapcar (lambda (sc-offset)
+                               (sb!di::sub-access-debug-var-slot
+                                ,fp
+                                sc-offset
+                                ,context))
                              (nthcdr ,rest-pos ,sc-offsets))))))
           ,@body))
        (setf (svref *internal-errors* ,(error-number-or-lose name))
         :datum object
         :expected-type 'fixnum))
 
-(deferr object-not-function-or-symbol-error (object)
-  (error 'type-error
-        :datum object
-        :expected-type '(or function symbol)))
-
 (deferr object-not-vector-error (object)
   (error 'type-error
         :datum object
 (deferr invalid-array-index-error (array bound index)
   (error 'simple-error
         :format-control
-        "invalid array index ~D for ~S (should be nonnegative and <~D)"
+        "invalid array index ~W for ~S (should be nonnegative and <~W)"
         :format-arguments (list index array bound)))
 
 (deferr object-not-simple-array-error (object)
 \f
 ;;;; INTERNAL-ERROR signal handler
 
+(defvar *internal-error-arguments*)
+
 (defun internal-error (context continuable)
   (declare (type system-area-pointer context))
   (declare (ignore continuable))
         (sb!vm:internal-error-arguments alien-context)
        (/show0 "back from INTERNAL-ERROR-ARGUMENTS, ERROR-NUMBER=..")
        (/hexstr error-number)
-       (/show0 "ARGUMENTS=..")
+       (/show0 "cold/low ARGUMENTS=..")
        (/hexstr arguments)
+
        (multiple-value-bind (name sb!debug:*stack-top-hint*)
           (find-interrupted-name)
         (/show0 "back from FIND-INTERRUPTED-NAME")
           (cond ((null handler)
                  (error 'simple-error
                         :format-control
-                        "unknown internal error, ~D? args=~S"
+                        "unknown internal error, ~D, args=~S"
                         :format-arguments
                         (list error-number
-                              (mapcar #'(lambda (sc-offset)
-                                          (sb!di::sub-access-debug-var-slot
-                                           fp sc-offset alien-context))
+                              (mapcar (lambda (sc-offset)
+                                        (sb!di::sub-access-debug-var-slot
+                                         fp sc-offset alien-context))
                                       arguments))))
                 ((not (functionp handler))
                  (error 'simple-error
                         :format-arguments
                         (list error-number
                               handler
-                              (mapcar #'(lambda (sc-offset)
-                                          (sb!di::sub-access-debug-var-slot
-                                           fp sc-offset alien-context))
+                              (mapcar (lambda (sc-offset)
+                                        (sb!di::sub-access-debug-var-slot
+                                         fp sc-offset alien-context))
                                       arguments))))
                 (t
                  (funcall handler name fp alien-context arguments)))))))))