Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix up the bv2string benchmark

Browse source
This commit is contained in:
Justin Ethier 2017-06-16 16:21:05 +00:00
parent 0d3569367f
commit 9b233f326e
1 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
examples/threading/benchmarks/bv2string.scm
View file

@ -17,7 +17,7 @@
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(import (scheme base) (scheme read) (scheme write) (scheme time) (srfi 18)) (import (scheme base) (scheme read) (scheme write) (scheme time) (srfi 18) (scheme process-context))
;; Crude test rig, just for benchmarking. ;; Crude test rig, just for benchmarking.
@ -116,10 +116,10 @@
) )
(define (main) (define (main)
(let* ((count (read)) (let* ((count 100 #;(read))
(input1 (read)) (input1 1000 #;(read))
(input2 (read)) (input2 1000 #;(read))
(output (read)) (output 0 #;(read))
(s3 (number->string count)) (s3 (number->string count))
(s2 (number->string input2)) (s2 (number->string input2))
(s1 (number->string input1)) (s1 (number->string input1))
@ -142,7 +142,7 @@
(let* ((j/s (jiffies-per-second)) (let* ((j/s (jiffies-per-second))
(t0 (current-second)) (t0 (current-second))
(j0 (current-jiffy))) (j0 (current-jiffy)))
(async-exec-multi! 2 (lambda () (async-exec-multi! 3 (lambda ()
(run-r7rs-benchmark (run-r7rs-benchmark
(string-append name ":" s1 ":" s2 ":" s3 ) (string-append name ":" s1 ":" s2 ":" s3 )
count count
@ -188,7 +188,10 @@
(let ((t (make-thread (let ((t (make-thread
(lambda () (lambda ()
(mutex-lock! m) (mutex-lock! m)
(set! *running-threads* (cons (current-thread) *running-threads*)) (let ((t (cons (current-thread) *running-threads*)))
(cond-expand
(cyclone (Cyc-minor-gc))) ;; Move t to heap
(set! *running-threads* t))
(mutex-unlock! m) (mutex-unlock! m)
(thunk))))) (thunk)))))
(thread-start! t))) (thread-start! t)))