X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Froom.lisp;h=8c7e450e0d4f98be179d9de61691e24b1a678fe7;hb=9767de1cecfe50560fe1da69fd458b6148a66da3;hp=90a7ecee5f6a619cafcbbc4353068e01e18e58d4;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 90a7ece..8c7e450 100644
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -32,7 +32,7 @@
   (let ((widetag (primitive-object-widetag obj))
 	(lowtag (primitive-object-lowtag obj))
 	(name (primitive-object-name obj))
-	(variable (primitive-object-var-length obj))
+	(variable (primitive-object-variable-length-p obj))
 	(size (primitive-object-size obj)))
     (cond
      ((not lowtag))
@@ -50,9 +50,9 @@
 			    :kind :fixed
 			    :length size))))))
 
-(dolist (code (list complex-string-widetag simple-array-widetag
+(dolist (code (list complex-base-string-widetag simple-array-widetag
 		    complex-bit-vector-widetag complex-vector-widetag
-		    complex-array-widetag))
+		    complex-array-widetag complex-vector-nil-widetag))
   (setf (svref *meta-room-info* code)
 	(make-room-info :name 'array-header
 			:kind :header)))
@@ -80,18 +80,27 @@
 		 (simple-array-double-float-widetag . 3)
 		 (simple-array-complex-single-float-widetag . 3)
 		 (simple-array-complex-double-float-widetag . 4)))
-  (let ((name (car stuff))
-	(size (cdr stuff)))
+  (let* ((name (car stuff))
+	 (size (cdr stuff))
+	 (sname (string name)))
     (setf (svref *meta-room-info* (symbol-value name))
-	  (make-room-info :name name
+	  (make-room-info :name (intern (subseq sname
+						0
+						(mismatch sname "-WIDETAG"
+							  :from-end t)))
 			  :kind :vector
 			  :length size))))
 
-(setf (svref *meta-room-info* simple-string-widetag)
-      (make-room-info :name 'simple-string-widetag
+(setf (svref *meta-room-info* simple-base-string-widetag)
+      (make-room-info :name 'simple-base-string
 		      :kind :string
 		      :length 0))
 
+(setf (svref *meta-room-info* simple-array-nil-widetag)
+      (make-room-info :name 'simple-array-nil
+		      :kind :fixed
+		      :length 2))
+
 (setf (svref *meta-room-info* code-header-widetag)
       (make-room-info :name 'code
 		      :kind :code))
@@ -100,7 +109,7 @@
       (make-room-info :name 'instance
 		      :kind :instance))
 
-); eval-when (compile eval)
+) ; EVAL-WHEN
 
 (defparameter *room-info* '#.*meta-room-info*)
 (deftype spaces () '(member :static :dynamic :read-only))
@@ -123,7 +132,8 @@
      (values (int-sap read-only-space-start)
 	     (int-sap (* *read-only-space-free-pointer* n-word-bytes))))
     (:dynamic
-     (values (int-sap dynamic-space-start)
+     (values (int-sap #!+gencgc dynamic-space-start 
+		      #!-gencgc (current-dynamic-space-start))
 	     (dynamic-space-free-pointer)))))
 
 ;;; Return the total number of bytes used in SPACE.
@@ -211,7 +221,8 @@
 			     (:fixed
 			      (aver (or (eql (room-info-length info)
 					       (1+ (get-header-data obj)))
-					  (floatp obj)))
+					(floatp obj)
+					(simple-array-nil-p obj)))
 			      (round-to-dualword
 			       (* (room-info-length info) n-word-bytes)))
 			     ((:vector :string)
@@ -429,7 +440,8 @@
 	   ((#.bignum-widetag
 	     #.single-float-widetag
 	     #.double-float-widetag
-	     #.simple-string-widetag
+	     #.simple-base-string-widetag
+	     #.simple-array-nil-widetag
 	     #.simple-bit-vector-widetag
 	     #.simple-array-unsigned-byte-2-widetag
 	     #.simple-array-unsigned-byte-4-widetag
@@ -452,7 +464,8 @@
 	     #.complex-widetag
 	     #.simple-array-widetag
 	     #.simple-vector-widetag
-	     #.complex-string-widetag
+	     #.complex-base-string-widetag
+	     #.complex-vector-nil-widetag
 	     #.complex-bit-vector-widetag
 	     #.complex-vector-widetag
 	     #.complex-array-widetag
@@ -489,19 +502,19 @@
        (when (eql type instance-header-widetag)
 	 (incf total-objects)
 	 (incf total-bytes size)
-	 (let* ((class (layout-class (%instance-ref obj 0)))
-		(found (gethash class totals)))
+	 (let* ((classoid (layout-classoid (%instance-ref obj 0)))
+		(found (gethash classoid totals)))
 	   (cond (found
 		  (incf (the fixnum (car found)))
 		  (incf (the fixnum (cdr found)) size))
 		 (t
-		  (setf (gethash class totals) (cons 1 size)))))))
+		  (setf (gethash classoid totals) (cons 1 size)))))))
      space)
 
     (collect ((totals-list))
-      (maphash (lambda (class what)
+      (maphash (lambda (classoid what)
 		 (totals-list (cons (prin1-to-string
-				     (class-proper-name class))
+				     (classoid-proper-name classoid))
 				    what)))
 	       totals)
       (let ((sorted (sort (totals-list) #'> :key #'cddr))