(in-package "SB-PCL")
\f
+;;; Ye olde CMUCL comment follows, but it seems likely that the paper
+;;; that would be inserted would resemble Kiczales and Rodruigez,
+;;; Efficient Method Dispatch in PCL, ACM 1990. Some of the details
+;;; changed between that paper and "May Day PCL" of 1992; some other
+;;; details have changed since, but reading that paper gives the broad
+;;; idea.
+;;;
;;; The caching algorithm implemented:
;;;
;;; << put a paper here >>
;;; STRUCTURE-CLASS seen only structure classes
(defun raise-metatype (metatype new-specializer)
(let ((slot (find-class 'slot-class))
- (std (find-class 'std-class))
(standard (find-class 'standard-class))
(fsc (find-class 'funcallable-standard-class))
(condition (find-class 'condition-class))
(class-of x))))
(cond
((eq x *the-class-t*) t)
- ((*subtypep meta-specializer std) 'standard-instance)
((*subtypep meta-specializer standard) 'standard-instance)
((*subtypep meta-specializer fsc) 'standard-instance)
((*subtypep meta-specializer condition) 'condition-instance)
(defun fill-cache (cache wrappers value)
;; FILL-CACHE won't return if WRAPPERS is nil, might as well check..
- (assert wrappers)
+ (aver wrappers)
(or (fill-cache-p nil cache wrappers value)
(and (< (ceiling (* (cache-count cache) *cache-expand-threshold*))
(defun probe-cache (cache wrappers &optional default limit-fn)
;;(declare (values value))
- (unless wrappers
- ;; FIXME: This and another earlier test on a WRAPPERS arg can
- ;; be compact assertoids.
- (error "WRAPPERS arg is NIL!"))
+ (aver wrappers)
(with-local-cache-functions (cache)
(let* ((location (compute-primary-cache-location (field) (mask) wrappers))
(limit (funcall (or limit-fn (limit-fn)) (nlines))))
(let* ((location (compute-primary-cache-location (field) (mask) wrappers))
(primary (location-line location)))
(declare (fixnum location primary))
+ ;; FIXME: I tried (aver (> location 0)) and (aver (not
+ ;; (location-reserved-p location))) here, on the basis that
+ ;; particularly passing a LOCATION of 0 for a cache with more
+ ;; than one key would cause PRIMARY to be -1. However, the
+ ;; AVERs triggered during the bootstrap, and removing them
+ ;; didn't cause anything to break, so I've left them removed.
+ ;; I'm still confused as to what is right. -- CSR, 2006-04-20
(multiple-value-bind (free emptyp)
(find-free-cache-line primary cache wrappers)
(when (or forcep emptyp)
(do-one-fill wrappers value))
(maybe-check-cache ncache)))))
\f
+(defvar *pcl-misc-random-state* (make-random-state))
+
;;; This is the heart of the cache filling mechanism. It implements
;;; the decisions about where entries are placed.
;;;
(when (>= osep limit)
(return-from find-free-cache-line (values primary nil)))
(when (cond ((= nsep limit) t)
- ((= nsep osep) (zerop (random 2)))
+ ((= nsep osep)
+ (zerop (random 2 *pcl-misc-random-state*)))
((> nsep osep) t)
(t nil))
;; See whether we can displace what is in this line so that we
((8 16) 4)
(otherwise 6)))
-(defvar *empty-cache* (make-cache)) ; for defstruct slot initial value forms