Changeset 9512


Ignore:
Timestamp:
May 16, 2008, 1:19:52 AM (11 years ago)
Author:
gb
Message:

use INSTANCE-CLASS-WRAPPER instead of some flet-ed equivalents.

File:
1 edited

Legend:

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

    r9423 r9512  
    294294
    295295(defun %find-1st-arg-combined-method (dt arg)
    296   (declare (optimize (speed 3)(safety 0)))
    297   (flet ((get-wrapper (arg)
    298            (if (not (%standard-instance-p arg))
    299              (or (and (typep arg 'macptr)
    300                       (foreign-instance-class-wrapper arg))
    301                  (and (generic-function-p arg)
    302                       (gf.instance.class-wrapper arg))
    303                  (let* ((class (class-of arg)))
    304                    (or (%class.own-wrapper class)
    305                        (progn
    306                          (update-class class nil)
    307                          (%class.own-wrapper class)))))
    308              (instance.class-wrapper arg))))
    309     (declare (inline get-wrapper))
    310     (let ((wrapper (get-wrapper arg)))
    311       (when (eql 0 (%wrapper-hash-index wrapper))
    312         (update-obsolete-instance arg)
    313         (setq wrapper (get-wrapper arg)))
    314       (let* ((mask (%gf-dispatch-table-mask dt))
    315              (index (%ilsl 1 (%ilogand mask (%wrapper-hash-index wrapper))))
    316              table-wrapper flag)
    317         (declare (fixnum index mask))
    318         (loop
    319           (if (eq (setq table-wrapper (%gf-dispatch-table-ref dt index)) wrapper)
    320             (return (%gf-dispatch-table-ref dt  (the fixnum (1+ index))))
    321             (progn
    322               (when (null (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
    323                 (if (or (neq table-wrapper (%unbound-marker))
    324                         (eql 0 flag))
    325                   (without-interrupts   ; why?
    326                    (return (1st-arg-combined-method-trap (%gf-dispatch-table-gf dt) wrapper arg))) ; the only difference?
    327                   (setq flag 0 index -2)))
    328               (setq index (+ 2 index)))))))))
     296  (let ((wrapper (instance-class-wrapper arg)))
     297    (when (eql 0 (%wrapper-hash-index wrapper))
     298      (update-obsolete-instance arg)
     299      (setq wrapper (instance-class-wrapper arg)))
     300    (let* ((mask (%gf-dispatch-table-mask dt))
     301           (index (%ilsl 1 (%ilogand mask (%wrapper-hash-index wrapper))))
     302           table-wrapper flag)
     303      (declare (fixnum index mask))
     304      (loop
     305        (if (eq (setq table-wrapper (%gf-dispatch-table-ref dt index)) wrapper)
     306          (return (%gf-dispatch-table-ref dt  (the fixnum (1+ index))))
     307          (progn
     308            (when (null (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
     309              (if (or (neq table-wrapper (%unbound-marker))
     310                      (eql 0 flag))
     311                (without-interrupts     ; why?
     312                 (return (1st-arg-combined-method-trap (%gf-dispatch-table-gf dt) wrapper arg))) ; the only difference?
     313                (setq flag 0 index -2)))
     314            (setq index (+ 2 index))))))))
    329315
    330316;;; for calls from outside - e.g. stream-reader
     
    338324(defun %find-nth-arg-combined-method (dt arg args) 
    339325  (declare (optimize (speed 3)(safety 0)))
    340   (flet ((get-wrapper (arg)
    341            (if (not (%standard-instance-p arg))
    342              (or (and (typep arg 'macptr)
    343                       (foreign-instance-class-wrapper arg))
    344                  (and (generic-function-p arg)
    345                       (gf.instance.class-wrapper arg))
    346                  (let* ((class (class-of arg)))
    347                    (or (%class.own-wrapper class)
    348                        (progn
    349                          (update-class class nil)
    350                          (%class.own-wrapper class)))))
    351              (instance.class-wrapper arg))))
    352     (declare (inline get-wrapper))
    353     (let ((wrapper (get-wrapper arg)))
    354       (when (eql 0 (%wrapper-hash-index wrapper))
    355         (update-obsolete-instance arg)
    356         (setq wrapper (get-wrapper arg)))
    357       (let* ((mask (%gf-dispatch-table-mask dt))
    358              (index (%ilsl 1 (%ilogand mask (%wrapper-hash-index wrapper))))
    359              table-wrapper flag)
    360         (declare (fixnum index mask))
    361         (loop
    362           (if (eq (setq table-wrapper (%gf-dispatch-table-ref dt index)) wrapper)
    363             (return (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
    364             (progn
    365               (when (null (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
    366                 (if (or (neq table-wrapper (%unbound-marker))
    367                         (eql 0 flag))
    368                   (without-interrupts ; why?
    369                    (let ((gf (%gf-dispatch-table-gf dt)))
    370                      (if (listp args)
    371                        (return (nth-arg-combined-method-trap-0 gf dt wrapper args))
    372                        (with-list-from-lexpr (args-list args)
    373                          (return (nth-arg-combined-method-trap-0 gf dt wrapper args-list))))))
    374                   (setq flag 0 index -2)))
    375               (setq index (+ 2 index)))))))))
     326  (let ((wrapper (instance-class-wrapper arg)))
     327    (when (eql 0 (%wrapper-hash-index wrapper))
     328      (update-obsolete-instance arg)
     329      (setq wrapper (instance-class-wrapper arg)))
     330    (let* ((mask (%gf-dispatch-table-mask dt))
     331           (index (%ilsl 1 (%ilogand mask (%wrapper-hash-index wrapper))))
     332           table-wrapper flag)
     333      (declare (fixnum index mask))
     334      (loop
     335        (if (eq (setq table-wrapper (%gf-dispatch-table-ref dt index)) wrapper)
     336          (return (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
     337          (progn
     338            (when (null (%gf-dispatch-table-ref dt (the fixnum (1+ index))))
     339              (if (or (neq table-wrapper (%unbound-marker))
     340                      (eql 0 flag))
     341                (without-interrupts     ; why?
     342                 (let ((gf (%gf-dispatch-table-gf dt)))
     343                   (if (listp args)
     344                     (return (nth-arg-combined-method-trap-0 gf dt wrapper args))
     345                     (with-list-from-lexpr (args-list args)
     346                       (return (nth-arg-combined-method-trap-0 gf dt wrapper args-list))))))
     347                (setq flag 0 index -2)))
     348            (setq index (+ 2 index))))))))
    376349
    377350
     
    553526  (and (typep thing 'funcallable-standard-object)
    554527       (let* ((wrapper (gf.instance.class-wrapper thing)))
    555          ;; In practice, many generic-functions are standard-generic-functions.         (or (eq *standard-generic-function-class-wrapper* wrapper)
     528         ;; In practice, many generic-functions are standard-generic-functions.
     529         (or (eq *standard-generic-function-class-wrapper* wrapper)
    556530             (eq *generic-function-class-wrapper* wrapper)
    557531             (let* ((bits (or (%wrapper-cpl-bits wrapper)
     
    563537                                      (optimize (speed 3) (safety 0)))
    564538                      (and (< ordinal (length bits))
    565                            (eql 1 (sbit bits ordinal)))))))))
     539                           (eql 1 (sbit bits ordinal))))))))))
    566540
    567541
     
    19891963
    19901964
     1965
Note: See TracChangeset for help on using the changeset viewer.