Changeset 15265 for trunk/source/level-1


Ignore:
Timestamp:
Mar 22, 2012, 1:23:42 PM (7 years ago)
Author:
gb
Message:

When we optimize a GF via %SNAP-READER-METHOD, we store the GF's
original dcode in the dispatch-table's GF slot so that we can
restore it if/when we undo the optimization; this is done under
the assumption that the optimized dcode doesn't need access to
the GF for method dispatch, but it does need it in order to
report NO-APPLICABLE-METHOD sanely. Store a CONS of (gf . dcode)
in the dispatch table's GF slot, access the car of that cons
when reporting no-applicable-method, and dtrt when undoing the
optimization.

File:
1 edited

Legend:

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

    r15093 r15265  
    19931993                         (eq (instance.class-wrapper instance) wrapper)))
    19941994             (%slot-ref (instance.slots instance) location))
    1995             (t (no-applicable-method (%gf-dispatch-table-gf dt) instance))))))
     1995            (t (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))))
    19961996(register-dcode-proto #'singleton-reader-dcode *gf-proto-one-arg*)
    19971997
     
    20052005              (%svref dt %gf-dispatch-table-first-data))
    20062006      (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
    2007       (no-applicable-method (%gf-dispatch-table-gf dt) instance)))
     2007      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance)))
    20082008(register-dcode-proto #'reader-constant-location-dcode *gf-proto-one-arg*)
    20092009
     
    20272027             (not (eql 0 (sbit bits defining-class-ordinal))))
    20282028      (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
    2029       (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     2029      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
    20302030(register-dcode-proto #'reader-constant-location-inherited-from-single-class-dcode *gf-proto-one-arg*)
    20312031
     
    20842084            (return t)))
    20852085      (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
    2086       (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     2086      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
    20872087(register-dcode-proto #'reader-constant-location-inherited-from-multiple-classes-dcode *gf-proto-one-arg*)
    20882088
     
    21002100    (if location
    21012101      (%slot-ref (instance.slots instance) location)
    2102       (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     2102      (no-applicable-method (car (%gf-dispatch-table-gf dt)) instance))))
    21032103(register-dcode-proto #'reader-variable-location-dcode *gf-proto-one-arg*)
    21042104
     
    21702170                  (unless (< argnum 0)
    21712171                    (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
    2172                           (%gf-dispatch-table-gf dt) (%gf-dcode f))))
     2172                          (%gf-dispatch-table-gf dt) (cons f (%gf-dcode f)))))
    21732173                   
    21742174                (cond ((null (cdr alist))
     
    25682568           (argnum (%gf-dispatch-table-argnum dt)))
    25692569      (when (< argnum 0)
    2570         (let* ((dcode (%gf-dispatch-table-gf dt)))
     2570        (let* ((dcode (cdr (%gf-dispatch-table-gf dt))))
    25712571          (setf (%gf-dispatch-table-argnum dt) (lognot argnum)
    25722572                (%gf-dispatch-table-gf dt) f
Note: See TracChangeset for help on using the changeset viewer.