Changeset 9131


Ignore:
Timestamp:
Apr 11, 2008, 2:24:01 AM (12 years ago)
Author:
gz
Message:

Fix tracing of optimized methods, by making dcode-proto-alist accurate again

Location:
branches/working-0711/ccl/level-1
Files:
3 edited

Legend:

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

    r9117 r9131  
    10581058
    10591059
    1060 (defparameter dcode-proto-alist
    1061   (list (cons #'%%one-arg-dcode *gf-proto-one-arg*)
    1062         (cons #'%%1st-two-arg-dcode *gf-proto-two-arg*)))
    1063    
    10641060(defun compute-dcode (gf &optional dt)
    10651061  (setq gf (require-type gf 'standard-generic-function))
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r8867 r9131  
    18191819      (%slot-ref (instance.slots instance) location)
    18201820      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1821(register-dcode-proto #'singleton-reader-dcode *gf-proto-one-arg*)
    18211822
    18221823;;; Dcode for a GF whose methods are all reader-methods which access a
     
    18321833      (%slot-ref (instance.slots instance) location)
    18331834      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1835(register-dcode-proto #'reader-constant-location-dcode *gf-proto-one-arg*)
    18341836
    18351837;;; Dcode for a GF whose methods are all reader-methods which access a
     
    18481850      (%slot-ref (instance.slots instance) location)
    18491851      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1852(register-dcode-proto #'reader-constant-location-inherited-from-single-class-dcode *gf-proto-one-arg*)
    18501853
    18511854;;; Dcode for a GF whose methods are all reader-methods which access a
     
    18641867      (%slot-ref (instance.slots instance) location)
    18651868      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1869(register-dcode-proto #'reader-constant-location-inherited-from-multiple-classes-dcode *gf-proto-one-arg*)
    18661870
    18671871
     
    18791883      (%slot-ref (instance.slots instance) location)
    18801884      (no-applicable-method (%gf-dispatch-table-gf dt) instance))))
     1885(register-dcode-proto #'reader-variable-location-dcode *gf-proto-one-arg*)
    18811886
    18821887(defun class-and-slot-location-alist (classes slot-name)
     
    20042009      (funcall mf arg1 arg2)
    20052010      (%%1st-two-arg-dcode dt arg1 arg2))))
     2011(register-dcode-proto #'reader-variable-location-dcode *gf-proto-two-arg*)
    20062012
    20072013(defun %%one-arg-eql-method-hack-dcode (dt arg)
     
    20092015    (if mf
    20102016      (funcall mf arg))))
     2017(register-dcode-proto #'%%one-arg-eql-method-hack-dcode *gf-proto-one-arg*)
    20112018
    20122019(defun install-eql-method-hack-dcode (gf)
  • branches/working-0711/ccl/level-1/l1-dcode.lisp

    r8817 r9131  
    781781;;;;;;;;;;;;;;;;;;;;;;;;; generic-function dcode ;;;;;;;;;;;;;;;;;;;;;;;;;;;
    782782
     783;; dcode functions using other than *gf-proto*
     784(defparameter dcode-proto-alist ())
     785
     786(defun register-dcode-proto (dcode proto)
     787  (let ((a (assoc dcode dcode-proto-alist)))
     788    (if a
     789      (setf (cdr a) proto)
     790      (push (cons dcode proto) dcode-proto-alist))))
     791
     792
    783793;;; Simple case for generic-functions with no specializers
    784794;;; Why anyone would want to do this I can't imagine.
     
    817827  (let ((method (%find-1st-arg-combined-method dt arg)))
    818828    (funcall method arg)))
     829(register-dcode-proto #'%%one-arg-dcode *gf-proto-one-arg*)
    819830
    820831;;; two args - specialized on first
     
    822833  (let ((method (%find-1st-arg-combined-method dt arg1)))
    823834    (funcall method arg1 arg2)))
    824 
     835(register-dcode-proto #'%%1st-two-arg-dcode *gf-proto-two-arg*)
    825836
    826837
Note: See TracChangeset for help on using the changeset viewer.