X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fclass.lisp;h=b6c435c5e9efed5b61a8992594f3c11f1b3f0b5e;hb=d94c1b4a8c534bde146823f56558faf37cd4c4d7;hp=de34a74aff6b0ec5b44616c5abcc42b045629568;hpb=95f17ca63742f8c164309716b35bc25545a849a6;p=sbcl.git diff --git a/src/code/class.lisp b/src/code/class.lisp index de34a74..b6c435c 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -106,6 +106,7 @@ #-sb-xc-host (progn (/show0 "processing *!INITIAL-LAYOUTS*") (dolist (x *!initial-layouts*) + (setf (layout-clos-hash (cdr x)) (random-layout-clos-hash)) (setf (gethash (car x) *forward-referenced-layouts*) (cdr x))) (/show0 "done processing *!INITIAL-LAYOUTS*"))) @@ -704,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))))) @@ -766,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))) @@ -825,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 @@ -878,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))) @@ -1112,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)) @@ -1186,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) @@ -1206,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) @@ -1238,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) @@ -1252,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)