diff --git a/code/room.lisp b/code/room.lisp
index 3f507b066e7bc7d64939ab974ee0f3bc1c20ca09..d7a1e30a97a5e7bf4b0a0503f7c9e100cf0af444 100644
--- a/code/room.lisp
+++ b/code/room.lisp
@@ -1,23 +1,22 @@
 ;;; -*- Mode: Lisp; Package: VM -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (Scott.Fahlman@CS.CMU.EDU). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.4 1991/03/17 14:28:27 wlott Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.3 1990/10/12 15:08:16 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.4 1991/03/17 14:28:27 wlott Exp $
 ;;; 
 ;;; Heap grovelling memory usage stuff.
 ;;; 
 (in-package "VM")
 (use-package "SYSTEM")
-(in-package "C")
-(import '(function-code-header make-lisp-obj dynamic-space-free-pointer
-	  code-code-size vector-length)
-	"VM")
 (in-package "LISP")
 (import '(
 	  dynamic-0-space-start dynamic-1-space-start read-only-space-start
@@ -25,6 +24,7 @@
 	  *static-space-free-pointer* *read-only-space-free-pointer*)
 	"VM")
 (in-package "VM")
+(import '(di::make-lisp-obj))
 
 
 ;;;; Type format database.
@@ -35,8 +35,9 @@
   (name nil :type symbol)
   ;;
   ;; Kind of type (how we determine length).
-  (kind nil :type (member :lowtag :fixed :header :vector
-			  :string :code :closure :structure))
+  (kind (required-argument)
+	:type (member :lowtag :fixed :header :vector
+		      :string :code :closure :structure))
   ;;
   ;; Length if fixed-length, shift amount for element size if :vector.
   (length nil :type (or fixnum null)))
@@ -137,7 +138,7 @@
 (proclaim '(inline vector-total-size))
 (defun vector-total-size (obj info)
   (let ((shift (room-info-length info))
-	(len (+ (vector-length obj)
+	(len (+ (length (the vector obj))
 		(ecase (room-info-kind info)
 		  (:vector 0)
 		  (:string 1)))))
@@ -189,6 +190,17 @@
 			     word-bytes))))
 	      (funcall fun obj header-type size)
 	      (setq current (sap+ current size))))
+	   ((eq (room-info-kind info) :structure)
+	    (let* ((obj (make-lisp-obj
+			 (logior (sap-int current) structure-pointer-type)))
+		   (size (round-to-dualword
+			  (* (+ (c::structure-length obj) 1) word-bytes))))
+	      (declare (fixnum size))
+	      (funcall fun obj header-type size)
+	      (assert (zerop (logand size lowtag-mask)))
+	      (when (> size 200000) (break "Implausible size, prev ~S" prev))
+	      (setq prev current)
+	      (setq current (sap+ current size))))
 	   (t
 	    (let* ((obj (make-lisp-obj
 			 (logior (sap-int current) other-pointer-type)))
@@ -201,9 +213,6 @@
 			     (* (room-info-length info) word-bytes)))
 			   ((:vector :string)
 			    (vector-total-size obj info))
-			   (:structure
-			    (round-to-dualword
-			     (* (+ (c::structure-length obj) 2) word-bytes)))
 			   (:header
 			    (round-to-dualword
 			     (* (1+ (get-header-data obj)) word-bytes)))
@@ -363,7 +372,8 @@
   (let ((code-words 0)
 	(no-ops 0)
 	(total-bytes 0))
-    (declare (fixnum code-words no-ops))
+    (declare (fixnum code-words no-ops)
+	     (type unsigned-byte total-bytes))
     (map-allocated-objects
      #'(lambda (obj type size)
  	 (declare (fixnum size) (optimize (speed 3) (safety 0)))
@@ -384,6 +394,69 @@
   
   (values))
 
+
+;;; DESCRIPTOR-VS-NON-DESCRIPTOR-STORAGE  --  Public
+;;;
+(defun descriptor-vs-non-descriptor-storage (&rest spaces)
+  (let ((descriptor-words 0)
+	(non-descriptor-headers 0)
+	(non-descriptor-bytes 0))
+    (declare (type unsigned-byte descriptor-words non-descriptor-headers
+		   non-descriptor-bytes))
+    (dolist (space (or spaces '(:read-only :static :dynamic)))
+      (declare (inline map-allocated-objects))
+      (map-allocated-objects
+       #'(lambda (obj type size)
+	   (declare (fixnum size) (optimize (speed 3) (safety 0)))
+	   (case type
+	     (#.code-header-type
+	      (let ((inst-words
+		     (truly-the fixnum (%primitive code-code-size obj))))
+		(declare (type fixnum inst-words))
+		(incf non-descriptor-bytes (* inst-words word-bytes))
+		(incf descriptor-words
+		      (- (truncate size word-bytes) inst-words))))
+	     ((#.bignum-type
+	       #.single-float-type
+	       #.double-float-type
+	       #.simple-string-type
+	       #.simple-bit-vector-type
+	       #.simple-array-unsigned-byte-2-type
+	       #.simple-array-unsigned-byte-4-type
+	       #.simple-array-unsigned-byte-8-type
+	       #.simple-array-unsigned-byte-16-type
+	       #.simple-array-unsigned-byte-32-type
+	       #.simple-array-single-float-type
+	       #.simple-array-double-float-type)
+	      (incf non-descriptor-headers)
+	      (incf non-descriptor-bytes (- size word-bytes)))
+	     ((#.list-pointer-type
+	       #.structure-pointer-type
+	       #.ratio-type
+	       #.complex-type
+	       #.simple-array-type
+	       #.simple-vector-type
+	       #.complex-string-type
+	       #.complex-bit-vector-type
+	       #.complex-vector-type
+	       #.complex-array-type
+	       #.closure-header-type
+	       #.funcallable-instance-header-type
+	       #.value-cell-header-type
+	       #.symbol-header-type
+	       #.sap-type
+	       #.weak-pointer-type
+	       #.structure-header-type)
+	      (incf descriptor-words (truncate size word-bytes)))
+	     (t
+	      (error "Bogus type: ~D" type))))
+       space))
+    (format t "~:D words allocated for descriptor objects.~%"
+	    descriptor-words)
+    (format t "~:D bytes data/~:D words header for non-descriptor objects.~%"
+	    non-descriptor-bytes non-descriptor-headers)
+    (values)))
+
 
 ;;; STRUCTURE-USAGE  --  Public
 ;;;
@@ -399,8 +472,7 @@
     (map-allocated-objects
      #'(lambda (obj type size)
 	 (declare (fixnum size) (optimize (speed 3) (safety 0)))
-	 (when (and (eql type simple-vector-type)
-		    (eql (get-header-data obj) vector-structure-subtype))
+	 (when (eql type structure-header-type)
 	   (incf total-objects)
 	   (incf total-bytes size)
 	   (let* ((name (svref obj 0))