;;; method invocation speed

;; Define and invoke at csi prompt.
;; Chicken 2.207 -O3 -fomit-frame-pointer -fno-strict-aliasing -mcpu=7450 -DC_ENABLE_PTABLES

;; (define (q n) (if (fx= n 0) 'done (q (fx- n 1))))
;; (define (t n) (if (fx= n 0) 'done (begin (objc TypeTest returnDoublePlusOneHalf: 2.5) (t (fx- n 1)))))
;; (define o @[TypeTest alloc]) 
;; (define (s n) (if (fx= n 0) 'done (begin (objc o getInt) (s (fx- n 1)))))
;; (define (a n) (if (fx= n 0) 'done (begin @[TypeTest alloc] (a (fx- n 1)))))

;; #;7> ,t (q 1000000)
;;    1.252 seconds elapsed
;;   6.e-03 seconds in (major) GC
;;        3 mutations
;;     1683 minor GCs
;;        5 major GCs

;; as of darcs tag invoke-1:
;; #;8> ,t (t 1000000)
;;   20.403 seconds elapsed
;;    0.548 seconds in (major) GC
;;        2 mutations
;;      274 minor GCs
;;      177 major GCs

;; as of Scheme rewrite -- pretty good, and still unoptimized
;; ,t (t 1000000)                                   #;21> ,t (s 1000000)	      
;;   30.472 seconds elapsed                           23.103 seconds elapsed       
;;    0.355 seconds in (major) GC		       0.139 seconds in (major) GC
;;        2 mutations				           2 mutations	      
;;      313 minor GCs				         971 minor GCs	      
;;      148 major GCs				          61 major GCs	      

;; as of auto-memory-management-1   (s same as above) (a does not use memory)
;; ,t (t 1000000)                        #;10> ,t (a 1000000)          
;;   30.955 seconds elapsed		   36.674 seconds elapsed      
;;    0.525 seconds in (major) GC	    2.582 seconds in (major) GC
;;        3 mutations			   967311 mutations            
;;      414 minor GCs			       61 minor GCs            
;;      220 major GCs			      976 major GCs            
;; done

;; For comparison again, a bare loop returning 2 values is incredibly slow:
;; (define (t n) (if (fx= n 0) 'done (begin (##sys#call-with-values (lambda () (values 1 2)) (lambda (a b) (void))) (t (fx- n 1)))))

;; #;8> ,t (t 1000000)
;;   44.275 seconds elapsed
;;    8.196 seconds in (major) GC
;; 22000002 mutations
;;       47 minor GCs
;;     5864 major GCs

;; But deconstructing a list is much faster.
;; (define (t n) (if (fx= n 0) 'done (begin (let* ((L (list 1 2)) (a (car L)) (b (cadr L))) (void)) (t (fx- n 1)))))
;;    3.857 seconds elapsed
;;    0.302 seconds in (major) GC
;;        2 mutations
;;      179 minor GCs
;;      219 major GCs


;;; Old class_nextMethodList attempts
;;;; attempt 1: scheme -- gets complicated due to the iterator

;; (define objc:_class_nextMethodList
;;   (foreign-lambda* c-pointer ((Class c) ((pointer void) it)) #<<EOF
;;     return(class_nextMethodList(c, &it));
;; EOF
;; ))

;; (define-foreign-record (method_list "struct objc_method_list")
;;   (c-pointer list)
;;   (int count))

;; method_list-list
;; method_list-count

;; (define (objc-class-method-list x)
;;   (let-location ((iterator (null-pointer) 
;;   (objc:_class_nextMethodList x iterator)
  
;;     if (mlist) {
;;        return(mlist->method_list);

;;;; method 2: use a callback to allocate the storage

(define-external (cons_two_strings (c-string x) (c-string y) (scheme-object lst)) scheme-object
  (cons (cons x y)
        lst))

(define objc_class_method_list_
  (foreign-safe-lambda* scheme-object ((c-pointer c)) #<<EOF

  void *iterator = NULL;
  struct objc_method_list *mlist;
  int i;
  C_word lst = C_SCHEME_END_OF_LIST;
  
  while(mlist = class_nextMethodList (c, &iterator)) {
      Method method = mlist->method_list;
      
      for(i=0 ; i < mlist->method_count ; i++){
	  lst = cons_two_strings((char*)method->method_name,
                                  method->method_types,
                                  lst);
	  method++;
      }
  }

  return(lst);

EOF
))

;; unoptimized -- about the same for -O2
#|
#;13> ,t (define v (map (lambda (c) (objc_class_method_list_ (objc-class-ptr c))) objc:classes ))
   0.592 seconds elapsed
   0.163 seconds in (major) GC
    1514 mutations
    2645 minor GCs
       4 major GCs
|#

;;;; method 3: allocate on the stack

;; ,t (define v (map (lambda (c) (objc_class_method_list_2_ (objc-class-ptr c))) objc:classes ))
;;    0.264 seconds elapsed
;;  7.9e-02 seconds in (major) GC
;;       26 mutations
;;        4 minor GCs
;;        5 major GCs

;; However, it can be fast at times.
;; ,t (define v (map (lambda (c) (objc_class_method_list_2_ (objc-class-ptr c))) objc:classes ))
;;  6.2e-02 seconds elapsed
;;        0 seconds in (major) GC
;;       26 mutations
;;       59 minor GCs
;;        0 major GCs




;;; optimized callbacks
;; 1 millon runs using interpreted function like
;; (define (s n) (if (fx= n 0) 'done (begin (objc:send/safe o retainCount) (s (fx- n 1)))))
;; note: objc:pointer->class is not compiled.
;; note: "maybe" logic is not compiled since this occurs in the interpreter.

                              send       send/safe   send/maybe-safe
(@ TypeTest retain-count)      28           37            30
(@ t retain-count)             27           37            36

(@ MyPoint retain-count)       27           37            39    ;; slight lose
(@ p retain-count)             27           37            44    ;; big lose: maybe logic overhead

;; Calling objc:class-of consumes 3 seconds compared to (noop) [3.5 compared to nothing].
;; 1s of this is spent in hash-table-ref.

;; ---
;; Moved maybe logic to objc:invoker, so it is always compiled.
;; 


;; ---
;; Compiled class proxy code.

(@ TypeTest retain-count)      26           37            27    ;; excellent!
(@ t retain-count)             26           37            30    ;; much better.  4 second overhead.

(@ MyPoint retain-count)       27           36            37    ;; ok
(@ p retain-count)             27           37            41    ;; still a lose--4 to 4.5 seconds.

;; So sending messages to scheme instances is a lose (-15%), but a big
;; win for objC instances (save 60-90% of callback speed, +30% overall).
;; Set (objc:optimized-callbacks #f) to obtain old behavior (with about a 1% penalty).