Index: /trunk/source/level-1/l1-clos.lisp
===================================================================
--- /trunk/source/level-1/l1-clos.lisp	(revision 14859)
+++ /trunk/source/level-1/l1-clos.lisp	(revision 14860)
@@ -2137,5 +2137,9 @@
                         do (note-class-dependent c f)))
                 (clear-gf-dispatch-table dt)
-                (setf (%gf-dispatch-table-argnum dt) -1) ;mark as non-standard
+                (let* ((argnum (%gf-dispatch-table-argnum dt)))
+                  (unless (< argnum 0)
+                    (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
+                          (%gf-dispatch-table-gf dt) (%gf-dcode f))))
+                    
                 (cond ((null (cdr alist))
                        ;; Method is only applicable to a single class.
@@ -2531,7 +2535,12 @@
   ;; Un-snap reader methods, undo other GF optimizations.
   (dolist (f (population-data %all-gfs%))
-    (let* ((dt (%gf-dispatch-table f)))
-      (clear-gf-dispatch-table dt)
-      (compute-dcode f))))
+    (let* ((dt (%gf-dispatch-table f))
+           (argnum (%gf-dispatch-table-argnum dt)))
+      (when (< argnum 0)
+        (let* ((dcode (%gf-dispatch-table-gf dt)))
+          (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
+                (%gf-dispatch-table-gf dt) f
+                (%gf-dcode f) dcode)
+        (clear-gf-dispatch-table dt))))))
 
 ;;; If there's a single method (with standard method combination) on
Index: /trunk/source/level-1/l1-dcode.lisp
===================================================================
--- /trunk/source/level-1/l1-dcode.lisp	(revision 14859)
+++ /trunk/source/level-1/l1-dcode.lisp	(revision 14860)
@@ -182,17 +182,18 @@
 (defun clear-gf-cache (gf)
   #-bccl (unless t (typep gf 'standard-generic-function) 
-           (report-bad-arg gf 'standard-generic-function))
+                 (report-bad-arg gf 'standard-generic-function))
   (let ((dt (%gf-dispatch-table gf)))
-    (if (eq (%gf-dispatch-table-size dt) *min-gf-dispatch-table-size*)
-      (clear-gf-dispatch-table dt)
-      (let ((new (make-gf-dispatch-table)))
-        (setf (%gf-dispatch-table-methods new) (%gf-dispatch-table-methods dt))
-        (setf (%gf-dispatch-table-precedence-list new)
-              (%gf-dispatch-table-precedence-list dt))
-        (setf (%gf-dispatch-table-gf new) gf)
-        (setf (%gf-dispatch-table-keyvect new)
-              (%gf-dispatch-table-keyvect dt))
-        (setf (%gf-dispatch-table-argnum new) (%gf-dispatch-table-argnum dt))
-        (setf (%gf-dispatch-table gf) new)))))
+    (unless (< (%gf-dispatch-table-argnum dt) 0) ;reader-method optimization
+      (if (eq (%gf-dispatch-table-size dt) *min-gf-dispatch-table-size*)
+        (clear-gf-dispatch-table dt)
+        (let ((new (make-gf-dispatch-table)))
+          (setf (%gf-dispatch-table-methods new) (%gf-dispatch-table-methods dt))
+          (setf (%gf-dispatch-table-precedence-list new)
+                (%gf-dispatch-table-precedence-list dt))
+          (setf (%gf-dispatch-table-gf new) gf)
+          (setf (%gf-dispatch-table-keyvect new)
+                (%gf-dispatch-table-keyvect dt))
+          (setf (%gf-dispatch-table-argnum new) (%gf-dispatch-table-argnum dt))
+          (setf (%gf-dispatch-table gf) new))))))
 
 (defun %gf-dispatch-table-store-conditional (dt index new)