0.8.16.2: TYPE-ERROR for ERROR

[sbcl.git] / src / compiler / ir1tran.lisp

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 16f919b..73060c5 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -50,11 +50,6 @@
   the efficiency of stable code.")
 
 (defvar *fun-names-in-this-file* nil)
-
-;;; *ALLOW-DEBUG-CATCH-TAG* controls whether we should allow the
-;;; insertion a (CATCH ...) around code to allow the debugger RETURN
-;;; command to function.
-(defvar *allow-debug-catch-tag* t)
 \f
 ;;;; namespace management utilities
 
@@ -390,7 +385,8 @@
   (declare (list path))
   (let* ((*current-path* path)
         (component (make-empty-component))
-        (*current-component* component))
+        (*current-component* component)
+         (*allow-instrumenting* t))
     (setf (component-name component) "initial component")
     (setf (component-kind component) :initial)
     (let* ((forms (if for-value `(,form) `(,form nil)))
@@ -478,50 +474,50 @@
     (ir1-error-bailout (start next result form)
       (let ((*current-path* (or (gethash form *source-paths*)
                                (cons form *current-path*))))
-       (if (step-form-p form)
-           (ir1-convert-step start next result form)
-       (if (atom form)
-           (cond ((and (symbolp form) (not (keywordp form)))
-                  (ir1-convert-var start next result form))
-                 ((leaf-p form)
-                  (reference-leaf start next result form))
-                 (t
-                  (reference-constant start next result form)))
-           (let ((opname (car form)))
-             (cond ((or (symbolp opname) (leaf-p opname))
-                    (let ((lexical-def (if (leaf-p opname)
-                                            opname
-                                            (lexenv-find opname funs))))
-                      (typecase lexical-def
-                        (null
-                          (ir1-convert-global-functoid start next result
-                                                       form))
-                        (functional
-                         (ir1-convert-local-combination start next result
-                                                        form
-                                                        lexical-def))
-                        (global-var
-                         (ir1-convert-srctran start next result
-                                               lexical-def form))
-                        (t
-                         (aver (and (consp lexical-def)
-                                    (eq (car lexical-def) 'macro)))
-                         (ir1-convert start next result
-                                      (careful-expand-macro (cdr lexical-def)
-                                                            form))))))
-                   ((or (atom opname) (not (eq (car opname) 'lambda)))
-                    (compiler-error "illegal function call"))
-                   (t
-                    ;; implicitly (LAMBDA ..) because the LAMBDA
-                    ;; expression is the CAR of an executed form
-                    (ir1-convert-combination start next result
-                                             form
-                                             (ir1-convert-lambda
-                                              opname
-                                              :debug-name (debug-namify
-                                                           "LAMBDA CAR "
-                                                           opname)
-                                              :allow-debug-catch-tag t)))))))))
+       (cond ((step-form-p form)
+               (ir1-convert-step start next result form))
+              ((atom form)
+               (cond ((and (symbolp form) (not (keywordp form)))
+                      (ir1-convert-var start next result form))
+                     ((leaf-p form)
+                      (reference-leaf start next result form))
+                     (t
+                      (reference-constant start next result form))))
+              (t
+               (let ((opname (car form)))
+                 (cond ((or (symbolp opname) (leaf-p opname))
+                        (let ((lexical-def (if (leaf-p opname)
+                                               opname
+                                               (lexenv-find opname funs))))
+                          (typecase lexical-def
+                            (null
+                             (ir1-convert-global-functoid start next result
+                                                          form))
+                            (functional
+                             (ir1-convert-local-combination start next result
+                                                            form
+                                                            lexical-def))
+                            (global-var
+                             (ir1-convert-srctran start next result
+                                                  lexical-def form))
+                            (t
+                             (aver (and (consp lexical-def)
+                                        (eq (car lexical-def) 'macro)))
+                             (ir1-convert start next result
+                                          (careful-expand-macro (cdr lexical-def)
+                                                                form))))))
+                       ((or (atom opname) (not (eq (car opname) 'lambda)))
+                        (compiler-error "illegal function call"))
+                       (t
+                        ;; implicitly (LAMBDA ..) because the LAMBDA
+                        ;; expression is the CAR of an executed form
+                        (ir1-convert-combination start next result
+                                                 form
+                                                 (ir1-convert-lambda
+                                                  opname
+                                                  :debug-name (debug-namify
+                                                               "LAMBDA CAR "
+                                                               opname))))))))))
     (values))
 
   ;; Generate a reference to a manifest constant, creating a new leaf
@@ -921,8 +917,8 @@
              (new-vars nil cons))
       (dolist (var-name (rest decl))
        (when (boundp var-name)
-          (compiler-assert-symbol-home-package-unlocked var-name
-                                                        "declaring the type of ~A"))
+          (compiler-assert-symbol-home-package-unlocked
+          var-name "declaring the type of ~A"))
        (let* ((bound-var (find-in-bindings vars var-name))
               (var (or bound-var
                        (lexenv-find var-name vars)