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-15

KMRCLを眺める(215) WITH-LOCK-HELD

| 23:45 | KMRCLを眺める(215) WITH-LOCK-HELD - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(215) WITH-LOCK-HELD - わだばLisperになる

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

ボディの中身が指定したロックが有効になった状態で実行されるというものです。

定義は、

(defmacro with-lock-held ((lock) &body body)
  #+allegro
  `(mp:with-process-lock (,lock) ,@body)
  #+cmu
  `(mp:with-lock-held (,lock) ,@body)
  #+lispworks
  `(mp:with-lock (,lock) ,@body)
  #+sb-thread
  `(sb-thread:with-recursive-lock (,lock) ,@body)
  #+openmcl
  `(ccl:with-lock-grabbed (,lock) ,@body)
  #-(or allegro cmu lispworks sb-thread openmcl)
  `(progn ,@body)
  )

となっています。

命名については、各処理系で割とばらばらですが、KMRCLでは今回もCMUCLに沿っているようです。

動作は、前回と同じ例ですが、

(defvar *out* #.*standard-output*)

;; ロックなし
(let ((x 0))
  (defun inc ()
    (print x *out*)
    (sleep (/ (random 8) 10))
    (incf x)))

;; ロックあり
(let ((lock (kl::make-lock "inc"))
      (x 0))
  (defun inc-with-lock ()
    (kl::with-lock-held (lock)
      (print x *out*)
      (sleep (/ (random 8) 10))
      (incf x))))

;; ロックなし
(dotimes (i 10)
  (kl::make-process (string (gensym)) 
                    #'inc))
;→
0 
0 
0 
0 
0 
0 
1 
1 
1
;⇒ NIL

;; ロックあり with-lock-held+mutex 
(dotimes (i 10)
  (kl::make-process (string (gensym)) 
                    #'inc-with-lock))
;→
0 
1 
2 
3 
4 
5 
6 
7 
8 
9
;⇒ NIL

というところ