0.pre7.114:
[sbcl.git] / src / compiler / debug-dump.lisp
index ff7298f..5a0df42 100644 (file)
        (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
        (setf (compiled-debug-fun-blocks dfun) blocks)))
 
-    (if (external-entry-point-p fun)
+    (if (xep-p fun)
        (setf (compiled-debug-fun-returns dfun) :standard)
        (let ((info (tail-set-info (lambda-tail-set fun))))
          (when info
 ;;; called after assembly so that source map information is available.
 (defun debug-info-for-component (component)
   (declare (type component component))
-  (collect ((dfuns))
-    (let ((var-locs (make-hash-table :test 'eq))
-         (*byte-buffer* (make-array 10
-                                    :element-type '(unsigned-byte 8)
-                                    :fill-pointer 0
-                                    :adjustable t)))
-      (dolist (fun (component-lambdas component))
-       (clrhash var-locs)
-       (dfuns (cons (label-position (block-label (lambda-block fun)))
-                    (compute-1-debug-fun fun var-locs))))
-      (let* ((sorted (sort (dfuns) #'< :key #'car))
-            (fun-map (compute-debug-fun-map sorted)))
-       (make-compiled-debug-info :name (component-name component)
-                                 :fun-map fun-map)))))
+  (let ((dfuns nil)
+       (var-locs (make-hash-table :test 'eq))
+       (*byte-buffer* (make-array 10
+                                  :element-type '(unsigned-byte 8)
+                                  :fill-pointer 0
+                                  :adjustable t)))
+    (dolist (lambda (component-lambdas component))
+      (clrhash var-locs)
+      (push (cons (label-position (block-label (lambda-block lambda)))
+                 (compute-1-debug-fun lambda var-locs))
+           dfuns))
+    (let* ((sorted (sort dfuns #'< :key #'car))
+          (fun-map (compute-debug-fun-map sorted)))
+      (make-compiled-debug-info :name (component-name component)
+                               :fun-map fun-map))))
 \f
 ;;; Write BITS out to BYTE-BUFFER in backend byte order. The length of
 ;;; BITS must be evenly divisible by eight.
 (defun write-packed-bit-vector (bits byte-buffer)
   (declare (type simple-bit-vector bits) (type byte-buffer byte-buffer))
+
+  ;; Enforce constraint from CMU-CL-era comment.
+  (aver (zerop (mod (length bits) 8)))
+
   (multiple-value-bind (initial step done)
       (ecase *backend-byte-order*
        (:little-endian (values 0  1  8))