Two-Phase Termination

さてTwo-Phase Termination - qnzm.log(クニジマログ)。

javaのinterruptを再現したかったけど、諦めた。
sb-thread:interrupt-threadで割り込みはかけられるんだけど、スレッドのステータスをとる方法が分からない。
ffiを使って取得してみようか、と一瞬考えたけど、linuxのpthreadでのスレッドの状態をとる方法も分からない。
で、素直に写経することにした。最近いまいちだな。

日付関数を使うのが始めて。そういえばつかったことなかったな。
get-decoded-timeで多値がかえる。でも多値ってなんか使いづらいな。。。
return、return-from、with-slotsを使ったのも始めてか。with-slotsは便利。
気がついたことは、or、andがさらっとかけない。ifを使わずに書きたい年頃なんだけど、ぱっと書けなくてなさけない。
それから、wait-lockを細かく使うとなにか気持ちがいい。

(defmacro with-lock(sem &body body)
  (let ((gsem (gensym)))
    `(let ((,gsem ,sem))
       (unwind-protect
           (progn
         (sb-thread::wait-on-semaphore ,gsem)
         ,@body)
         (sb-thread::signal-semaphore ,gsem)))))

(defmacro waitfor(sem test &body body)
  (let ((gsem (gensym)))
    `(let ((,gsem ,sem))
       (unwind-protect
           (progn
         (sb-thread::wait-on-semaphore ,gsem)
         (do ()
             (,test)
           (sb-thread::signal-semaphore ,gsem))
         (progn
           ,@body))
         (sb-thread::signal-semaphore ,gsem)))))

(defun strcon(&rest items)
    (apply #'concatenate 'string (mapcar #'write-to-string items)))

(defun get-datetime-string()
  (multiple-value-bind (sec min hour date mon y day p zone) (get-decoded-time)
          (strcon hour  min  sec)))

(defclass logger ()
  ((th :accessor logger-thread :initform nil)
   (sm :accessor logger-semaphore :initform nil)
   (started :accessor logger-started :initform nil)
   (finished :accessor logger-finished :initform nil)))

(defmethod initialize-instance :after ((l logger) &rest intargs)
  (setf (logger-semaphore l) (sb-thread::make-semaphore :name (symbol-name (gensym))))
  (sb-thread::signal-semaphore (logger-semaphore l)))

(defmethod logger-start((l logger))
  (with-slots (th sm started finished)
          l 
          (with-lock sm (or (not started) finished (return-from logger-start nil)))
          (setf th (sb-thread:make-thread
            #'(lambda ()
                (do ()
                ((with-lock sm finished) (return nil))
                  (with-lock sm (setf started t))
                  (format t "start ~A ~%" (get-datetime-string))
                  (sleep 2)
                  (format t "end ~A ~%" (get-datetime-string))))
            :name (symbol-name (gensym))))
          th))

(defmethod logger-stop ((l logger))
  (with-slots (sm started finished)
          l
          (with-lock sm 
             (or started (return-from logger-stop))
             (and finished (return-from logger-stop))
             (setf finished t))))

(sb-thread:make-thread 
 #'(lambda () 
     (setf log (make-instance 'logger))
     (format t "log start~%")
     (logger-start log)
     (sleep 5)
     (format t "log end~%")
     (logger-stop log)))
        
(do ((cmd (read-line) (read-line)))
    ((string= cmd "exit") 'DONE))