fix out-of-line structure predicates on obsolete standard-instances

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

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 4e2d8fc..b6c435c 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -705,7 +705,7 @@
 (defun find-classoid-cell (name &key create errorp)
   (let ((table *classoid-cells*)
         (real-name (uncross name)))
-    (or (with-locked-hash-table (table)
+    (or (with-locked-system-table (table)
           (or (gethash real-name table)
               (when create
                 (setf (gethash real-name table) (make-classoid-cell real-name)))))
@@ -767,7 +767,8 @@
             (:primitive
              (error "Cannot redefine standard type ~S." name))
             (:defined
-             (warn "Redefining DEFTYPE type to be a class: ~S" name)
+             (warn "redefining DEFTYPE type to be a class: ~
+                    ~/sb-impl::print-symbol-with-prefix/" name)
                 (setf (info :type :expander name) nil
                       (info :type :lambda-list name) nil
                       (info :type :source-location name) nil)))
@@ -826,7 +827,7 @@
 (defun insured-find-classoid (name predicate constructor)
   (declare (type function predicate constructor))
   (let ((table *forward-referenced-layouts*))
-    (with-locked-hash-table (table)
+    (with-locked-system-table (table)
       (let* ((old (find-classoid name nil))
              (res (if (and old (funcall predicate old))
                       old
@@ -879,7 +880,7 @@
     (%ensure-classoid-valid class2 layout2)))
 
 (defun update-object-layout-or-invalid (object layout)
-  (if (typep (classoid-of object) 'standard-classoid)
+  (if (layout-for-std-class-p (layout-of object))
       (sb!pcl::check-wrapper-validity object)
       (sb!c::%layout-invalid-error object layout)))
 
@@ -1113,7 +1114,7 @@
       :translation (integer #.sb!xc:most-negative-fixnum
                     #.sb!xc:most-positive-fixnum)
       :inherits (integer rational real number)
-      :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)
+      :codes #.(mapcar #'symbol-value sb!vm::fixnum-lowtags)
       :prototype-form 42)
      (bignum
       :translation (and integer (not fixnum))
@@ -1187,13 +1188,15 @@
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(unsigned-byte 16)))
-     #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-     (simple-array-unsigned-byte-29
-      :translation (simple-array (unsigned-byte 29) (*))
-      :codes (#.sb!vm:simple-array-unsigned-byte-29-widetag)
+
+     (simple-array-unsigned-fixnum
+      :translation (simple-array (unsigned-byte #.sb!vm:n-positive-fixnum-bits) (*))
+      :codes (#.sb!vm:simple-array-unsigned-fixnum-widetag)
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
-      :prototype-form (make-array 0 :element-type '(unsigned-byte 29)))
+      :prototype-form (make-array 0
+                       :element-type '(unsigned-byte #.sb!vm:n-positive-fixnum-bits)))
+
      (simple-array-unsigned-byte-31
       :translation (simple-array (unsigned-byte 31) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-31-widetag)
@@ -1207,13 +1210,6 @@
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(unsigned-byte 32)))
      #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-     (simple-array-unsigned-byte-60
-      :translation (simple-array (unsigned-byte 60) (*))
-      :codes (#.sb!vm:simple-array-unsigned-byte-60-widetag)
-      :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array sequence)
-      :prototype-form (make-array 0 :element-type '(unsigned-byte 60)))
-     #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
      (simple-array-unsigned-byte-63
       :translation (simple-array (unsigned-byte 63) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-63-widetag)
@@ -1239,13 +1235,17 @@
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(signed-byte 16)))
-     #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
-     (simple-array-signed-byte-30
-      :translation (simple-array (signed-byte 30) (*))
-      :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
+
+     (simple-array-fixnum
+      :translation (simple-array (signed-byte #.sb!vm:n-fixnum-bits)
+                    (*))
+      :codes (#.sb!vm:simple-array-fixnum-widetag)
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence)
-      :prototype-form (make-array 0 :element-type '(signed-byte 30)))
+      :prototype-form (make-array 0
+                       :element-type
+                       '(signed-byte #.sb!vm:n-fixnum-bits)))
+
      (simple-array-signed-byte-32
       :translation (simple-array (signed-byte 32) (*))
       :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
@@ -1253,13 +1253,6 @@
       :inherits (vector simple-array array sequence)
       :prototype-form (make-array 0 :element-type '(signed-byte 32)))
      #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
-     (simple-array-signed-byte-61
-      :translation (simple-array (signed-byte 61) (*))
-      :codes (#.sb!vm:simple-array-signed-byte-61-widetag)
-      :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array sequence)
-      :prototype-form (make-array 0 :element-type '(signed-byte 61)))
-     #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
      (simple-array-signed-byte-64
       :translation (simple-array (signed-byte 64) (*))
       :codes (#.sb!vm:simple-array-signed-byte-64-widetag)