Michael Sperber [Mr. Preprocessor] writes:
> Now, one of the reasons why there's basically no docs is that the
> situation is changing, and thus any documentation we do now would soon
> be outdated: Scheme 48 has, in recent versions, already switched to a
> lockless synchronization model for dealing with shared memory. (Scsh
> still uses a lock-based model.) Moreover, I've been doing work on
> implementing Reppy's abstractions in Scheme 48/scsh. The basic
> framework is already done, but some work remains.
I look forward to seeing it. Meanwhile, performance has certainly
improved. A while ago I posted some code (some Oz from one of their
tutorials that I translated to Scsh) to benchmark thread context
switching. Stephen Ma (who fixed some bugs of mine) sent me old and
new results from his machine yesterday and I ran the benchmark here.
=======================================================
Stephen's results
=======================================================
[500Mhz P3, 192MBytes of RAM]
scsh 0.6.2:
> Threads Times Real User System
> 10 10 0.23 0.19 0.03
> 10 100 0.31 0.24 0.03
> 10 1000 1.22 1.05 0.10
> 10 10000 9.74 9.53 0.13
> 100 10 0.48 0.44 0.02
> 100 100 2.72 2.57 0.07
> 100 1000 25.13 24.26 0.19
> 100 10000 248.49 242.14 0.15
> 1000 10 20.28 18.19 0.11
> 1000 100 173.49 172.19 0.09
> 1000 1000 1749.48 1707.62 0.64
So far, scsh 0.6.3 gives:
Threads Times Real User System
10 10 0.17 0.13 0.05
10 100 0.22 0.16 0.03
10 1000 0.69 0.57 0.05
10 10000 6.26 6.08 0.12
100 10 0.23 0.17 0.05
100 100 0.70 0.61 0.07
100 1000 6.29 6.11 0.13
100 10000 61.35 60.98 0.13
1000 10 1.01 0.82 0.16
1000 100 6.67 6.53 0.10
1000 1000 63.65 63.03 0.14
1000 10000 631.23 628.18 0.15
10000 10 10.95 10.74 0.12
10000 100 82.72 81.79 0.18
10000 1000 805.54 796.76 0.16
=======================================================
my results
=======================================================
[1.7GHz P4, 256MB of RAM]
0.6.2
> Threads Times Real User System
> 10 10 0.08 0.05 0.03
> 10 100 0.11 0.09 0.01
> 10 1000 0.47 0.44 0.02
> 10 10000 3.75 3.63 0.06
> 100 10 0.16 0.14 0.02
> 100 100 0.97 0.90 0.05
> 100 1000 8.62 8.46 0.05
> 100 10000 84.91 84.22 0.03
> 1000 10 6.35 6.25 0.04
> 1000 100 58.99 58.33 0.05
> 1000 1000 587.22 581.71 0.10
> top's TIME column says it's been running > 90 minutes now, and still
> no results for 10000 threads.
0.6.3
Threads Times Real User System
10 10 0.07 0.06 0.01
10 100 0.09 0.08 0.00
10 1000 0.28 0.25 0.02
10 10000 2.49 2.38 0.07
100 10 0.09 0.06 0.03
100 100 0.29 0.25 0.02
100 1000 2.50 2.44 0.03
100 10000 24.35 24.07 0.03
1000 10 0.43 0.37 0.04
1000 100 2.69 2.60 0.06
1000 1000 25.62 25.45 0.05
1000 10000 250.48 248.52 0.07
10000 10 4.41 4.32 0.05
10000 100 32.64 32.41 0.04
10000 1000 316.12 313.79 0.08
10000 10000 3158.52 3133.17 0.25
==================================================================
the code I'm running, in 2 files
==================================================================
#!/usr/local/bin/scsh \
-o threads -o locks -o placeholders -e go -s
!#
;; ~/scsh/thread-fun-sma.scm
(define (make-semaphore init)
(let ((s (make-vector 3)))
(vector-set! s 0 (make-lock))
(vector-set! s 1 init)
(vector-set! s 2 '())
s))
(define (semaphore-add s)
(obtain-lock (vector-ref s 0))
(vector-set! s 1 (+ 1 (vector-ref s 1)))
(if (and (< 0 (vector-ref s 1))
(not (null? (vector-ref s 2))))
(let ((p (car (vector-ref s 2))))
(vector-set! s 2 (cdr (vector-ref s 2)))
(placeholder-set! p #t)))
(release-lock (vector-ref s 0)))
(define (semaphore-sub s)
(let loop ()
(obtain-lock (vector-ref s 0))
(if (>= 0 (vector-ref s 1))
(let ((p (make-placeholder)))
(vector-set! s 2 (cons p (vector-ref s 2)))
(release-lock (vector-ref s 0))
(placeholder-value p)
(loop)))
(vector-set! s 1 (- (vector-ref s 1) 1))
(release-lock (vector-ref s 0))))
(define (go prog+args)
(let ((args (cdr prog+args)))
(let* ((threads (string->number (car args)))
(times (string->number (cadr args)))
(s (make-semaphore (- 1 threads))))
(let loop ((i 1))
(spawn (lambda ()
(let loop ((i 1))
(relinquish-timeslice)
(if (< i times)
(loop (+ i 1))))
(semaphore-add s)
))
(if (< i threads)
(loop (+ i 1))))
(semaphore-sub s)
)))
==================================================================
#!/usr/local/bin/scsh \
-e go -s
!#
;; ~/scsh/run-thread-fun-sma.scm
(define (go _)
(format #t "Threads\tTimes\tReal\tUser\tSystem\n")
(let loop ((threads 10))
(let loop ((times 10))
(let ((strings ((field-splitter)
(run/string (time /home/sge/scsh/thread-fun-sma.scm
,threads ,times)
(= 2 1)))))
(format #t "~s\t~s\t~a\t~a\t~a\n";
threads times (car strings) (caddr strings)
(list-ref strings 4)))
(if (< times 10000)
(loop (* 10 times))))
(if (< threads 10000)
(loop (* 10 threads)))))
==================================================================
|