protect against read-time package-lock circumvention from LOCKED::(BAR)

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

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 7e21398..2997e90 100644 (file)
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -122,7 +122,7 @@
              (unless (or (constant-p v)
                          (and (global-var-p v)
                               (member (global-var-kind v)
-                                      '(:global :special))))
+                                      '(:global :special :unknown))))
                (barf "strange *FREE-VARS* entry: ~S" v))
              (dolist (n (leaf-refs v))
                (check-node-reached n))
@@ -463,8 +463,7 @@
      (let ((leaf (ref-leaf node)))
        (when (functional-p leaf)
          (if (eq (functional-kind leaf) :toplevel-xep)
-             (unless (eq (component-kind (block-component (node-block node)))
-                         :toplevel)
+             (unless (component-toplevelish-p (block-component (node-block node)))
                (barf ":TOPLEVEL-XEP ref in non-top-level component: ~S"
                      node))
              (check-fun-reached leaf node)))))
@@ -931,11 +930,6 @@
     (symbol (block-or-lose (gethash thing *free-funs*)))))
 
 ;;; Print cN.
-(defun print-continuation (cont)
-  (declare (type continuation cont))
-  (format t " c~D" (cont-num cont))
-  (values))
-
 (defun print-ctran (cont)
   (declare (type ctran cont))
   (format t "c~D " (cont-num cont))
@@ -1009,7 +1003,12 @@
              (case (cleanup-kind cleanup)
                ((:dynamic-extent)
                 (format t "entry DX~{ v~D~}"
-                        (mapcar #'cont-num (cleanup-info cleanup))))
+                        (mapcar (lambda (lvar-or-cell)
+                                  (if (consp lvar-or-cell)
+                                      (cons (car lvar-or-cell)
+                                            (cont-num (cdr lvar-or-cell)))
+                                      (cont-num lvar-or-cell)))
+                                (cleanup-info cleanup))))
                (t
                 (format t "entry ~S" (entry-exits node))))))
           (exit