(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 '())
)))
(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)))))