0.6.12.13:

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

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index e36ec9b..434fefe 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -25,7 +25,8 @@
 ;;; The LOCATION-INFO structure holds the information what we need
 ;;; about locations which code generation decided were "interesting".
 (defstruct (location-info
-           (:constructor make-location-info (kind label vop)))
+           (:constructor make-location-info (kind label vop))
+           (:copier nil))
   ;; The kind of location noted.
   (kind nil :type location-kind)
   ;; The label pointing to the interesting code location.
@@ -99,7 +100,7 @@
        0)
    *byte-buffer*)
 
-  (let ((loc (if (target-fixnump label) label (label-position label))))
+  (let ((loc (if (fixnump label) label (label-position label))))
     (write-var-integer (- loc *previous-location*) *byte-buffer*)
     (setq *previous-location* loc))
 
@@ -243,16 +244,15 @@
 ;;; we need them or not.
 (defun debug-source-for-info (info)
   (declare (type source-info info))
-  (assert (not (source-info-current-file info)))
+  (aver (not (source-info-current-file info)))
   (mapcar #'(lambda (x)
              (let ((res (make-debug-source
                          :from :file
-                         :comment (file-info-comment x)
                          :created (file-info-write-date x)
                          :compiled (source-info-start-time info)
                          :source-root (file-info-source-root x)
                          :start-positions
-                         (unless (eq *byte-compile* 't)
+                         (unless (eq *byte-compile* t)
                            (coerce-to-smallest-eltype
                             (file-info-positions x)))))
                    (name (file-info-name x)))
@@ -346,7 +346,7 @@
        (vector-push-extend id buffer)))
     (if tn
        (vector-push-extend (tn-sc-offset tn) buffer)
-       (assert minimal))
+       (aver minimal))
     (when save-tn
       (vector-push-extend (tn-sc-offset save-tn) buffer)))
   (values))
@@ -415,8 +415,8 @@
   (let ((res (gethash var var-locs)))
     (cond (res)
          (t
-          (assert (or (null (leaf-refs var))
-                      (not (tn-offset (leaf-info var)))))
+          (aver (or (null (leaf-refs var))
+                    (not (tn-offset (leaf-info var)))))
           'deleted))))
 \f
 ;;;; arguments/returns
@@ -441,7 +441,7 @@
                (cond (info
                       (case (arg-info-kind info)
                         (:keyword
-                         (res (arg-info-keyword info)))
+                         (res (arg-info-key info)))
                         (:rest
                          (res 'rest-arg))
                         (:more-context
@@ -499,8 +499,7 @@
 (defun compute-1-debug-function (fun var-locs)
   (declare (type clambda fun) (type hash-table var-locs))
   (let* ((dfun (dfun-from-fun fun))
-        (actual-level
-         (cookie-debug (lexenv-cookie (node-lexenv (lambda-bind fun)))))
+        (actual-level (policy (lambda-bind fun) debug))
         (level (if #!+sb-dyncount *collect-dynamic-statistics*
                    #!-sb-dyncount nil
                    (max actual-level 2)
@@ -564,11 +563,11 @@
                 minimal-debug-function-name-component)
                ((not pkg)
                 minimal-debug-function-name-uninterned)
-               ((eq pkg *package*)
+               ((eq pkg (sane-package))
                 minimal-debug-function-name-symbol)
                (t
                 minimal-debug-function-name-packaged))))
-    (assert (or (atom name) setf-p))
+    (aver (or (atom name) setf-p))
     (let ((options 0))
       (setf (ldb minimal-debug-function-name-style-byte options) name-rep)
       (setf (ldb minimal-debug-function-kind-byte options)