From e8c0f02647086746c05589db54ca65630bd8f496 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 22 Feb 1990 09:41:02 +0000
Subject: [PATCH] Fixed some compiler errors.

---
 compiler/debug-dump.lisp | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp
index 029810e5a..4f6516ff7 100644
--- a/compiler/debug-dump.lisp
+++ b/compiler/debug-dump.lisp
@@ -22,8 +22,8 @@
 ;;;; Debug blocks:
 
 (deftype location-kind ()
-  '(:unknown-return :known-return :internal-error :non-local-exit
-		    :block-start))
+  '(member :unknown-return :known-return :internal-error :non-local-exit
+	   :block-start))
 
 
 ;;; The Location-Info structure holds the information what we need about
@@ -96,7 +96,7 @@
 (defun dump-1-location (node block kind tlf-num label live var-locs)
   (declare (type node node) (type ir2-block block)
 	   (type local-tn-bit-vector live) (type label label)
-	   (type location-kind location) (type (or index null) tlf-num)
+	   (type location-kind kind) (type (or index null) tlf-num)
 	   (type hash-table var-locs))
   
   (vector-push-extend
@@ -108,8 +108,8 @@
     (setq *previous-location* loc))
   
   (unless tlf-num
-    (write-var-integer (node-tlf-number node)))
-  (write-var-integer (first (node-source-path node)))
+    (write-var-integer (node-tlf-number node) *byte-buffer*))
+  (write-var-integer (first (node-source-path node)) *byte-buffer*)
   
   (write-packed-bit-vector (compute-live-vars live block var-locs)
 			   *byte-buffer*)
@@ -158,8 +158,8 @@
 	    (setf (block-flag block) num)
 	    (incf num)
 	    (unless (eql (node-tlf-number
-			  (continuation-next (block-start block))
-			  tlf-num))
+			  (continuation-next (block-start block)))
+			 tlf-num)
 	      (setq tlf-num nil)))
 	  
 	  (dolist (loc (ir2-block-locations 2block))
@@ -178,8 +178,9 @@
 	      (dolist (b succ)
 		(write-var-integer (block-flag b) *byte-buffer*)))
 	    (dump-1-location (continuation-next (block-start block))
-			     2block (ir2-block-live-out 2block)
-			     :block-start tlf-num (ir2-block-%label 2block)
+			     2block :block-start tlf-num
+			     (ir2-block-%label 2block)
+			     (ir2-block-live-out 2block)
 			     var-locs))
 	  
 	  (dolist (loc (ir2-block-locations 2block))
@@ -209,8 +210,10 @@
 			  :created (file-info-write-date x)
 			  :compiled (source-info-start-time info)
 			  :source-root (file-info-source-root x)
-			  :start-position (coerce-to-smallest-eltype
-					   (file-info-positions info)))))
+			  :start-positions
+			  (when (policy nil (>= debug 2))
+			    (coerce-to-smallest-eltype
+			     (file-info-positions x))))))
 		(cond ((pathnamep name)
 		       (setf (debug-source-name res) name))
 		      (t
@@ -235,7 +238,7 @@
 			(setq max val))
 		      (setq max nil))))
       (if (listp seq)
-	  (dolist (elt seq)
+	  (dolist (val seq)
 	    (frob))
 	  (dotimes (i (length seq))
 	    (let ((val (aref seq i)))
@@ -320,7 +323,7 @@
 	      (frob-leaf thing (cdr x) (= level 3)))))
 	
 	(dolist (let (lambda-lets fun))
-	  (frob let (= level 3)))))
+	  (frob-lambda let (= level 3)))))
     
     (setf (fill-pointer *byte-buffer*) 0)
     (let ((sorted (sort (vars) #'string<
@@ -447,7 +450,7 @@
 
 	    (when (>= level 2)
 	      (multiple-value-bind (blocks tlf-num)
-				   (compute-debug-blocks fun)
+				   (compute-debug-blocks fun var-locs)
 		(setf (debug-function-tlf-number dfun) tlf-num)
 		(setf (debug-function-blocks dfun) blocks)))
 
-- 
GitLab