Ignore:
Timestamp:
Jul 2, 2011, 10:37:33 AM (9 years ago)
Author:
gb
Message:

In CLEAR-GF-CACHE, don't do anything if the dispatch table's
ARGNUM slot has a negative value.

In %SNAP-READER-METHOD, if the gf's dispatch table's argnum
is non-negative, complement it and store the gf's dcode in
the dt's GENERIC-FUNCTION slot.

In PESSIMIZE-CLOS, if a GF's dispatch-table's argnum is negative,
complement it and set the gf's dcode to the value saved in the
dispatch-table's GENERIC-FUNCTION slot. (We can't use COMPUTE-DCODE
to restore the GF's dcode, since it calls slot accessors, possibly
including the one that we're modifying in a non-atomic way.)

It's not clear that PESSIMIZE-CLOS has to deal with anything but
snapped reader methods; DCODE-FOR-UNIVERSALLY-APPLICABLE-SINGLETON
looks like it was half-finished. If we do things like that, we may
need to adopt and follow similar conventions to allow it to be undone,

File:
1 edited

Legend:

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

    r14558 r14860  
    182182(defun clear-gf-cache (gf)
    183183  #-bccl (unless t (typep gf 'standard-generic-function)
    184            (report-bad-arg gf 'standard-generic-function))
     184                 (report-bad-arg gf 'standard-generic-function))
    185185  (let ((dt (%gf-dispatch-table gf)))
    186     (if (eq (%gf-dispatch-table-size dt) *min-gf-dispatch-table-size*)
    187       (clear-gf-dispatch-table dt)
    188       (let ((new (make-gf-dispatch-table)))
    189         (setf (%gf-dispatch-table-methods new) (%gf-dispatch-table-methods dt))
    190         (setf (%gf-dispatch-table-precedence-list new)
    191               (%gf-dispatch-table-precedence-list dt))
    192         (setf (%gf-dispatch-table-gf new) gf)
    193         (setf (%gf-dispatch-table-keyvect new)
    194               (%gf-dispatch-table-keyvect dt))
    195         (setf (%gf-dispatch-table-argnum new) (%gf-dispatch-table-argnum dt))
    196         (setf (%gf-dispatch-table gf) new)))))
     186    (unless (< (%gf-dispatch-table-argnum dt) 0) ;reader-method optimization
     187      (if (eq (%gf-dispatch-table-size dt) *min-gf-dispatch-table-size*)
     188        (clear-gf-dispatch-table dt)
     189        (let ((new (make-gf-dispatch-table)))
     190          (setf (%gf-dispatch-table-methods new) (%gf-dispatch-table-methods dt))
     191          (setf (%gf-dispatch-table-precedence-list new)
     192                (%gf-dispatch-table-precedence-list dt))
     193          (setf (%gf-dispatch-table-gf new) gf)
     194          (setf (%gf-dispatch-table-keyvect new)
     195                (%gf-dispatch-table-keyvect dt))
     196          (setf (%gf-dispatch-table-argnum new) (%gf-dispatch-table-argnum dt))
     197          (setf (%gf-dispatch-table gf) new))))))
    197198
    198199(defun %gf-dispatch-table-store-conditional (dt index new)
Note: See TracChangeset for help on using the changeset viewer.