Gauche の fast lock (spin lock) 実装のテスト (MSYS2/MinGW-w64)

test_0001_open.bat

@rem set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-i686\bin\gosh.exe
set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-x86_64\bin\gosh.exe
@rem set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-x86_64_2_mutexlock\bin\gosh.exe

%GOSH% test_0001_open.scm

pause

test_0001_open.scm

(use gauche.time)

(define-syntax print-time
  (syntax-rules ()
    ((_ msg n body ...)
     (print msg (time-this n (lambda () body ...))))))

(define n 10000000)

(print-time "open-output-string : " n (open-output-string))

;; fast lock
;;   open-output-string : #<time-result 10000000 times/  7.810 real/  6.922 user/  0.906 sys>
;;
;; mutex lock
;;   open-output-string : #<time-result 10000000 times/ 42.673 real/ 29.015 user/ 13.625 sys>

test_0002_write.bat

@rem set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-i686\bin\gosh.exe
set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-x86_64\bin\gosh.exe
@rem set GOSH=C:\Gauche\Gauche-mingw-dist\Gauche-x86_64_2_mutexlock\bin\gosh.exe

%GOSH% test_0002_write.scm

pause

test_0002_write.scm

(use gauche.threads)
(use gauche.time)

(define-syntax print-time
  (syntax-rules ()
    ((_ msg n body ...)
     (print msg (time-this n (lambda () body ...))))))

(define n       1)
(define threads 100)
(define len     100000)

(print-time "port write test : " n
  (define result #f)
  (define p (open-output-string))
  (define ths (make-vector threads))
  (dotimes (i threads)
    (set! (~ ths i) (make-thread
                     (lambda ()
                       (let loop ((i2 len))
                         (write (modulo i 10) p)
                         (when (> i2 1) (loop (- i2 1))))))))
  (dotimes (i threads)
    (thread-start! (~ ths i)))
  (dotimes (i threads)
    (thread-join! (~ ths i)))
  (set! result (get-output-string p))
  ;(print result)
  (unless (= (string-length result) (* threads len))
    (print "Error occured!"))
  )

;; fast lock
;;   port write test : #<time-result 1 times/ 11.036 real/ 17.984 user/ 48.187 sys>
;;
;; mutex lock
;;   port write test : #<time-result 1 times/ 40.738 real/ 22.016 user/ 22.891 sys>