Changeset 11365

Timestamp:

Nov 15, 2008, 2:28:24 PM (12 years ago)

Author:

gz

Message:

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

File:

• branches/working-0711/ccl/level-1/l1-clos.lisp (modified) (4 diffs)

branches/working-0711/ccl/level-1/l1-clos.lisp

@@ -302 +302 @@
 (defvar *update-slots-preserve-existing-wrapper* nil)
 
+(defvar *optimized-dependents* (make-hash-table :test 'eq :weak :key)
+  "Hash table mapping a class to a list of all objects that have been optimized to
+   depend in some way on the layout of the class")
+
+(defun note-class-dependent (class gf)
+  (pushnew gf (gethash class *optimized-dependents*)))
+
+;; Yeah, yeah, when/if this gets more general can use generic functions.
+(defun unoptimize-dependents (class)
+  (loop for obj in (gethash class *optimized-dependents*)
+        do (etypecase obj
+             (standard-generic-function (compute-dcode obj)))))
+
 (defun update-slots (class eslotds)
   (let* ((instance-slots (extract-slotds-with-allocation :instance eslotds))
@@ -321 +334 @@
                  (make-instances-obsolete class)
                  (%cons-wrapper class)))))
+    (when old-wrapper
+      (unoptimize-dependents class))
     (setf (%class-slots class) eslotds)
     (setf (%wrapper-instance-slots new-wrapper) new-ordering
@@ -2004 +2019 @@
 
 
-
 ;;; Try to replace gf dispatch with something faster in f.
-(defun %snap-reader-method (f)
+(defun %snap-reader-method (f &key (redefinable t))
   (when (slot-boundp f 'methods)
     (let* ((methods (generic-function-methods f)))
@@ -2032 +2046 @@
               ;; of the alist pairs - are small, positive fixnums.
               (when (every (lambda (pair) (typep (cdr pair) 'fixnum)) alist)
+                (when redefinable
+                  (loop for (c . nil) in alist
+                        do (note-class-dependent c f)))
                 (clear-gf-dispatch-table dt)
                 (setf (%gf-dispatch-table-argnum dt) -1) ;mark as non-standard