Changeset 14485


Ignore:
Timestamp:
04/29/13 15:48:24 (10 years ago)
Author:
rschlatte
Message:

remove slot location caching from StandardGenericFunction?

  • std-slot-value goes through a hash table lookup as well (via StandardObject?.SLOT_VALUE), and we eliminate some function calls on the fast path.
Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r14479 r14485  
    612612        autoload(PACKAGE_SYS, "%time", "Time");
    613613        autoload(PACKAGE_SYS, "cache-emf", "StandardGenericFunction", true);
    614         autoload(PACKAGE_SYS, "cache-slot-location", "StandardGenericFunction", true);
    615614        autoload(PACKAGE_SYS, "canonicalize-logical-host", "LogicalPathname", true);
    616615        autoload(PACKAGE_SYS, "%class-direct-slots", "SlotClass");
     
    629628        autoload(PACKAGE_SYS, "function-info", "function_info");
    630629        autoload(PACKAGE_SYS, "get-cached-emf", "StandardGenericFunction", true);
    631         autoload(PACKAGE_SYS, "get-cached-slot-location", "StandardGenericFunction", true);
    632630        autoload(PACKAGE_SYS, "get-function-info-value", "function_info");
    633631        autoload(PACKAGE_SYS, "hash-table-entries", "HashTableFunctions");
  • trunk/abcl/src/org/armedbear/lisp/StandardGenericFunction.java

    r14481 r14485  
    4242
    4343  ConcurrentHashMap<CacheEntry,LispObject> cache;
    44   ConcurrentHashMap<LispObject,LispObject> slotCache;
    4544
    4645  public StandardGenericFunction()
     
    284283  };
    285284
    286   private static final Primitive CACHE_SLOT_LOCATION
    287     = new pf_cache_slot_location();
    288   @DocString(name="cache-slot-location",
    289            args="generic-function layout location")
    290   private static final class pf_cache_slot_location extends Primitive
    291   {
    292     pf_cache_slot_location()
    293     {
    294       super("cache-slot-location", PACKAGE_SYS, true, "generic-function layout location");
    295     }
    296     @Override
    297     public LispObject execute(LispObject first, LispObject second,
    298                                 LispObject third)
    299     {
    300       final StandardGenericFunction gf = checkStandardGenericFunction(first);
    301       LispObject layout = second;
    302       LispObject location = third;
    303       ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
    304       if (ht == null)
    305         ht = gf.slotCache = new ConcurrentHashMap<LispObject,LispObject>();
    306       ht.put(layout, location);
    307       return third;
    308     }
    309   };
    310 
    311   private static final Primitive GET_CACHED_SLOT_LOCATION
    312     = new pf_get_cached_slot_location();
    313   @DocString(name="get-cached-slot-location")
    314   private static final class pf_get_cached_slot_location extends Primitive
    315   {
    316     pf_get_cached_slot_location()
    317     {
    318       super("get-cached-slot-location", PACKAGE_SYS, true, "generic-function layout");
    319     }
    320     @Override
    321     public LispObject execute(LispObject first, LispObject second)
    322     {
    323       final StandardGenericFunction gf = checkStandardGenericFunction(first);
    324       LispObject layout = second;
    325       ConcurrentHashMap<LispObject,LispObject> ht = gf.slotCache;
    326       if (ht == null)
    327         return NIL;
    328       LispObject location = (LispObject) ht.get(layout);
    329       return location != null ? location : NIL;
    330     }
    331   };
    332 
    333285  private static class CacheEntry
    334286  {
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r14483 r14485  
    22602260(declaim (ftype (function * t) slow-method-lookup-1))
    22612261
    2262 (declaim (ftype (function (t t t) t) slow-reader-lookup))
    2263 (defun slow-reader-lookup (gf layout slot-name)
    2264   (let ((location (layout-slot-location layout slot-name)))
    2265     (cache-slot-location gf layout location)
    2266     location))
    2267 
    22682262(defun std-compute-discriminating-function (gf)
    22692263  ;; In this function, we know that gf is of class
     
    22752269      ((and (= (length methods) 1)
    22762270            (eq (type-of (car methods)) 'standard-reader-method)
    2277             (eq (type-of (car (std-method-specializers (%car methods))))
     2271            (eq (type-of (car (std-method-specializers (car methods))))
    22782272                'standard-class))
    2279        (let* ((method (%car methods))
    2280               (class (car (std-method-specializers method)))
    2281               (slot-name (slot-definition-name (accessor-method-slot-definition
    2282                                                 method)))
    2283               (reader (if (typep class 'funcallable-standard-class)
    2284                           #'funcallable-standard-instance-access
    2285                           #'standard-instance-access)))
     2273       (let ((slot-name (slot-definition-name (accessor-method-slot-definition
     2274                                               (first methods)))))
    22862275         #'(lambda (arg)
    2287              (declare (optimize speed))
    2288              (let* ((layout (std-instance-layout arg))
    2289                     (location (get-cached-slot-location gf layout)))
    2290                (unless location
    2291                  (unless (simple-typep arg class)
    2292                    ;; FIXME no applicable method
    2293                    (error 'simple-type-error
    2294                           :datum arg
    2295                           :expected-type class))
    2296                  (setf location (slow-reader-lookup gf layout slot-name)))
    2297                (let ((value (if (consp location)
    2298                                 (cdr location) ; :allocation :class
    2299                                 (funcall reader arg location))))
    2300                  (if (eq value +slot-unbound+)
    2301                      ;; fix SLOT-UNBOUND.5 from ansi test suite
    2302                      (nth-value 0 (slot-unbound class arg slot-name))
    2303                      value))))))
     2276             ;; this evades linear scan through slot names (see
     2277             ;; SLOT_VALUE in StandardObject.java)
     2278             (std-slot-value arg slot-name))))
    23042279
    23052280      (t
Note: See TracChangeset for help on using the changeset viewer.