test-exploration/add-timing.scm
(require (lib "xmlrpc.ss" "xmlrpc")
         (lib "pregexp.ss")
         (lib "process.ss"))

(define adder (xmlrpc-server "localhost" 8080 "servlets/testing/add.ss"))
(define my-add (adder 'math.add))

(define (show-memory-usage)
  (let ([lines '()])
    (define (size-in-mb line)
      (let ([val (list-ref (pregexp-split "\\s+" line) 8)])
        (floor (/ (* (string->number val) 1024) 1000000))))
    
  (let-values ([(in out id err lam)
                (apply values (process "ps -eAalww"))])
    (let loop ([line (read-line in)])
      (unless (eof-object? line)
        (if (pregexp-match "mzscheme" line)
            (set! lines (cons line lines)))
        (loop (read-line in))))
    (for-each (lambda (line)
                (cond
                  [(pregexp-match "mzscheme3m" line)
                   (printf "S:[~aMB] "
                           (size-in-mb line))]
                  [(pregexp-match "mzscheme" line)
                   (printf "C:[~aMB] "
                           (size-in-mb line))]))
              lines)
    (printf "~n")
    (close-input-port in)
    (close-output-port out)
    (close-input-port err)
    )))

(define (do-timing)
  (let ([times '()]
        [start 0]
        [end 0]
        [avg (lambda (times)
               (* 1.0 (/ (apply + times) (length times))))])
    (let loop ([count 0])
      (let ([a (random 100)]
            [b (random 100)])
        (set! start (current-milliseconds))
        (my-add a b)
        (set! end (current-milliseconds))
        (set! times (cons (- end start) times))
        
        (if (zero? (modulo count 50))
            (begin
              (printf "~a | T:[~ams] " 
                      count
                      (inexact->exact (floor (avg times))))
              (show-memory-usage)
              (set! times '())
              ;;(sleep 1)
              )))
      (loop (add1 count)))
    (avg times)))

(define (test-threads size cluster-size)
  (let ([v (make-vector size)]
        [threads (make-vector size)])
    (let loop ([n size])
      (unless (< n cluster-size) 
        (sleep 0.05)
        (let loop ([c cluster-size])
          (unless (zero? c)
            (vector-set! threads
                         (sub1 n)
                         (thread (lambda ()
                                   (printf "[~a] Spawning~n" (sub1 n))
                                   (vector-set! v (sub1 n) (my-add 3 5)))))
            (loop (sub1 c))))
        (loop (sub1 n))))
    (for-each (lambda (tid)
                (printf "[~a] Waiting~n" tid)
                (thread-wait tid))
              (vector->list threads))
    (apply + (map (lambda (n)
                    (if (= 8 n) 1 0))
                  (vector->list v)))))