Changeset 11364 for trunk/source/level-1


Ignore:
Timestamp:
Nov 15, 2008, 2:26:39 PM (11 years ago)
Author:
gz
Message:

Keep track of reader methods that have been snapped and unsnap them whenever slots are redefined

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos.lisp

    r11120 r11364  
    302302(defvar *update-slots-preserve-existing-wrapper* nil)
    303303
     304(defvar *optimized-dependents* (make-hash-table :test 'eq :weak :key)
     305  "Hash table mapping a class to a list of all objects that have been optimized to
     306   depend in some way on the layout of the class")
     307
     308(defun note-class-dependent (class gf)
     309  (pushnew gf (gethash class *optimized-dependents*)))
     310
     311;; Yeah, yeah, when/if this gets more general can use generic functions.
     312(defun unoptimize-dependents (class)
     313  (loop for obj in (gethash class *optimized-dependents*)
     314        do (etypecase obj
     315             (standard-generic-function (compute-dcode obj)))))
     316
    304317(defun update-slots (class eslotds)
    305318  (let* ((instance-slots (extract-slotds-with-allocation :instance eslotds))
     
    321334                 (make-instances-obsolete class)
    322335                 (%cons-wrapper class)))))
     336    (when old-wrapper
     337      (unoptimize-dependents class))
    323338    (setf (%class-slots class) eslotds)
    324339    (setf (%wrapper-instance-slots new-wrapper) new-ordering
     
    20042019
    20052020
    2006 
    20072021;;; Try to replace gf dispatch with something faster in f.
    2008 (defun %snap-reader-method (f)
     2022(defun %snap-reader-method (f &key (redefinable t))
    20092023  (when (slot-boundp f 'methods)
    20102024    (let* ((methods (generic-function-methods f)))
     
    20322046              ;; of the alist pairs - are small, positive fixnums.
    20332047              (when (every (lambda (pair) (typep (cdr pair) 'fixnum)) alist)
     2048                (when redefinable
     2049                  (loop for (c . nil) in alist
     2050                        do (note-class-dependent c f)))
    20342051                (clear-gf-dispatch-table dt)
    20352052                (setf (%gf-dispatch-table-argnum dt) -1) ;mark as non-standard
Note: See TracChangeset for help on using the changeset viewer.