diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp
index fa354e392b435a192c6c60e161a43b2ab1c82e90..8756f9cfdbffdca3b067379b398e03df0aefa375 100644
--- a/compiler/debug-dump.lisp
+++ b/compiler/debug-dump.lisp
@@ -15,6 +15,11 @@
 (in-package 'c)
 
 
+(defvar *byte-buffer*
+  (make-array 10 :element-type '(unsigned-byte 8)
+	      :fill-pointer 0  :adjustable t))
+
+
 ;;; DEBUG-SOURCE-FOR-INFO  --  Interface
 ;;;
 ;;;    Return a list of DEBUG-SOURCE structures containing information derived
@@ -42,73 +47,112 @@
 	  (source-info-files info)))
 
 
-;;; DEBUG-LOCATION-FOR  --  Internal
+;;; TN-SC-OFFSET  --  Internal
+;;;
+;;;    Return a SC-OFFSET describing TN's location.
+;;;
+(defun tn-sc-offset (tn)
+  (declare (type tn tn))
+  (make-sc-offset (sc-number (tn-sc tn))
+		  (tn-offset tn)))
+
+
+;;; DUMP-1-LOCATION  --  Internal
+;;;
+;;;    Dump info to represent Var's location being TN.  ID is an integer that
+;;; makes Var's name unique in the function.  Buffer is the vector we stick the
+;;; result in.
 ;;;
-;;;    Return a COMPILED-LOCATION structure describing Leaf.  If we already
-;;; have a location for this var in this function, then return that.  If the
-;;; var has no refs, return DELETED.
-;;;
-(defun debug-location-for (leaf var-locs)
-  (declare (type lambda-var leaf) (type hash-table var-locs))
-  (cond ((gethash leaf var-locs))
-	((null (leaf-refs leaf)) 'deleted)
-	(t
-	 (let* ((name (leaf-name leaf))
-		(package (symbol-package name))
-		(loc (make-compiled-location
-		      :name (symbol-name name)
-		      :package-name (when package (package-name package))
-		      :type (type-specifier (leaf-type leaf))))
-		(tn (leaf-info leaf)))
-	   
-	   (setf (compiled-location-offset loc)
-		 (tn-offset tn))
-	   (setf (compiled-location-sc loc)
-		 (sc-number (tn-sc tn)))
-	   
-	   (let ((save (or (tn-save-tn tn) tn)))
-	     (setf (compiled-location-save-offset loc)
-		   (tn-offset save))
-	     (setf (compiled-location-save-sc loc)
-		   (sc-number (tn-sc tn))))
-	   
-	   (setf (gethash leaf var-locs)
-		 loc)))))
+(defun dump-1-location (var tn id buffer)
+  (declare (type lambda-var var) (type tn tn) (type unsigned-byte id))
+  (let* ((name (leaf-name var))
+	 (package (symbol-package name))
+	 (package-p (and package (not (eq package *package*))))
+	 (save-tn (tn-save-tn tn))
+	 (flags 0))
+    (unless package
+      (setq flags (logior flags compiled-location-uninterned)))
+    (when package-p
+      (setq flags (logior flags compiled-location-packaged)))
+    (when (eq (tn-kind tn) :environment)
+      (setq flags (logior flags compiled-location-environment-live)))
+    (when save-tn
+      (setq flags (logior flags compiled-location-save-loc-p)))
+    (unless (zerop id)
+      (setq flags (logior flags compiled-location-id-p)))
+    (vector-push-extend flags buffer)
+    (write-var-string (symbol-name name) buffer)
+    (when package-p
+      (write-var-string (package-name package) buffer))
+    (unless (zerop id)
+      (write-var-integer id buffer))
+    (write-var-integer (tn-sc-offset tn) buffer)
+    (when save-tn
+      (write-var-integer (tn-sc-offset save-tn) buffer)))
+  (undefined-value))
 
 
 ;;; COMPUTE-VARIABLES  --  Internal
 ;;;
 ;;;    Return a vector suitable for use as the DEBUG-FUNCTION-VARIABLES of Fun.
-;;; If Max-Info-P is true, we dump gensym variables as well as named ones.
+;;; Level is the current DEBUG-INFO quality.  Var-Locs is a hashtable in which
+;;; we enter the translation from LAMBDA-VARS to the relative position of that
+;;; variable's location in the resulting vector.
 ;;;
-(defun compute-variables (fun max-info-p var-locs)
+(defun compute-variables (fun level var-locs)
   (declare (type clambda fun) (type hash-table var-locs))
-  (collect ((locs))
-    (flet ((frob (x)
-	     (dolist (leaf (lambda-vars x))
+  (collect ((vars))
+    (labels ((frob-leaf (leaf tn gensym-p)
 	       (let ((name (leaf-name leaf)))
 		 (when (and name (leaf-refs leaf)
-			    (or max-info-p (symbol-package name)))
-		   (locs (debug-location-for leaf var-locs)))))))
-      (frob fun)
-      (dolist (let (lambda-lets fun))
-	(frob let)))
+			    (or gensym-p (symbol-package name)))
+		   (vars (cons leaf tn)))))
+	     (frob-lambda (x gensym-p)
+	       (dolist (leaf (lambda-vars x))
+		 (frob-leaf leaf (leaf-info leaf) gensym-p))))
+      (frob-lambda fun t)
+      (when (>= level 2)
+	(dolist (x (ir2-environment-environment
+		    (environment-info (lambda-environment fun))))
+	  (let ((thing (car x)))
+	    (when (lambda-var-p thing)
+	      (frob-leaf thing (cdr x) (= level 3)))))
+	
+	(dolist (let (lambda-lets fun))
+	  (frob let (= level 3)))))
     
-    (let ((res (coerce (sort (locs)
-			     #'(lambda (x y)
-				 (string< (compiled-location-name x)
-					  (compiled-location-name y))))
-		       'simple-vector)))
-      (let ((prev-name nil))
-	(declare (type (or simple-string null) prev-name))
-	(dotimes (i (length res))
-	  (let* ((loc (svref res i))
-		 (name (compiled-location-name loc)))
-	    (when (and prev-name (string= prev-name name))
-	      (setf (compiled-location-id loc)
-		    (1+ (compiled-location-id (svref res (1- i))))))
-	    (setq prev-name name))))
-      res)))
+    (setf (fill-pointer *byte-buffer*) 0)
+    (let ((sorted (sort (vars) #'string<
+			:key #'(lambda (x)
+				 (symbol-name (leaf-name (car x))))))
+	  (prev-name nil)
+	  (id 0)
+	  (i 0))
+      (declare (type (or simple-string null) prev-name))
+      (dolist (x sorted)
+	(let* ((var (car x))
+	       (name (symbol-name (leaf-name var))))
+	  (cond ((and prev-name (string= prev-name name))
+		 (incf id))
+		(t
+		 (setq id 0  prev-name name)))
+	  (dump-1-location var (cdr x) id *byte-buffer*))
+	(setf (gethash var var-locs) i)
+	(incf i)))
+
+    (copy-seq *byte-buffer*)))
+
+
+;;; DEBUG-LOCATION-FOR  --  Internal
+;;;
+;;;    Return Var's relative position in the function's variables (determined
+;;; from the Var-Locs hashtable.)
+;;;
+(defun debug-location-for (var var-locs)
+  (declare (type lambda-var var) (type hashtable var-locs))
+  (let ((res (gethash var var-locs)))
+    (assert res () "No location for ~S?" var)
+    res))
 
 
 ;;; COMPUTE-ARGUMENTS  --  Internal
