0.8.9.6.netbsd.2:

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

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 4dbefe7..43f552e 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -36,6 +36,28 @@
        (size (primitive-object-size obj)))
     (cond
      ((not lowtag))
+     (;; KLUDGE described in dan_b message "Another one for the
+      ;; collection [bug 108]" (sbcl-devel 2004-01-22)
+      ;;
+      ;; In a freshly started SBCL 0.8.7.20ish, (TIME (ROOM T))  causes
+      ;;   debugger invoked on a SB-INT:BUG in thread 5911:
+      ;;     failed AVER: "(SAP= CURRENT END)"
+      ;; [WHN: Similar things happened on one but not the other of my
+      ;; machines when I just run ROOM a lot in a loop.]
+      ;;
+      ;; This appears to be due to my [DB] abuse of the primitive
+      ;; object macros to define a thread object that shares a lowtag
+      ;; with fixnums and has no widetag: it looks like the code that
+      ;; generates *META-ROOM-INFO* infers from this that even fixnums
+      ;; are thread-sized - probably undesirable.
+      ;;
+      ;; This [the fix; the EQL NAME 'THREAD clause here] is more in the
+      ;; nature of a workaround than a really good fix. I'm not sure
+      ;; what a really good fix is: I /think/ it's probably to remove
+      ;; the :LOWTAG option in DEFINE-PRIMITIVE-OBJECT THREAD, then teach
+      ;; genesis to generate the necessary OBJECT_SLOT_OFFSET macros
+      ;; for assembly source in the runtime/genesis/*.h files.
+      (eql name 'thread))
      ((not widetag)
       (let ((info (make-room-info :name name
                                  :kind :lowtag))
@@ -50,9 +72,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)))
@@ -69,11 +91,15 @@
                 (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-15-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-29-widetag . 2)
                 (simple-array-signed-byte-30-widetag . 2)
                 (simple-array-signed-byte-32-widetag . 2)
                 (simple-array-single-float-widetag . 2)
@@ -91,8 +117,8 @@
                          :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))
 
@@ -132,7 +158,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.
@@ -439,7 +466,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
@@ -462,7 +490,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