0.8.6.40:

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

diff --git a/src/code/room.lisp b/src/code/room.lisp
index df09fbe..0faffae 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -50,9 +50,9 @@
                            :kind :fixed
                            :length size))))))
 
                            :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-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)))
   (setf (svref *meta-room-info* code)
        (make-room-info :name 'array-header
                        :kind :header)))

@@ -69,11 +69,15 @@
                 (simple-vector-widetag . 2)
                 (simple-array-unsigned-byte-2-widetag . -2)
                 (simple-array-unsigned-byte-4-widetag . -1)
                 (simple-vector-widetag . 2)
                 (simple-array-unsigned-byte-2-widetag . -2)
                 (simple-array-unsigned-byte-4-widetag . -1)

+                (simple-array-unsigned-byte-7-widetag . 0)

                 (simple-array-unsigned-byte-8-widetag . 0)
                 (simple-array-unsigned-byte-8-widetag . 0)

+                (simple-array-unsigned-byte-15-widetag . 1)

                 (simple-array-unsigned-byte-16-widetag . 1)
                 (simple-array-unsigned-byte-16-widetag . 1)

+                (simple-array-unsigned-byte-31-widetag . 2)

                 (simple-array-unsigned-byte-32-widetag . 2)
                 (simple-array-signed-byte-8-widetag . 0)
                 (simple-array-signed-byte-16-widetag . 1)
                 (simple-array-unsigned-byte-32-widetag . 2)
                 (simple-array-signed-byte-8-widetag . 0)
                 (simple-array-signed-byte-16-widetag . 1)

+                (simple-array-unsigned-byte-29-widetag . 2)

                 (simple-array-signed-byte-30-widetag . 2)
                 (simple-array-signed-byte-32-widetag . 2)
                 (simple-array-single-float-widetag . 2)
                 (simple-array-signed-byte-30-widetag . 2)
                 (simple-array-signed-byte-32-widetag . 2)
                 (simple-array-single-float-widetag . 2)

@@ -91,8 +95,8 @@
                          :kind :vector
                          :length size))))
 
                          :kind :vector
                          :length size))))
 

-(setf (svref *meta-room-info* simple-string-widetag)
-      (make-room-info :name 'simple-string
+(setf (svref *meta-room-info* simple-base-string-widetag)
+      (make-room-info :name 'simple-base-string

                      :kind :string
                      :length 0))
 
                      :kind :string
                      :length 0))
 

@@ -132,7 +136,8 @@
      (values (int-sap read-only-space-start)
             (int-sap (* *read-only-space-free-pointer* n-word-bytes))))
     (:dynamic
      (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.
             (dynamic-space-free-pointer)))))
 
 ;;; Return the total number of bytes used in SPACE.

@@ -439,7 +444,8 @@
           ((#.bignum-widetag
             #.single-float-widetag
             #.double-float-widetag
           ((#.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
             #.simple-bit-vector-widetag
             #.simple-array-unsigned-byte-2-widetag
             #.simple-array-unsigned-byte-4-widetag

@@ -462,7 +468,8 @@
             #.complex-widetag
             #.simple-array-widetag
             #.simple-vector-widetag
             #.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
             #.complex-bit-vector-widetag
             #.complex-vector-widetag
             #.complex-array-widetag

@@ -499,19 +506,19 @@
        (when (eql type instance-header-widetag)
         (incf total-objects)
         (incf total-bytes size)
        (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
           (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))
      space)
 
     (collect ((totals-list))

-      (maphash (lambda (class what)
+      (maphash (lambda (classoid what)

                 (totals-list (cons (prin1-to-string
                 (totals-list (cons (prin1-to-string

-                                    (class-proper-name class))
+                                    (classoid-proper-name classoid))

                                    what)))
               totals)
       (let ((sorted (sort (totals-list) #'> :key #'cddr))
                                    what)))
               totals)
       (let ((sorted (sort (totals-list) #'> :key #'cddr))