[Openmcl-cvs-notifications] r15279 - in /release/1.8/source: ./ level-1/l1-clos.lisp

[rme at clozure.com]

Author: rme
Date: Wed Mar 28 11:40:02 2012
New Revision: 15279

Log:
Report no-applicable-method more sanely for optimized
reader methods.

Modified:
    release/1.8/source/   (props changed)
    release/1.8/source/level-1/l1-clos.lisp

Propchange: release/1.8/source/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Wed Mar 28 11:40:02 2012
@@ -4,4 +4,4 @@
 /branches/rme-logops:13875-13886
 /branches/working-0711/ccl:7970-13192,13197-13198,13202,13208,13214,13235-=
13236,13239,13263,13277-13278,13290,13293-13294,13302-13306,13331-13332,133=
39,13361-13364,13379,13383,13386,13388,13409,13435-13436,13438,13440-13442,=
13460-13461,13465,13467,13476,13487,13490,13492-13493,13502-13528,13545-135=
47,13549,13557-13558
 /release/1.5/source:13667
-/trunk/source:15221-15223,15225-15226,15228,15249,15252,15255-15256,15259,=
15277
+/trunk/source:15221-15223,15225-15226,15228,15249,15252,15255-15256,15259,=
15265-15266,15277

Modified: release/1.8/source/level-1/l1-clos.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.8/source/level-1/l1-clos.lisp (original)
+++ release/1.8/source/level-1/l1-clos.lisp Wed Mar 28 11:40:02 2012
@@ -1991,7 +1991,7 @@
                   (progn (update-obsolete-instance instance)
                          (eq (instance.class-wrapper instance) wrapper)))
              (%slot-ref (instance.slots instance) location))
-            (t (no-applicable-method (%gf-dispatch-table-gf dt) instance))=
))))
+            (t (no-applicable-method (method-generic-function (car (%gf-di=
spatch-table-methods dt))) instance))))))
 (register-dcode-proto #'singleton-reader-dcode *gf-proto-one-arg*)
 =

 ;;; Dcode for a GF whose methods are all reader-methods which access a
@@ -2003,7 +2003,7 @@
               (%class-of-instance instance))
               (%svref dt %gf-dispatch-table-first-data))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-tab=
le-first-data)))
-      (no-applicable-method (%gf-dispatch-table-gf dt) instance)))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-ta=
ble-methods dt))) instance)))
 (register-dcode-proto #'reader-constant-location-dcode *gf-proto-one-arg*)
 =

 ;;; Dcode for a GF whose methods are all reader-methods which access a
@@ -2025,7 +2025,7 @@
              (< defining-class-ordinal (the fixnum (uvsize bits)))
              (not (eql 0 (sbit bits defining-class-ordinal))))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-tab=
le-first-data)))
-      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-ta=
ble-methods dt))) instance))))
 (register-dcode-proto #'reader-constant-location-inherited-from-single-cla=
ss-dcode *gf-proto-one-arg*)
 =

 ;;; It may be faster to make individual functions that take their
@@ -2082,7 +2082,7 @@
                      (not (eql 0 (sbit bits ordinal))))
             (return t)))
       (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-tab=
le-first-data)))
-      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-ta=
ble-methods dt))) instance))))
 (register-dcode-proto #'reader-constant-location-inherited-from-multiple-c=
lasses-dcode *gf-proto-one-arg*)
 =

 =

@@ -2098,7 +2098,7 @@
                      alist))))
     (if location
       (%slot-ref (instance.slots instance) location)
-      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
+      (no-applicable-method (method-generic-function (car (%gf-dispatch-ta=
ble-methods dt))) instance))))
 (register-dcode-proto #'reader-variable-location-dcode *gf-proto-one-arg*)
 =

 (defun class-and-slot-location-alist (classes slot-name)