From 9be48f2a73ca5f4cc0848b8c0adad7127de10373 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 14 Apr 2007 09:48:40 +0000 Subject: [PATCH] 1.0.4.85: small PCL cleanups and thread-safety notes * CACHE-NUMBER-VECTOR-REF and WRAPPER-CACHE-NUMBER-VECTOR-REF were equivalent to LAYOUT-CLOS-HASH. Use only the latter for easier reading. * *PREVIOUS-NWRAPPERS* is protected by the PCL lock, so ok. * The whole of dlisp2.lisp is currently dead code. --- doc/internals-notes/threading-specials | 4 ++- src/pcl/cache.lisp | 45 ++++++++++++++++---------------- src/pcl/dlisp.lisp | 7 +++-- src/pcl/dlisp2.lisp | 4 +++ version.lisp-expr | 2 +- 5 files changed, 34 insertions(+), 28 deletions(-) diff --git a/doc/internals-notes/threading-specials b/doc/internals-notes/threading-specials index aea00d3..914e83f 100644 --- a/doc/internals-notes/threading-specials +++ b/doc/internals-notes/threading-specials @@ -132,6 +132,9 @@ bound & safe: SB-PCL::*PRECOMPILING-LAP* SB-PCL::*CACHE-MISS-VALUES-STACK* +protected by PCL-LOCK: + SB-PCL::*PREVIOUS-NWRAPPERS* + believed protected by the compiler-lock: SB-PCL::*ALL-CTORS* SB-PCL::*FGENS* @@ -148,7 +151,6 @@ potentially unsafe: SB-PCL::*PVS* SB-PCL::*SLOT-NAME-LISTS-INNER* SB-PCL::*SLOT-NAME-LISTS-OUTER* - SB-PCL::*PREVIOUS-NWRAPPERS* debugging / profiling -- low relevance: SB-PCL::*DFUN-COUNT* diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 129ebbf..c9960ac 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -118,6 +118,16 @@ (defmacro modify-cache (cache-vector &body body) `(with-pcl-lock + ;; This locking scheme is less the sufficient, and not what the + ;; PCL implementors had planned: apparently we should increment + ;; the lock count atomically, and all cache users should check + ;; the count before and after they touch cache: if the counts + ;; match the cache was not altered, if they don't match the + ;; work needs to be redone. + ;; + ;; We probably want to re-engineer things so that the whole + ;; cache vector gets replaced atomically when we do things + ;; to it that could affect others. (multiple-value-prog1 (progn ,@body) (let ((old-count (cache-vector-lock-count ,cache-vector))) @@ -288,21 +298,6 @@ (and (< field-number #.(1- wrapper-cache-number-vector-length)) (1+ field-number))) -;;; FIXME: Why are there two layers here, with one operator trivially -;;; defined in terms of the other? It'd be nice either to have a -;;; comment explaining why the separation is valuable, or to collapse -;;; it into a single layer. -;;; -;;; Second FIXME deleted from here. Setting the "hash" values is OK: -;;; that's part of the magic we need to do to obsolete things. The -;;; hash values are used as indexes to the cache vectors. Nikodemus -;;; thinks both "layers" should go away, and we should just use the -;;; LAYOUT-CLOS-HASH directly. -(defmacro cache-number-vector-ref (cnv n) - `(wrapper-cache-number-vector-ref ,cnv ,n)) -(defmacro wrapper-cache-number-vector-ref (wrapper n) - `(layout-clos-hash ,wrapper ,n)) - (declaim (inline wrapper-class*)) (defun wrapper-class* (wrapper) (or (wrapper-class wrapper) @@ -326,9 +321,10 @@ (defun invalid-wrapper-p (wrapper) (not (null (layout-invalid wrapper)))) -;;; FIXME: This needs a lock +;;; We only use this inside INVALIDATE-WRAPPER. (defvar *previous-nwrappers* (make-hash-table)) +;;; We always call this inside WITH-PCL-LOCK. (defun invalidate-wrapper (owrapper state nwrapper) (aver (member state '(:flush :obsolete) :test #'eq)) (let ((new-previous ())) @@ -346,8 +342,13 @@ (setf (cadr previous) nwrapper) (push previous new-previous)) + ;; 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 (cache-number-vector-ref owrapper i) 0)) + (setf (layout-clos-hash owrapper i) 0)) + ;; FIXME: We could save a whopping cons by using (STATE . WRAPPER) ;; instead (push (setf (layout-invalid owrapper) (list state nwrapper)) @@ -492,15 +493,13 @@ (defun compute-primary-cache-location (field mask wrappers) (declare (type field-type field) (fixnum mask)) (if (not (listp wrappers)) - (logand mask - (the fixnum (wrapper-cache-number-vector-ref wrappers field))) + (logand mask (layout-clos-hash wrappers field)) (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 (wrapper-cache-number-vector-ref wrapper - field))) + (let ((wrapper-cache-number (layout-clos-hash wrapper field))) (declare (fixnum wrapper-cache-number)) (if (zerop wrapper-cache-number) (return-from compute-primary-cache-location 0) @@ -535,8 +534,10 @@ (declare (type field-type field) (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 (wrapper-cache-number-vector-ref wrapper field))) + (wcn (layout-clos-hash wrapper field))) (declare (fixnum wcn)) (incf result wcn)) (when (and (not (zerop i)) diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp index e0d23e7..b744883 100644 --- a/src/pcl/dlisp.lisp +++ b/src/pcl/dlisp.lisp @@ -173,7 +173,7 @@ (fsc-instance-wrapper ,instance))))) (block access (when (and wrapper - (/= (wrapper-cache-number-vector-ref wrapper ,field) 0) + (/= (layout-clos-hash wrapper ,field) 0) ,@(if (eql 1 1-or-2-class) `((eq wrapper wrapper-0)) `((or (eq wrapper wrapper-0) @@ -420,7 +420,7 @@ (go ,miss-label))))))) (defun emit-1-wrapper-compute-primary-cache-location (wrapper miss-label) - `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref ,wrapper field))) + `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field))) (declare (fixnum wrapper-cache-no)) (when (zerop wrapper-cache-no) (go ,miss-label)) ,(let ((form `(logand mask wrapper-cache-no))) @@ -433,8 +433,7 @@ ,@(let ((adds 0) (len (length wrappers))) (declare (fixnum adds len)) (mapcar (lambda (wrapper) - `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref - ,wrapper field))) + `(let ((wrapper-cache-no (layout-clos-hash ,wrapper field))) (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/dlisp2.lisp b/src/pcl/dlisp2.lisp index 504c540..538c781 100644 --- a/src/pcl/dlisp2.lisp +++ b/src/pcl/dlisp2.lisp @@ -22,6 +22,10 @@ ;;;; specification. (in-package "SB-PCL") + +;;;; The whole of this file is dead code as long as *optimize-cache-functions-p* +;;;; is true, which it currently _always_ is. + (defun emit-reader/writer-function (reader/writer 1-or-2-class class-slot-p) (values diff --git a/version.lisp-expr b/version.lisp-expr index fb9d26e..6a8d3a3 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.4.84" +"1.0.4.85" -- 1.7.10.4