Changeset 9352


Ignore:
Timestamp:
May 3, 2008, 12:09:02 PM (11 years ago)
Author:
gb
Message:

Tune a few of the optimized slot-reader dcode functions a little.
Might make a few cases a little faster; hopefully, didn't slow
anything down.

File:
1 edited

Legend:

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

    r9237 r9352  
    18351835(defun reader-constant-location-dcode (dt instance)
    18361836  (declare (optimize (speed 3) (safety 0)))
    1837   (let* ((classes (%svref dt %gf-dispatch-table-first-data))
    1838          (location (%svref dt (1+ %gf-dispatch-table-first-data))))
    18391837    (if (memq (if (eq (typecode instance) target::subtag-instance)
    18401838              (%class-of-instance instance))
    1841             classes)
    1842       (%slot-ref (instance.slots instance) location)
    1843       (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1839              (%svref dt %gf-dispatch-table-first-data))
     1840      (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
     1841      (no-applicable-method (%gf-dispatch-table-gf dt) instance)))
    18441842(register-dcode-proto #'reader-constant-location-dcode *gf-proto-one-arg*)
    18451843
     
    18471845;;; slot in one or more classes which have multiple subclasses, all of
    18481846;;; which (by luck or design) have the same slot-definition location.
    1849 ;;; The number of classes is for which the method is applicable is
    1850 ;;; large, but all are subclasses of a single class
     1847;;; The number of classes for which the method is applicable is
     1848;;; potentially large, but all are subclasses of a single class
    18511849(defun reader-constant-location-inherited-from-single-class-dcode (dt instance)
    18521850  (declare (optimize (speed 3) (safety 0)))
    18531851  (let* ((defining-class (%svref dt %gf-dispatch-table-first-data))
    18541852         (location (%svref dt (1+ %gf-dispatch-table-first-data)))
    1855          (class (if (eq (typecode instance) target::subtag-instance)
    1856                   (%class-of-instance instance))))
    1857     (if (and class (memq defining-class (or (%class.cpl class)
    1858                                             (%inited-class-cpl class))))
     1853         (cpl (let* ((wrapper
     1854                      (if (eq (typecode instance) target::subtag-instance)
     1855                        (instance.class-wrapper instance))))
     1856                (when wrapper (or (%wrapper-cpl wrapper)
     1857                                  (%inited-class-cpl
     1858                                   (%wrapper-class wrapper)))))))
     1859    (if (memq defining-class cpl)
    18591860      (%slot-ref (instance.slots instance) location)
    18601861      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     
    18681869(defun reader-constant-location-inherited-from-multiple-classes-dcode (dt instance)
    18691870  (declare (optimize (speed 3) (safety 0)))
    1870   (let* ((location (%svref dt (1+ %gf-dispatch-table-first-data)))
    1871          (class (if (eq (typecode instance) target::subtag-instance)
    1872                   (%class-of-instance instance)))
    1873          (cpl (if class (or (%class.cpl class) (%inited-class-cpl class)))))
     1871  (let* ((wrapper (if (eq (typecode instance) target::subtag-instance)
     1872                    (instance.class-wrapper instance)))
     1873         (cpl (if wrapper (or (%wrapper-cpl wrapper) (%inited-class-cpl (%wrapper-class wrapper))))))
    18741874    (if (dolist (defining-class (%svref dt %gf-dispatch-table-first-data))
    18751875          (when (memq defining-class cpl) (return t)))
    1876       (%slot-ref (instance.slots instance) location)
     1876      (%slot-ref (instance.slots instance) (%svref dt (1+ %gf-dispatch-table-first-data)))
    18771877      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
    18781878(register-dcode-proto #'reader-constant-location-inherited-from-multiple-classes-dcode *gf-proto-one-arg*)
     
    19251925                  (when (subtypep class other) (return nil))))
    19261926          (unique class))))))
     1927
     1928
    19271929
    19281930;;; Try to replace gf dispatch with something faster in f.
Note: See TracChangeset for help on using the changeset viewer.