- (let ((pv-table (outer (mapcar #'inner slot-name-lists))))
- (when new-p
- (let ((pv-index 0))
- (dolist (slot-name-list slot-name-lists)
- (dolist (slot-name (cdr slot-name-list))
- (note-pv-table-reference slot-name pv-index pv-table)
- (incf pv-index)))
- (setf (pv-table-pv-size pv-table) pv-index)))
- pv-table))))
-
-(defun note-pv-table-reference (ref pv-offset pv-table)
- (let ((entry (gethash ref *pv-key-to-pv-table-table*)))
- (when (listp entry)
- (let ((table-entry (assq pv-table entry)))
- (when (and (null table-entry)
- (> (length entry) 8))
- (let ((new-table-table (make-hash-table :size 16 :test 'eq)))
- (dolist (table-entry entry)
- (setf (gethash (car table-entry) new-table-table)
- (cdr table-entry)))
- (setf (gethash ref *pv-key-to-pv-table-table*) new-table-table)))
- (when (listp entry)
- (if (null table-entry)
- (let ((new (cons pv-table pv-offset)))
- (if (consp entry)
- (push new (cdr entry))
- (setf (gethash ref *pv-key-to-pv-table-table*)
- (list new))))
- (push pv-offset (cdr table-entry)))
- (return-from note-pv-table-reference nil))))
- (let ((list (gethash pv-table entry)))
- (if (consp list)
- (push pv-offset (cdr list))
- (setf (gethash pv-table entry) (list pv-offset)))))
- nil)
-
-(defun map-pv-table-references-of (ref function)
- (let ((entry (gethash ref *pv-key-to-pv-table-table*)))
- (if (listp entry)
- (dolist (table+pv-offset-list entry)
- (funcall function
- (car table+pv-offset-list)
- (cdr table+pv-offset-list)))
- (maphash function entry)))
- ref)
+ (sb-thread::with-spinlock (*pv-lock*)
+ (let ((pv-table
+ (%intern-pv-table (mapcar #'intern-slot-names slot-name-lists))))
+ (when new-p
+ (let ((pv-index 0))
+ (dolist (slot-name-list slot-name-lists)
+ (dolist (slot-name (cdr slot-name-list))
+ (pushnew pv-table (gethash slot-name *pv-tables-by-slots*))
+ (incf pv-index)))
+ (setf (pv-table-pv-size pv-table) pv-index)))
+ pv-table)))))
+
+(defun map-pv-table-references-of (slot-name function)
+ (dolist (table (sb-thread::with-spinlock (*pv-lock*)
+ (gethash slot-name *pv-tables-by-slots*)))
+ (funcall function table)))