X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fclass.lisp;h=b7ada1fc57e895ffc2b8372c431d5ebbe990b236;hb=da8cb4801a3ab35070f380e22aea3d260f9df8aa;hp=4e06f521cbf7002854dd3a0d2f56ca1802a1ce3f;hpb=a682f4c392bc874a6a898632889319ebdd8821fc;p=sbcl.git diff --git a/src/code/class.lisp b/src/code/class.lisp index 4e06f52..b7ada1f 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -84,9 +84,10 @@ ;;; Note: This bound is set somewhat less than MOST-POSITIVE-FIXNUM ;;; in order to guarantee that several hash values can be added without ;;; overflowing into a bignum. -(def!constant layout-clos-hash-max (ash sb!xc:most-positive-fixnum -3) +(def!constant layout-clos-hash-limit (1+ (ash sb!xc:most-positive-fixnum -3)) #!+sb-doc - "the inclusive upper bound on LAYOUT-CLOS-HASH values") + "the exclusive upper bound on LAYOUT-CLOS-HASH values") +(def!type layout-clos-hash () '(integer 0 #.layout-clos-hash-limit)) ;;; a list of conses, initialized by genesis ;;; @@ -136,30 +137,9 @@ ;; DEF!STRUCT setup. -- WHN 19990930 #+sb-xc-host make-load-form-for-layout)) - ;; hash bits which should be set to constant pseudo-random values - ;; for use by CLOS. Sleazily accessed via %INSTANCE-REF, see - ;; LAYOUT-CLOS-HASH. - ;; - ;; FIXME: We should get our story straight on what the type of these - ;; values is. (declared INDEX here, described as <= - ;; LAYOUT-CLOS-HASH-MAX by the doc string of that constant, - ;; generated as strictly positive in RANDOM-LAYOUT-CLOS-HASH..) - ;; - ;; [ CSR notes, several years later (2005-11-30) that the value 0 is - ;; special for these hash slots, indicating that the wrapper is - ;; obsolete. ] - ;; - ;; KLUDGE: The fact that the slots here start at offset 1 is known - ;; to the LAYOUT-CLOS-HASH function and to the LAYOUT-dumping code - ;; in GENESIS. - (clos-hash-0 (random-layout-clos-hash) :type index) - (clos-hash-1 (random-layout-clos-hash) :type index) - (clos-hash-2 (random-layout-clos-hash) :type index) - (clos-hash-3 (random-layout-clos-hash) :type index) - (clos-hash-4 (random-layout-clos-hash) :type index) - (clos-hash-5 (random-layout-clos-hash) :type index) - (clos-hash-6 (random-layout-clos-hash) :type index) - (clos-hash-7 (random-layout-clos-hash) :type index) + ;; a pseudo-random hash value for use by CLOS. KLUDGE: The fact + ;; that this slot is at offset 1 is known to GENESIS. + (clos-hash (random-layout-clos-hash) :type layout-clos-hash) ;; the class that this is a layout for (classoid (missing-arg) :type classoid) ;; The value of this slot can be: @@ -205,7 +185,16 @@ ;; This slot is known to the C runtime support code. (n-untagged-slots 0 :type index) ;; Definition location - (source-location nil)) + (source-location nil) + ;; True IFF the layout belongs to a standand-instance or a + ;; standard-funcallable-instance -- that is, true only if the layout + ;; is really a wrapper. + ;; + ;; FIXME: If we unify wrappers and layouts this can go away, since + ;; it is only used in SB-PCL::EMIT-FETCH-WRAPPERS, which can then + ;; use INSTANCE-SLOTS-LAYOUT instead (if there is are no slot + ;; layouts, there are no slots for it to pull.) + (for-std-class-p nil :type boolean :read-only t)) (def!method print-object ((layout layout) stream) (print-unreadable-object (layout stream :type t :identity t) @@ -220,23 +209,6 @@ ;;;; support for the hash values used by CLOS when working with LAYOUTs -(def!constant layout-clos-hash-length 8) -#!-sb-fluid (declaim (inline layout-clos-hash)) -(defun layout-clos-hash (layout i) - ;; FIXME: Either this I should be declared to be `(MOD - ;; ,LAYOUT-CLOS-HASH-LENGTH), or this is used in some inner loop - ;; where we can't afford to check that kind of thing and therefore - ;; should have some insane level of optimization. (This is true both - ;; of this function and of the SETF function below.) - (declare (type layout layout) (type index i)) - ;; FIXME: LAYOUT slots should have type `(MOD ,LAYOUT-CLOS-HASH-MAX), - ;; not INDEX. - (truly-the index (%instance-ref layout (1+ i)))) -#!-sb-fluid (declaim (inline (setf layout-clos-hash))) -(defun (setf layout-clos-hash) (new-value layout i) - (declare (type layout layout) (type index new-value i)) - (setf (%instance-ref layout (1+ i)) new-value)) - ;;; a generator for random values suitable for the CLOS-HASH slots of ;;; LAYOUTs. We use our own RANDOM-STATE here because we'd like ;;; pseudo-random values to come the same way in the target even when @@ -254,7 +226,7 @@ ;; ;; an explanation is provided in Kiczales and Rodriguez, "Efficient ;; Method Dispatch in PCL", 1990. -- CSR, 2005-11-30 - (1+ (random layout-clos-hash-max + (1+ (random (1- layout-clos-hash-limit) (if (boundp '*layout-clos-hash-random-state*) *layout-clos-hash-random-state* (setf *layout-clos-hash-random-state* @@ -850,7 +822,7 @@ NIL is returned when no such class exists." (defun update-object-layout-or-invalid (object layout) (if (typep (classoid-of object) 'standard-classoid) (sb!pcl::check-wrapper-validity object) - (%layout-invalid-error object layout))) + (sb!c::%layout-invalid-error object layout))) ;;; Simple methods for TYPE= and SUBTYPEP should never be called when ;;; the two classes are equal, since there are EQ checks in those @@ -913,22 +885,6 @@ NIL is returned when no such class exists." ;; uncertain, since a subclass of both might be defined nil))) -;;; KLUDGE: we need this for the special-case SEQUENCE type, which -;;; (because of multiple inheritance with ARRAY for the VECTOR types) -;;; doesn't have the nice hierarchical properties we want. This is -;;; basically DELEGATE-COMPLEX-INTERSECTION2 with a special-case for -;;; SEQUENCE/ARRAY interactions. -(!define-type-method (classoid :complex-intersection2) (type1 class2) - (cond - ((and (eq class2 (find-classoid 'sequence)) - (array-type-p type1)) - (type-intersection2 (specifier-type 'vector) type1)) - (t - (let ((method (type-class-complex-intersection2 (type-class-info type1)))) - (if (and method (not (eq method #'delegate-complex-intersection2))) - :call-other-method - (hierarchical-intersection2 type1 class2)))))) - ;;; KLUDGE: we need this to deal with the special-case INSTANCE and ;;; FUNCALLABLE-INSTANCE types (which used to be CLASSOIDs until CSR ;;; discovered that this was incompatible with the MOP class @@ -1112,6 +1068,7 @@ NIL is returned when no such class exists." :inherits (array) :prototype-form (make-array nil)) (sequence + :translation (or cons (member nil) vector extended-sequence) :state :read-only :depth 2) (vector @@ -1489,8 +1446,7 @@ NIL is returned when no such class exists." (declare (type layout layout)) (setf (layout-invalid layout) t (layout-depthoid layout) -1) - (dotimes (i layout-clos-hash-length) - (setf (layout-clos-hash layout i) 0)) + (setf (layout-clos-hash layout) 0) (let ((inherits (layout-inherits layout)) (classoid (layout-classoid layout))) (modify-classoid classoid)