@@ -153,13 +197,14 @@
 ;;; return from Fun.
 ;;;
 (defun compute-debug-returns (fun)
-  (collect ((res))
-    (dolist (tn (return-info-locations (tail-set-info (lambda-tail-set fun))))
-      (let ((loc (make-compiled-location :name "RETURN-LOCATION")))
-	(setf (compiled-location-offset loc) (tn-offset tn))
-	(setf (compiled-location-sc loc) (sc-number (tn-sc tn)))
-	(res loc)))
-    (coerce (res) 'simple-vector)))
+  (let* ((locs (return-info-locations (tail-set-info (lambda-tail-set fun))))
+	 (len (length locs))
+	 (res (make-array len :element-type '(unsigned-byte 32))))
+    (do ((i 0 (1+ i))
+	 (loc locs (cdr loc)))
+	((null loc))
+      (setf (aref res i) (tn-sc-offset (car loc))))
+    res))
 
 
 ;;; DEBUG-INFO-FOR-COMPONENT  --  Interface
@@ -171,15 +216,9 @@
 (defun debug-info-for-component (component assem-nodes count)
   (declare (type component component) (simple-vector assem-nodes)
 	   (type index count))
-  (let ((min-info-p
-	 (policy nil (or (= debug 0)
-			 (and (> space debug) (= space 3)))))
-	(normal-info-p
-	 (policy nil (>= debug space)))
-	(max-info-p
-	 (policy nil (= debug 3)))
-	(res (make-compiled-debug-info :name (component-name component))))
-
+  (let ((level (cookie-debug *default-cookie*))
+	(res (make-compiled-debug-info :name (component-name component)
+				       :package (package-name *package*))))
     (collect ((dfuns))
       (let ((var-locs (make-hash-table :test #'eq)))
 	(dolist (fun (component-lambdas component))
@@ -192,11 +231,11 @@
 				    (component-name component)))
 		       :kind (functional-kind fun))))
 	    
-	    (when normal-info-p
+	    (when (>= level 1)
 	      (setf (compiled-debug-function-variables dfun)
-		    (compute-variables fun max-info-p var-locs)))
+		    (compute-variables fun level var-locs)))
 
-	    (unless min-info-p
+	    (unless (= level 0)
 	      (setf (compiled-debug-function-arguments dfun)
 		    (compute-arguments fun var-locs)))
 
@@ -206,7 +245,7 @@
 		  (cond ((eq (return-info-kind info) :unknown)
 			 (setf (compiled-debug-function-returns dfun)
 			       :standard))
-			((not min-info-p)
+			((/= level 0)
 			 (setf (compiled-debug-function-returns dfun)
 			       (compute-debug-returns fun)))))))