From 8fee0ba99cd1b1038072bd3fc8f5d5338d80d2de Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 28 May 2007 15:16:22 +0000 Subject: [PATCH] 1.0.6.2: remove multiple layout-clos-hash slots * It seems that despite the claims of the paper "Efficient Method Dispatch in PCL" the multiple hash seeds yield a neglible benefit. * The soon-to-come thread safe cache also uses only a single hash value, so removing these now allows better performance comparisons: multiple hash values vs. single hash value vs. new cache. Actual work done mostly by Christophe Rhodes. --- package-data-list.lisp-expr | 4 +- src/code/class.lisp | 54 +++-------------- src/code/target-format.lisp | 3 +- src/compiler/generic/genesis.lisp | 117 +++++++++++++++++++------------------ src/pcl/cache.lisp | 94 ++++++----------------------- src/pcl/dlisp.lisp | 13 ++--- src/pcl/wrapper.lisp | 5 +- version.lisp-expr | 2 +- 8 files changed, 95 insertions(+), 197 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 2e6fb42..7f281c5 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1543,7 +1543,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "LAYOUT-CLASSOID" "LAYOUT-INVALID" "%SIMPLE-FUN-NAME" "DSD-TYPE" "%INSTANCEP" "DEFSTRUCT-SLOT-DESCRIPTION" "%SIMPLE-FUN-ARGLIST" "%SIMPLE-FUN-NEXT" - "LAYOUT-CLOS-HASH-LENGTH" "DD-PREDICATE-NAME" + "DD-PREDICATE-NAME" "CLASSOID-PROPER-NAME" "%NOTE-TYPE-DEFINED" "LAYOUT-INFO" "%SET-INSTANCE-LAYOUT" "DD-DEFAULT-CONSTRUCTOR" "LAYOUT-OF" "%SIMPLE-FUN-SELF" "%REALPART" @@ -1562,7 +1562,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." #!+long-float "%RANDOM-LONG-FLOAT" "%RANDOM-SINGLE-FLOAT" "STATIC-CLASSOID" "%FUNCALLABLE-INSTANCE-INFO" "RANDOM-CHUNK" "BIG-RANDOM-CHUNK" - "LAYOUT-CLOS-HASH-MAX" "CLASSOID-CELL-NAME" + "LAYOUT-CLOS-HASH-LIMIT" "CLASSOID-CELL-NAME" "BUILT-IN-CLASSOID-DIRECT-SUPERCLASSES" "BUILT-IN-CLASSOID-TRANSLATION" "RANDOM-LAYOUT-CLOS-HASH" "CLASSOID-PCL-CLASS" "FUNCALLABLE-STRUCTURE" diff --git a/src/code/class.lisp b/src/code/class.lisp index 4629a86..78a5432 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: @@ -220,23 +200,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 +217,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* @@ -1474,8 +1437,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) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 5a29fba..df74380 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -78,8 +78,7 @@ (function (typecase character (base-char - (svref *format-directive-interpreters* - (char-code character))) + (svref *format-directive-interpreters* (char-code character))) (character nil))) (*default-format-error-offset* (1- (format-directive-end directive)))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 730a9c8..55a0e57 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -851,10 +851,27 @@ core and return a descriptor to it." ;;; the descriptor for layout's layout (needed when making layouts) (defvar *layout-layout*) -;;; FIXME: This information should probably be pulled out of the -;;; cross-compiler's tables at genesis time instead of inserted by -;;; hand here as a bare numeric constant. -(defconstant target-layout-length 18) +(defconstant target-layout-length + (layout-length (find-layout 'layout))) + +(defun target-layout-index (slot-name) + ;; KLUDGE: this is a little bit sleazy, but the tricky thing is that + ;; structure slots don't have a terribly firm idea of their names. + ;; At least here if we change LAYOUT's package of definition, we + ;; only have to change one thing... + (let* ((name (find-symbol (symbol-name slot-name) "SB!KERNEL")) + (layout (find-layout 'layout)) + (dd (layout-info layout)) + (slots (dd-slots dd)) + (dsd (find name slots :key #'dsd-name))) + (aver dsd) + (dsd-index dsd))) + +(defun cold-set-layout-slot (cold-layout slot-name value) + (write-wordindexed + cold-layout + (+ sb-vm:instance-slots-offset (target-layout-index slot-name)) + value)) ;;; Return a list of names created from the cold layout INHERITS data ;;; in X. @@ -878,6 +895,7 @@ core and return a descriptor to it." (defun make-cold-layout (name length inherits depthoid nuntagged) (let ((result (allocate-boxed-object *dynamic* ;; KLUDGE: Why 1+? -- WHN 19990901 + ;; header word? -- CSR 20051204 (1+ target-layout-length) sb!vm:instance-pointer-lowtag))) (write-memory result @@ -891,7 +909,7 @@ core and return a descriptor to it." ;; Set slot 0 = the layout of the layout. (write-wordindexed result sb!vm:instance-slots-offset *layout-layout*) - ;; Set the immediately following slots = CLOS hash values. + ;; Set the CLOS hash value. ;; ;; Note: CMU CL didn't set these in genesis, but instead arranged ;; for them to be set at cold init time. That resulted in slightly @@ -917,41 +935,30 @@ core and return a descriptor to it." ;; before using it. However, they didn't, so we have a slight ;; problem. We address it by generating the hash values using a ;; different algorithm than we use in ordinary operation. - (dotimes (i sb!kernel:layout-clos-hash-length) - (let (;; The expression here is pretty arbitrary, we just want - ;; to make sure that it's not something which is (1) - ;; evenly distributed and (2) not foreordained to arise in - ;; the target Lisp's (RANDOM-LAYOUT-CLOS-HASH) sequence - ;; and show up as the CLOS-HASH value of some other - ;; LAYOUT. - (hash-value - (1+ (mod (logxor (logand (random-layout-clos-hash) 15253) - (logandc2 (random-layout-clos-hash) 15253) - 1) - ;; (The MOD here is defensive programming - ;; to make sure we never write an - ;; out-of-range value even if some joker - ;; sets LAYOUT-CLOS-HASH-MAX to other - ;; than 2^n-1 at some time in the - ;; future.) - sb!kernel:layout-clos-hash-max)))) - (write-wordindexed result - (+ i sb!vm:instance-slots-offset 1) - (make-fixnum-descriptor hash-value)))) + (let (;; The expression here is pretty arbitrary, we just want + ;; to make sure that it's not something which is (1) + ;; evenly distributed and (2) not foreordained to arise in + ;; the target Lisp's (RANDOM-LAYOUT-CLOS-HASH) sequence + ;; and show up as the CLOS-HASH value of some other + ;; LAYOUT. + (hash-value + (1+ (mod (logxor (logand (random-layout-clos-hash) 15253) + (logandc2 (random-layout-clos-hash) 15253) + 1) + (1- sb!kernel:layout-clos-hash-limit))))) + (cold-set-layout-slot result 'clos-hash + (make-fixnum-descriptor hash-value))) ;; Set other slot values. - (let ((base (+ sb!vm:instance-slots-offset - sb!kernel:layout-clos-hash-length - 1))) - ;; (Offset 0 is CLASS, "the class this is a layout for", which - ;; is uninitialized at this point.) - (write-wordindexed result (+ base 1) *nil-descriptor*) ; marked invalid - (write-wordindexed result (+ base 2) inherits) - (write-wordindexed result (+ base 3) depthoid) - (write-wordindexed result (+ base 4) length) - (write-wordindexed result (+ base 5) *nil-descriptor*) ; info - (write-wordindexed result (+ base 6) *nil-descriptor*) ; pure - (write-wordindexed result (+ base 7) nuntagged)) + ;; + ;; leave CLASSOID uninitialized for now + (cold-set-layout-slot result 'invalid *nil-descriptor*) + (cold-set-layout-slot result 'inherits inherits) + (cold-set-layout-slot result 'depthoid depthoid) + (cold-set-layout-slot result 'length length) + (cold-set-layout-slot result 'info *nil-descriptor*) + (cold-set-layout-slot result 'pure *nil-descriptor*) + (cold-set-layout-slot result 'n-untagged-slots nuntagged) (setf (gethash name *cold-layouts*) (list result @@ -971,17 +978,16 @@ core and return a descriptor to it." ;; We initially create the layout of LAYOUT itself with NIL as the LAYOUT and ;; #() as INHERITS, (setq *layout-layout* *nil-descriptor*) - (setq *layout-layout* - (make-cold-layout 'layout - (number-to-core target-layout-length) - (vector-in-core) - ;; FIXME: hard-coded LAYOUT-DEPTHOID of LAYOUT.. - (number-to-core 3) - ;; no raw slots in LAYOUT: - (number-to-core 0))) - (write-wordindexed *layout-layout* - sb!vm:instance-slots-offset - *layout-layout*) + (let ((xlayout-layout (find-layout 'layout))) + (aver (= 0 (layout-n-untagged-slots xlayout-layout))) + (setq *layout-layout* + (make-cold-layout 'layout + (number-to-core target-layout-length) + (vector-in-core) + (number-to-core (layout-depthoid xlayout-layout)) + (number-to-core 0))) + (write-wordindexed + *layout-layout* sb!vm:instance-slots-offset *layout-layout*) ;; Then we create the layouts that we'll need to make a correct INHERITS ;; vector for the layout of LAYOUT itself.. @@ -1013,13 +1019,7 @@ core and return a descriptor to it." ;; ..and return to backpatch the layout of LAYOUT. (setf (fourth (gethash 'layout *cold-layouts*)) (listify-cold-inherits layout-inherits)) - (write-wordindexed *layout-layout* - ;; FIXME: hardcoded offset into layout struct - (+ sb!vm:instance-slots-offset - layout-clos-hash-length - 1 - 2) - layout-inherits))) + (cold-set-layout-slot *layout-layout* 'inherits layout-inherits)))) ;;;; interning symbols in the cold image @@ -1967,7 +1967,10 @@ core and return a descriptor to it." (layout (pop-stack)) (nuntagged (descriptor-fixnum - (read-wordindexed layout (+ sb!vm:instance-slots-offset 16)))) + (read-wordindexed + layout + (+ sb!vm:instance-slots-offset + (target-layout-index 'n-untagged-slots))))) (ntagged (- size nuntagged))) (write-memory result (make-other-immediate-descriptor size sb!vm:instance-header-widetag)) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index f2a05df..29af071 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -137,9 +137,6 @@ 1 (1+ old-count))))))) -(deftype field-type () - '(mod #.layout-clos-hash-length)) - (eval-when (:compile-toplevel :load-toplevel :execute) (declaim (ftype (function (fixnum) (values (and unsigned-byte fixnum) &optional)) power-of-two-ceiling)) @@ -161,7 +158,6 @@ (nkeys 1 :type (integer 1 #.+nkeys-limit+)) (valuep nil :type (member nil t)) (nlines 0 :type fixnum) - (field 0 :type field-type) (limit-fn #'default-limit-fn :type function) (mask 0 :type fixnum) (size 0 :type fixnum) @@ -186,13 +182,16 @@ ;;; are the forms of this constant which it is more convenient for the ;;; runtime code to use. (defconstant wrapper-cache-number-length - (integer-length layout-clos-hash-max)) -(defconstant wrapper-cache-number-mask layout-clos-hash-max) + (integer-length (1- layout-clos-hash-limit))) +(defconstant wrapper-cache-number-mask (1- layout-clos-hash-limit)) (defconstant wrapper-cache-number-adds-ok - (truncate most-positive-fixnum layout-clos-hash-max)) + (truncate most-positive-fixnum (1- layout-clos-hash-limit))) ;;;; wrappers themselves +;;; FIXME: delete this comment, possibly replacing it with a reference +;;; to Kiczales and Rodruigez +;;; ;;; This caching algorithm requires that wrappers have more than one ;;; wrapper cache number. You should think of these multiple numbers ;;; as being in columns. That is, for a given cache, the same column @@ -211,24 +210,9 @@ ;;; `pack' the wrapper cache numbers on machines where the addressing ;;; modes make that a good idea. -;;; In SBCL, as in CMU CL, we want to do type checking as early as -;;; possible; structures help this. The structures are hard-wired to -;;; have a fixed number of cache hash values, and that number must -;;; correspond to the number of cache lines we use. -(defconstant wrapper-cache-number-vector-length - layout-clos-hash-length) - (unless (boundp '*the-class-t*) (setq *the-class-t* nil)) -(defconstant +first-wrapper-cache-number-index+ 0) - -(declaim (inline next-wrapper-cache-number-index)) -(defun next-wrapper-cache-number-index (field-number) - (and (< field-number #.(1- wrapper-cache-number-vector-length)) - (1+ field-number))) - - (defun get-cache (nkeys valuep limit-fn nlines) (let ((cache (make-cache))) (declare (type cache cache)) @@ -237,7 +221,6 @@ (setf (cache-nkeys cache) nkeys (cache-valuep cache) valuep (cache-nlines cache) nlines - (cache-field cache) +first-wrapper-cache-number-index+ (cache-limit-fn cache) limit-fn (cache-mask cache) cache-mask (cache-size cache) actual-size @@ -250,8 +233,7 @@ (cache-overflow cache) nil) cache))) -(defun get-cache-from-cache (old-cache new-nlines - &optional (new-field +first-wrapper-cache-number-index+)) +(defun get-cache-from-cache (old-cache new-nlines) (let ((nkeys (cache-nkeys old-cache)) (valuep (cache-valuep old-cache)) (cache (make-cache))) @@ -265,7 +247,6 @@ (cache-nkeys cache) nkeys (cache-valuep cache) valuep (cache-nlines cache) nlines - (cache-field cache) new-field (cache-limit-fn cache) (cache-limit-fn old-cache) (cache-mask cache) cache-mask (cache-size cache) actual-size @@ -330,17 +311,16 @@ ;;; The basic functional version. This is used by the cache miss code to ;;; compute the primary location of an entry. -(defun compute-primary-cache-location (field mask wrappers) - (declare (type field-type field) (fixnum mask)) +(defun compute-primary-cache-location (mask wrappers) + (declare (fixnum mask)) (if (not (listp wrappers)) - (logand mask (layout-clos-hash wrappers field)) + (logand mask (layout-clos-hash wrappers)) (let ((location 0) (i 0)) (declare (fixnum location i)) (dolist (wrapper wrappers) ;; First add the cache number of this wrapper to location. - (let ((wrapper-cache-number (layout-clos-hash wrapper field))) - (declare (fixnum wrapper-cache-number)) + (let ((wrapper-cache-number (layout-clos-hash wrapper))) (if (zerop wrapper-cache-number) (return-from compute-primary-cache-location 0) (incf location wrapper-cache-number))) @@ -368,17 +348,15 @@ (declare (type cache to-cache from-cache) (fixnum from-location)) (let ((result 0) (cache-vector (cache-vector from-cache)) - (field (cache-field to-cache)) (mask (cache-mask to-cache)) (nkeys (cache-nkeys to-cache))) - (declare (type field-type field) (fixnum result mask nkeys) + (declare (fixnum result mask nkeys) (simple-vector cache-vector)) (dotimes-fixnum (i nkeys) ;; FIXME: Sometimes we get NIL here as wrapper, apparently because ;; another thread has stomped on the cache-vector. (let* ((wrapper (cache-vector-ref cache-vector (+ i from-location))) - (wcn (layout-clos-hash wrapper field))) - (declare (fixnum wcn)) + (wcn (layout-clos-hash wrapper))) (incf result wcn)) (when (and (not (zerop i)) (zerop (mod i wrapper-cache-number-adds-ok))) @@ -400,7 +378,6 @@ (limit-fn () (cache-limit-fn .cache.)) (size () (cache-size .cache.)) (mask () (cache-mask .cache.)) - (field () (cache-field .cache.)) (overflow () (cache-overflow .cache.)) ;; ;; Return T IFF this cache location is reserved. The @@ -578,7 +555,7 @@ (cache) (line-location line)))) (declare (ignorable #'cache #'nkeys #'line-size #'c-vector #'valuep #'nlines #'max-location #'limit-fn #'size - #'mask #'field #'overflow #'line-reserved-p + #'mask #'overflow #'line-reserved-p #'location-reserved-p #'line-location #'location-line #'line-wrappers #'location-wrappers #'line-matches-wrappers-p @@ -610,11 +587,6 @@ ;; FILL-CACHE won't return if WRAPPERS is nil, might as well check.. (aver wrappers) (or (fill-cache-p nil cache wrappers value) - (and (< (ceiling (* (cache-count cache) *cache-expand-threshold*)) - (if (= (cache-nkeys cache) 1) - (1- (cache-nlines cache)) - (cache-nlines cache))) - (adjust-cache cache wrappers value)) (expand-cache cache wrappers value))) (defvar *check-cache-p* nil) @@ -647,7 +619,7 @@ (defun probe-cache (cache wrappers &optional default limit-fn) (aver wrappers) (with-local-cache-functions (cache) - (let* ((location (compute-primary-cache-location (field) (mask) wrappers)) + (let* ((location (compute-primary-cache-location (mask) wrappers)) (limit (funcall (or limit-fn (limit-fn)) (nlines)))) (declare (fixnum location limit)) (when (location-reserved-p location) @@ -701,7 +673,7 @@ ;;; FIXME: Deceptive name as this has side-effects. (defun fill-cache-p (forcep cache wrappers value) (with-local-cache-functions (cache) - (let* ((location (compute-primary-cache-location (field) (mask) wrappers)) + (let* ((location (compute-primary-cache-location (mask) wrappers)) (primary (location-line location))) (declare (fixnum location primary)) ;; FIXME: I tried (aver (> location 0)) and (aver (not @@ -774,37 +746,6 @@ (+ from-loc i))))))) (maybe-check-cache cache))))))) -;;; Returns NIL or (values ) -;;; -;;; This is only called when it isn't possible to put the entry in the -;;; cache the easy way. That is, this function assumes that -;;; FILL-CACHE-P has been called as returned NIL. -;;; -;;; If this returns NIL, it means that it wasn't possible to find a -;;; wrapper field for which all of the entries could be put in the -;;; cache (within the limit). -(defun adjust-cache (cache wrappers value) - (with-local-cache-functions (cache) - (let ((ncache (get-cache-from-cache cache (nlines) (field)))) - (do ((nfield (cache-field ncache) - (next-wrapper-cache-number-index nfield))) - ((null nfield) nil) - (setf (cache-field ncache) nfield) - (labels ((try-one-fill-from-line (line) - (fill-cache-from-cache-p nil ncache cache line)) - (try-one-fill (wrappers value) - (fill-cache-p nil ncache wrappers value))) - (if (and (dotimes-fixnum (i (nlines) t) - (when (and (null (line-reserved-p i)) - (line-valid-p i wrappers)) - (unless (try-one-fill-from-line i) (return nil)))) - (dolist (wrappers+value (cache-overflow cache) t) - (unless (try-one-fill (car wrappers+value) (cdr wrappers+value)) - (return nil))) - (try-one-fill wrappers value)) - (return (maybe-check-cache ncache)) - (flush-cache-vector-internal (cache-vector ncache)))))))) - ;;; returns: (values ) (defun expand-cache (cache wrappers value) ;;(declare (values cache)) @@ -814,8 +755,7 @@ (unless (fill-cache-from-cache-p nil ncache cache line) (do-one-fill (line-wrappers line) (line-value line)))) (do-one-fill (wrappers value) - (setq ncache (or (adjust-cache ncache wrappers value) - (fill-cache-p t ncache wrappers value)))) + (setq ncache (fill-cache-p t ncache wrappers value))) (try-one-fill (wrappers value) (fill-cache-p nil ncache wrappers value))) (dotimes-fixnum (i (nlines)) diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp index 3cbdc7c..7ed3463 100644 --- a/src/pcl/dlisp.lisp +++ b/src/pcl/dlisp.lisp @@ -220,9 +220,7 @@ (let ((instance nil) (arglist ()) (closure-variables ()) - (field +first-wrapper-cache-number-index+) (read-form (emit-slot-read-form class-slot-p 'index 'slots))) - ;;we need some field to do the fast obsolete check (ecase reader/writer ((:reader :boundp) (setq instance (dfun-arg-symbol 0) @@ -248,7 +246,7 @@ (fsc-instance-wrapper ,instance))))) (block access (when (and wrapper - (/= (layout-clos-hash wrapper ,field) 0) + (/= (layout-clos-hash wrapper) 0) ,@(if (eql 1 1-or-2-class) `((eq wrapper wrapper-0)) `((or (eq wrapper wrapper-0) @@ -385,13 +383,12 @@ (error "Every metatype is T.")) `(prog () (return - (let ((field (cache-field ,cache-var)) - (cache-vector (cache-vector ,cache-var)) + (let ((cache-vector (cache-vector ,cache-var)) (mask (cache-mask ,cache-var)) (size (cache-size ,cache-var)) (overflow (cache-overflow ,cache-var)) ,@wrapper-bindings) - (declare (fixnum size field mask)) + (declare (fixnum size mask)) ,(emit-cache-lookup wrapper-vars miss-tag value-var) ,hit-form)) ,miss-tag @@ -500,7 +497,7 @@ (go ,miss-label))))))) (defun emit-1-wrapper-compute-primary-cache-location (wrapper miss-label) - `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field))) + `(let ((wrapper-cache-no (layout-clos-hash ,wrapper))) (declare (fixnum wrapper-cache-no)) (when (zerop wrapper-cache-no) (go ,miss-label)) ,(let ((form `(logand mask wrapper-cache-no))) @@ -513,7 +510,7 @@ ,@(let ((adds 0) (len (length wrappers))) (declare (fixnum adds len)) (mapcar (lambda (wrapper) - `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field))) + `(let ((wrapper-cache-no (layout-clos-hash ,wrapper))) (declare (fixnum wrapper-cache-no)) (when (zerop wrapper-cache-no) (go ,miss-label)) (setq primary (the fixnum (+ primary wrapper-cache-no))) diff --git a/src/pcl/wrapper.lisp b/src/pcl/wrapper.lisp index 807a789..f8dc323 100644 --- a/src/pcl/wrapper.lisp +++ b/src/pcl/wrapper.lisp @@ -142,10 +142,7 @@ ;; FIXME: We are here inside PCL lock, but might someone be ;; accessing the wrapper at the same time from outside the lock? - ;; Can it matter that they get 0 from one slot and a valid value - ;; from another? - (dotimes (i layout-clos-hash-length) - (setf (layout-clos-hash owrapper i) 0)) + (setf (layout-clos-hash owrapper) 0) ;; FIXME: We could save a whopping cons by using (STATE . WRAPPER) ;; instead diff --git a/version.lisp-expr b/version.lisp-expr index 8b8f470..c0fe41d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.6.1" +"1.0.6.2" -- 1.7.10.4