Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-10-14

KMRCLを眺める(214) MAKE-LOCK

| 23:50 | KMRCLを眺める(214) MAKE-LOCK - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(214) MAKE-LOCK - わだばLisperになる

今回はKMRCLのprocesses.lispから、MAKE-LOCKです。

定義は、

(defun make-lock (name)
  #+allegro (mp:make-process-lock :name name)
  #+cmu (mp:make-lock name)
  #+lispworks (mp:make-lock :name name)
  #+sb-thread (sb-thread:make-mutex :name name)
  #+openmcl (ccl:make-lock name)
  )

となっていて、各処理系のlockのラッパーになっています。やはり命名は、CMUCL方式の様子。

動作は、

(kl::make-lock "foo")
;⇒ #S(SB-THREAD:MUTEX :NAME "foo" :%OWNER NIL :STATE 0)
;; lockなし
(let ((x 0))
  (defun inc ()
    (print x)
    (sleep (/ (random 8) 10))
    (incf x)))

;; lock付き
(let ((lock (kl::make-lock "inc"))
      (x 0))
  (defun inc-with-lock ()
    (sb-thread:with-mutex (lock)
      (print x)
      (sleep (/ (random 8) 10))
      (incf x))))

;; lockなし
(loop :repeat 10
      :do (kl::make-process 
           (string (gensym))
           (lambda (&aux (*standard-output* #.*standard-output*))
             (inc))))
;->
0 
0 
0 
0 
0 
0 
1 
1 
1
;⇒ NIL

;; lock使用
(loop :repeat 10
      :do (kl::make-process
           (string (gensym))
           (lambda (&aux (*standard-output* #.*standard-output*))
             (inc-with-lock))))
;->
0 
1 
2 
3 
4 
5 
6 
7 
8 
9
;⇒ NIL

というところでしょうか。あまり定番の書き方が分かってないですが…。

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20101014