0.8.0.24:

[sbcl.git] / src / code / room.lisp

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 90a7ece..6c8625a 100644 (file)
--- 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))
@@ -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
+      (make-room-info :name 'simple-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)
@@ -489,19 +500,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))