Changeset 9945


Ignore:
Timestamp:
Jul 10, 2008, 8:57:14 AM (11 years ago)
Author:
gb
Message:

SINGLETON-READER-DCODE: store/use the wrapper, not the class.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r9847 r9945  
    13331333          (setf (slot-value class 'direct-superclasses) new))
    13341334      (fdefinition '%class-direct-subclasses) #'class-direct-subclasses
    1335       (fdefinition '%class-own-wrapper) #'class-own-wrapper
     1335      ;(fdefinition '%class-own-wrapper) #'class-own-wrapper
    13361336      (fdefinition '(setf %class-own-wrapper)) #'(setf class-own-wrapper)
    13371337)
     
    18381838(defun singleton-reader-dcode (dt instance)
    18391839  (declare (optimize (speed 3) (safety 0)))
    1840   (let* ((class (%svref dt %gf-dispatch-table-first-data))
     1840  (let* ((wrapper (%svref dt %gf-dispatch-table-first-data))
    18411841         (location (%svref dt (1+ %gf-dispatch-table-first-data))))
    18421842    (if (eq (if (eq (typecode instance) target::subtag-instance)
    1843               (%class-of-instance instance))
    1844             class)
     1843              (instance.class-wrapper instance))
     1844            wrapper)
    18451845      (%slot-ref (instance.slots instance) location)
    18461846      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     
    20202020                       ;; Method is only applicable to a single class.
    20212021                       (destructuring-bind (class . location) (car alist)
    2022                          (setf (%svref dt %gf-dispatch-table-first-data) class
     2022                         (setf (%svref dt %gf-dispatch-table-first-data) (%class.own-wrapper class)
    20232023                               (%svref dt (1+ %gf-dispatch-table-first-data)) location
    20242024                               (gf.dcode f) (dcode-for-gf f #'singleton-reader-dcode))))
Note: See TracChangeset for help on using the changeset viewer.