Changeset 15266

Timestamp:

Mar 22, 2012, 7:00:44 AM (13 years ago)

Author:

Gary Byers

Message:

Revert the last change. Use car of method list to find GF in optimized
reader methods. Pass test suite.

File:

• trunk/source/level-1/l1-clos.lisp (modified) (7 diffs)

trunk/source/level-1/l1-clos.lisp

@@ -1993 +1993 @@
                          (eq (instance.class-wrapper instance) wrapper)))
              (%slot-ref (instance.slots instance) location))
-            (t (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))))
+            (t (no-applicable-method (method-generic-function (car (%gf-dispatch-table-methods dt))) instance))))))
 (register-dcode-proto #'singleton-reader-dcode *gf-proto-one-arg*)
 
@@ -2005 +2005 @@
               (%svref dt %gf-dispatch-table-first-data))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
-      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance)))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-table-methods dt))) instance)))
 (register-dcode-proto #'reader-constant-location-dcode *gf-proto-one-arg*)
 
@@ -2027 +2027 @@
              (not (eql 0 (sbit bits defining-class-ordinal))))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
-      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-table-methods dt))) instance))))
 (register-dcode-proto #'reader-constant-location-inherited-from-single-class-dcode *gf-proto-one-arg*)
 
@@ -2084 +2084 @@
             (return t)))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
-      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-table-methods dt))) instance))))
 (register-dcode-proto #'reader-constant-location-inherited-from-multiple-classes-dcode *gf-proto-one-arg*)
 
@@ -2100 +2100 @@
     (if location
       (%slot-ref (instance.slots instance) location)
-      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-table-methods dt))) instance))))
 (register-dcode-proto #'reader-variable-location-dcode *gf-proto-one-arg*)
 
@@ -2170 +2170 @@
                   (unless (< argnum 0)
                     (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
-                          (%gf-dispatch-table-gf dt) (cons f (%gf-dcode f)))))
+                          (%gf-dispatch-table-gf dt) (%gf-dcode f))))
                     
                 (cond ((null (cdr alist))
@@ -2568 +2568 @@
            (argnum (%gf-dispatch-table-argnum dt)))
       (when (< argnum 0)
-        (let* ((dcode (cdr (%gf-dispatch-table-gf dt))))
+        (let* ((dcode (%gf-dispatch-table-gf dt)))
           (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
                 (%gf-dispatch-table-gf dt) f