X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdebug-dump.lisp;h=3c954eb600ce8e8d4bfba04f40b638cbcfebff93;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=60169dad13feb328e7edde2378a12de0b7460109;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index 60169da..3c954eb 100644
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -100,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))
 
@@ -198,7 +198,7 @@
   (values))
 
 ;;; Return a vector and an integer (or null) suitable for use as the
-;;; BLOCKS and TLF-NUMBER in Fun's debug-function. This requires two
+;;; BLOCKS and TLF-NUMBER in FUN's debug-function. This requires two
 ;;; passes to compute:
 ;;; -- Scan all blocks, dumping the header and successors followed
 ;;;    by all the non-elsewhere locations.
@@ -244,59 +244,58 @@
 ;;; we need them or not.
 (defun debug-source-for-info (info)
   (declare (type source-info info))
-  (assert (not (source-info-current-file info)))
-  (mapcar #'(lambda (x)
-	      (let ((res (make-debug-source
-			  :from :file
-			  :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)
-			    (coerce-to-smallest-eltype
-			     (file-info-positions x)))))
-		    (name (file-info-name x)))
-		(etypecase name
-		  ((member :lisp)
-		   (setf (debug-source-from res) name)
-		   (setf (debug-source-name res)
-			 (coerce (file-info-forms x) 'simple-vector)))
-		  (pathname
-		   (let* ((untruename (file-info-untruename x))
-			  (dir (pathname-directory untruename)))
-		     (setf (debug-source-name res)
-			   (namestring
-			    (if (and dir (eq (first dir) :absolute))
-				untruename
-				name))))))
-		res))
-	  (source-info-files info)))
+  (let* ((file-info (source-info-file-info info))
+	 (res (make-debug-source
+	       :from :file
+	       :created (file-info-write-date file-info)
+	       :compiled (source-info-start-time info)
+	       :source-root (file-info-source-root file-info)
+	       :start-positions
+	       (unless (eq *byte-compile* t)
+		 (coerce-to-smallest-eltype
+		  (file-info-positions file-info)))))
+	 (name (file-info-name file-info)))
+    (etypecase name
+      ((member :lisp)
+       (setf (debug-source-from res) name)
+       (setf (debug-source-name res)
+	     (coerce (file-info-forms file-info) 'simple-vector)))
+      (pathname
+       (let* ((untruename (file-info-untruename file-info))
+	      (dir (pathname-directory untruename)))
+	 (setf (debug-source-name res)
+	       (namestring
+		(if (and dir (eq (first dir) :absolute))
+		    untruename
+		    name))))))
+    (list res)))
+
 
 ;;; Given an arbitrary sequence, coerce it to an unsigned vector if
 ;;; possible. Ordinarily we coerce it to the smallest specialized
 ;;; vector we can. However, we also have a special hack for
 ;;; cross-compiling at bootstrap time, when arbitrarily-specialized
-;;; aren't fully supported: in that case, we coerce it only to a
-;;; vector whose element size is an integer multiple of output byte
+;;; vectors aren't fully supported: in that case, we coerce it only to
+;;; a vector whose element size is an integer multiple of output byte
 ;;; size.
 (defun coerce-to-smallest-eltype (seq)
   (let ((maxoid #-sb-xc-host 0
-		;; An initial value value of 255 prevents us from
+		;; An initial value of 255 prevents us from
 		;; specializing the array to anything smaller than
 		;; (UNSIGNED-BYTE 8), which keeps the cross-compiler's
 		;; portable specialized array output functions happy.
 		#+sb-xc-host 255))
     (flet ((frob (x)
 	     (if (typep x 'unsigned-byte)
-	       (when (>= x maxoid)
-		 (setf maxoid x))
-	       (return-from coerce-to-smallest-eltype
-		 (coerce seq 'simple-vector)))))
+		 (when (>= x maxoid)
+		   (setf maxoid x))
+		 (return-from coerce-to-smallest-eltype
+		   (coerce seq 'simple-vector)))))
       (if (listp seq)
-	(dolist (i seq)
-	  (frob i))
-	(dovector (i seq)
-	  (frob i)))
+	  (dolist (i seq)
+	    (frob i))
+	  (dovector (i seq)
+	    (frob i)))
       (coerce seq `(simple-array (integer 0 ,maxoid) (*))))))
 
 ;;;; variables
@@ -346,7 +345,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 +414,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))))
 
 ;;;; arguments/returns
@@ -441,7 +440,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
@@ -567,7 +566,7 @@
 		 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)