CommonLispとSDLで色々 #2 マクロ探検
はじめに
cl-sdl2にはSDLの標準APIにはない機能がマクロとして定義されており、便利な反面、CからSDLを使うときと同じように書けません。そこでひとまず、定義されているマクロが具体的にどのように作られ、動いているのかをmacroexpandを使って見ていきます。今回読んでいくのは、sdl2:with-initとsdl2:in-main-threadになります。
sdl2:with-init
with-initについて
SDLの初期化を行うこのマクロは、sdl2のsdl2.lisp内で次のように定義されています。
(defmacro with-init ((&rest sdl-init-flags) &body body)
`(progn
(init ,@sdl-init-flags)
(unwind-protect
(in-main-thread () ,@body)
(quit))))
このマクロを使用する際は、以下のように記述します。
(sdl2:with-init :everything
;;処理
)
with-initの展開
with-initをmacroexpandを使って展開します。
CL-USER> (macroexpand '(sdl2:with-init (:everything)))
with-initを展開すると、prognでまとめられた以下のフォームが得られます。
(PROGN
(SDL2:INIT :EVERYTHING)
(UNWIND-PROTECT (SDL2:IN-MAIN-THREAD NIL) (SDL2:QUIT)))
prognは複数のフォームをまとめておくためのオペレーターで、SDL2:INIT〜と、UNWIND-PROTECT〜が処理されます。sdl2:initは、sdl2.lisp内で定義されている初期化のための関数です。
init関数
init関数では、*wakeup-event*というダイナミック変数にSDLで定義されているSDL_Event構造体がセットされます。autowrap:allocによって構造体の領域は確保されています。
(unless *wakeup-event*
(setf *wakeup-event* (alloc 'sdl2-ffi:sdl-event)))
次のコードは、*main-thread-channel*がnilの場合、ensure-main-channelを呼び出し*main-thread-channel*にチャネルを作成します。
(unless *main-thread-channel*
(ensure-main-channel)
その後、*the-main-thread*という名前でメインのスレッドを作成しています。チャネル作成にはtrivial-channels、スレッドにはbordeaux-threadsを使用しています。
(setf *the-main-thread* (bt:make-thread #'sdl-main-thread :name "SDL2 Main Thread")))
メインスレッド作成部分では、#'sdl-main-threadという記述で呼び出す関数を指定しています。この場合、このスレッドでsdl-main-threadという関数を呼び出す意味になります。
sdl-main-thread
with-init内で作られたスレッドから呼び出されるsdl-main-threadの定義を見ていきます。
(defun sdl-main-thread ()
(without-fp-traps
(let ((*main-thread* (bt:current-thread)))
(loop :while *main-thread-channel* :do
(block loop-block
(restart-bind ((continue (lambda (&optional v)
(declare (ignore v))
(signal 'sdl-continue))
:report-function
(lambda (stream)
(format stream "Return to the SDL2 main loop.")))
(abort (lambda (&optional v)
(declare (ignore v))
(signal 'sdl-quit))
:report-function
(lambda (stream)
(format stream "Abort, quitting SDL2 entirely."))))
(recv-and-handle-message)))))))
bt:current-threadによって、現在のスレッド(with-initで作成したスレッド)を*main-thread*にセットしています。その後、loopによって*main-thread-channel*がnilでなければ、blockオペレーターの内部の処理を実行していきます。
recv-and-handle-messageが呼び出され、そこから最終的にhandle-messageという関数が呼び出されます。
(defun recv-and-handle-message ()
(let ((msg (recvmsg *main-thread-channel*)))
(handle-message msg)))
recv-and-handle-messageは、*main-thread-channel*に登録されているメッセージを取り出し、handle-messageに渡しているだけです。
handle-message
(defun handle-message (msg)
(let ((fun (car msg))
(chan (cdr msg))
(condition))
(handler-bind ((sdl-continue
(lambda (c)
(declare (ignore c))
(when chan (sendmsg chan nil))
(return-from handle-message)))
(sdl-quit
(lambda (c)
(declare (ignore c))
(quit)
(return-from handle-message))))
(handler-bind ((error (lambda (e) (setf condition e))))
(if chan
(sendmsg chan (multiple-value-list (funcall fun)))
(funcall fun))))))
handle-messageでは、受け取ったメッセージのCAR部を関数、CDR部をチャネルとして受け取ります。最終的には、car部の関数を実行します。
REPL上で行うと、以下の流れで処理が登録され、実行されます。
CL-USER> (defparameter *fun* (lambda () (format t "hello")))
*FUN*
CL-USER> (defparameter *main-ch* (trivial-channels:make-channel))
*MAIN-CH*
CL-USER> (defparameter *sub-ch* (trivial-channels:make-channel))
*SUB-CH*
CL-USER> (trivial-channels:sendmsg *main-ch* (cons *fun* *sub-ch*))
T
CL-USER> (sdl2::handle-message (trivial-channels:recvmsg *main-ch*))
hello
T
init関数の中身の流れを確認したので、with-initの次の処理を見ていきます。
unwind-protect
unwind-protectは、protected-formとcleanup-formという2つの引数を受け取るオペレーターで、protected-form内で例外が発生した場合も必ずcleanup-formが処理されます。
unwind-protectの行を見やすく整形すると以下のようなコードになります。
(unwind-protect
(sdl2:in-main-thread nil)
(sdl2:quit))
(sdl2:in-main-thread nil)がprotected-formで、(sql2:quit)がcleanup-formになるため、in-main-threadの呼び出しで例外が発生したとしても必ずquitが呼び出されることになります。
実際には、with-initには引数としてフォームを渡すため、with-initマクロに(format t "hello")というフォームを渡してみます。
CL-USER> (macroexpand '(sdl2:with-init (:everything)
(format t "hello")))
すると、次のように展開されました。
(PROGN
(SDL2:INIT :EVERYTHING)
(UNWIND-PROTECT (SDL2:IN-MAIN-THREAD NIL (FORMAT T "hello")) (SDL2:QUIT)))
(unwind-protect
(sdl2:in-main-thread nil (format t "hello"))
(sdl2:quit))
with-initマクロに渡したフォームは、in-main-threadマクロの第2引数に渡されることがわかります。次は、このin-main-threadマクロを展開させてみます。
sdl2:in-main-thread
in-main-thread
in-main-threadマクロは、sdl2のsdl2.lisp内で定義されています。
(defmacro in-main-thread ((&key background no-event) &body b)
(with-gensyms (fun channel)
`(let ((,fun (lambda () ,@b)))
(if (or *main-thread-channel* *main-thread*)
(if *main-thread*
(funcall ,fun)
,(if background
`(progn
(sendmsg *main-thread-channel* (cons ,fun nil))
(values))
`(let ((,channel (make-channel)))
(sendmsg *main-thread-channel* (cons ,fun ,channel))
,(unless no-event
'(push-event *wakeup-event*))
(let ((result (recvmsg ,channel)))
(etypecase result
(list (values-list result))
(error (error result)))))))
(error "No main thread, did you call SDL_Init?")))))
in-main-threadマクロを展開させる前に、この中で使われているwith-gensymsマクロをまず展開します。このマクロはalexandriaパッケージで次のように定義されています。
(defmacro with-gensyms (names &body forms)
`(let ,(mapcar (lambda (name)
(multiple-value-bind (symbol string)
(etypecase name
(symbol
(values name (symbol-name name)))
((cons symbol (cons string-designator null))
(values (first name) (string (second name)))))
`(,symbol (gensym ,string))))
names)
,@forms))
with-gensymsの展開
CL-USER> (macroexpand '(alexandria:with-gensyms (fun channel)
`(let ((,fun (lambda () ,@b)))
(if (or *main-thread-channel* *main-thread*)
(if *main-thread*
(funcall ,fun)
,(if background
`(progn
(sendmsg *main-thread-channel* (cons ,fun nil))
(values))
`(let ((,channel (make-channel)))
(sendmsg *main-thread-channel* (cons ,fun ,channel))
,(unless no-event
'(push-event *wakeup-event*))
(let ((result (recvmsg ,channel)))
(etypecase result
(list (values-list result))
(error (error result)))))))
(error "No main thread, did you call SDL_Init?")))))
with-gensymsを展開すると、次のような結果が得られます。
(LET ((FUN (GENSYM "FUN")) (CHANNEL (GENSYM "CHANNEL")))
(SI:QUASIQUOTE
(LET (((SI:UNQUOTE FUN) (LAMBDA () (SI:UNQUOTE-SPLICE B))))
(IF (OR *MAIN-THREAD-CHANNEL* *MAIN-THREAD*)
(IF *MAIN-THREAD*
(FUNCALL (SI:UNQUOTE FUN))
(SI:UNQUOTE
(IF BACKGROUND
(SI:QUASIQUOTE
(PROGN
(SENDMSG *MAIN-THREAD-CHANNEL* (CONS (SI:UNQUOTE FUN) NIL))
(VALUES)))
(SI:QUASIQUOTE
(LET (((SI:UNQUOTE CHANNEL) (MAKE-CHANNEL)))
(SENDMSG *MAIN-THREAD-CHANNEL*
(CONS (SI:UNQUOTE FUN) (SI:UNQUOTE CHANNEL)))
(SI:UNQUOTE
(UNLESS NO-EVENT '(PUSH-EVENT *WAKEUP-EVENT*)))
(LET ((RESULT (RECVMSG (SI:UNQUOTE CHANNEL))))
(ETYPECASE RESULT
(LIST (VALUES-LIST RESULT))
(ERROR (ERROR RESULT)))))))))
(ERROR "No main thread, did you call SDL_Init?")))))
with-gensymsとgensymについて
with-gensymsは、On Lisp - 古典的なマクロのセクションに説明があり、何回もgensymを行う際に利用される、マクロ内で良く使われるものになります。gensymは衝突しない名前のシンボルを作成するもので、On Lisp - 変数補足の「Gensymによって捕捉を避ける」という節に詳しい説明があります。
gensymだけを使う場合、以下のような結果が得られます。
CL-USER> (gensym)
#:G3557
with-gensyms (fun channel)によって生成された最初の一行目は、funとchannelという変数に対して、gensymで生成されたシンボル名をセットしています。
(let ((fun (gensym "fun")) (channel (gensym "channel")))
〜 )
実際にgensymに引数を付けて実行すると、引数として与えた文字列を接頭辞としたシンボル名を取得できます。
CL-USER> (gensym "fun")
#:|fun3567|
CL-USER> (gensym "channel")
#:|channel3568|
これによりシンボル名の衝突を回避することができ、fun〜とchannel〜というふたつのシンボル名を作成することができました。
si:quasiquote内で、si:unquoteを使うことによって、変数にセットされているシンボル名を取得することができます。
CL-USER> (let ((fun (gensym "fun")))
(si:quasiquote
(si:unquote fun)))
#:|fun3570|
CL-USER> (let ((channel (gensym "channel")))
(si:quasiquote
(si:unquote channel)))
#:|channel3571|
with-gensyms、gensymの動作を見たところで、次はin-main-threadを展開したものを確認します。
in-main-threadの展開
in-main-threadの第一引数は、background、no-eventという二つのキーが指定できますが、with-initの展開時にnilが指定してあったので、そのままnilを指定する形にします。
CL-USER> (macroexpand '(sdl2:in-main-thread nil (format t "hello")))
すると、次のフォームが結果として返って来ます。
(LET ((#:FUN3551 (LAMBDA () (FORMAT T "hello"))))
(IF (OR SDL2::*MAIN-THREAD-CHANNEL* SDL2::*MAIN-THREAD*)
(IF SDL2::*MAIN-THREAD*
(FUNCALL #:FUN3551)
(LET ((#:CHANNEL3552 (TRIVIAL-CHANNELS:MAKE-CHANNEL)))
(TRIVIAL-CHANNELS:SENDMSG SDL2::*MAIN-THREAD-CHANNEL*
(CONS #:FUN3551 #:CHANNEL3552))
(SDL2:PUSH-EVENT SDL2::*WAKEUP-EVENT*)
(LET ((SDL2::RESULT (TRIVIAL-CHANNELS:RECVMSG #:CHANNEL3552)))
(ETYPECASE SDL2::RESULT
(LIST (VALUES-LIST SDL2::RESULT))
(ERROR (ERROR SDL2::RESULT))))))
(ERROR "No main thread, did you call SDL_Init?")))
with-gensymsの展開時と見比べるとわかりやすいかもしれません。#:FUN3551、#:CHANNEL3552という形で、with-gensymsによって自動的に生成されたシンボル名がフォームの中で使われていることがわかります。
順に見ていくと、最初に渡しておいた(format t "hello")というフォームが、lambdaによって関数化され、#:FUN3551という名前が付けられています。
次に、
sdl2::*main-thread-channel*sdl2::*main-thread*
の2つのダイナミック変数のどちらかがNILかどうかを判定しています。もし、成立しなければ、最後の(ERROR "No main thread, did you call SDL_Init?")が処理されます。
with-initマクロの際見てきましたが、sdl2.lispのsdl2:init関数内では、以下のコードで*main-thread-channel*を初期化しています。
(unless *main-thread-channel*
(ensure-main-channel)
ensure-make-channelは、make-channelというオペレーターによって作成されます。make-channelは、trivial-channelsというパッケージで定義されており、https://github.com/rpav/trivial-channelsで提供されているチャネル（及びキュー）を管理するためのライブラリです。ここでは、make-channelを呼び出しmain-thread-channelという名前のチャネルを作成しています。
(defun ensure-main-channel ()
(unless *main-thread-channel*
(setf *main-thread-channel* (make-channel))))
通常はwith-initマクロによってsdl2:initが実行されているはずなので、*main-thread-channel*はnil以外のはずです。REPL上で簡単に確認することもできます。
CL-USER> (sdl2:init :everything)
NIL
CL-USER> sdl2::*main-thread-channel*
#S(TRIVIAL-CHANNELS:CHANNEL :TRIVIAL-CHANNELS.QUEUE:QUEUE #S(TRIVIAL-CHANNELS.QUEUE:QUEUE :TRIVIAL-CHANNELS.QUEUE::HEAD NIL :TRIVIAL-CHANNELS.QUEUE::TAIL NIL) :TRIVIAL-CHANNELS::Q-CONDITION #<semaphore 000056045cd9cee0> :TRIVIAL-CHANNELS::Q-MUTEX #<lock (nonrecursive) "Anonymous lock">)
(OR SDL2::*MAIN-THREAD-CHANNEL* SDL2::*MAIN-THREAD*)の条件が成立している場合、sdl2::*main-thread*がnil以外であれば、#:FUN3551の関数を呼び出し、そうでなければ以下の部分が処理されます。
(LET ((#:CHANNEL3552 (TRIVIAL-CHANNELS:MAKE-CHANNEL)))
(TRIVIAL-CHANNELS:SENDMSG SDL2::*MAIN-THREAD-CHANNEL*
(CONS #:FUN3551 #:CHANNEL3552))
(SDL2:PUSH-EVENT SDL2::*WAKEUP-EVENT*)
(LET ((SDL2::RESULT (TRIVIAL-CHANNELS:RECVMSG #:CHANNEL3552)))
(ETYPECASE SDL2::RESULT
(LIST (VALUES-LIST SDL2::RESULT))
(ERROR (ERROR SDL2::RESULT)))))
新しいチャネル#:CHANNEL3552が作成され、trivial-channels:sendmsgによって、sdl2:*main-thread-channel*に対して、作成したチャネルと関数のCons Cellを渡しています。sendmsgは、チャネルに対してメッセージを送信します。*main-thread-channel*に対してCons Cellをメッセージとして送信するという意味になります。
With-initのhandle-message関数を思い出すと、この*main-thread-channel*に送信されたメッセージのうち、CAR部を関数、CDR部をチャネルとして取り扱っていました。handle-message内で処理したいものをここで登録しているという形になります。
trivial-channels:sendmsg
trivial-channelsは、いくつものメッセージを送信しておき、必要に応じて取り出すことができます。送信時の第2引数はオブジェクトのため、Cons Cell以外にも様々なオブジェクトを送信することができます。
;; 作成
(trivial-channels:make-channel)
;; 送信
(trivial-channels:sendmsg channel object)
;; 受信
(trivial-channels:recvmsg channel)
recvmsgは、送信したメッセージを受信します。最初に送信したものから順次取り出します。
push-event
次に見ていくのは、以下の部分です。
(SDL2:PUSH-EVENT SDL2::*WAKEUP-EVENT*)
sdl2のevent.lispに、push-eventという関数が定義されています。symbol、sdl2-ffi:sdl-event、sdl2-ffi:sdl-user-eventという3つのイベントの型の違いによって処理を分岐させていますが、最終的にsdl-push-eventで登録を行っています。
(defun push-event (event)
(etypecase event
(symbol
(with-sdl-event (ev event)
(setf (ev :type) (get-event-code event))
(check-rc (sdl-push-event ev))))
(sdl2-ffi:sdl-event
(check-rc (sdl-push-event event)))
(sdl2-ffi:sdl-user-event
(check-rc (sdl-push-event event)))))
with-initで出てきましたが、(sdl2::push-event sdl2::*wakeup-event*)の、sdl2::*wakeup-event*はsdl2.lispで定義されているダイナミック変数です。autowrap:allocによって構造体のメモリを確保しています。その確保したメモリを、sdl-push-eventに登録しています。
trivial-channels:recvmsg
handle-message関数内の以下の行は、sendmsg時に登録したCons CellのCDR部のチャネルに対して(funcall func)の結果を送信しています。
(trivial-channels:sendmsg chan (multiple-value-list (funcall fun)))
そのことを踏まえると、以下のコードは、SDL2::RESULTとあるように、処理の実行結果を取得するものになります。
(LET ((SDL2::RESULT (TRIVIAL-CHANNELS:RECVMSG #:CHANNEL3552)))
(ETYPECASE SDL2::RESULT
(LIST (VALUES-LIST SDL2::RESULT))
(ERROR (ERROR SDL2::RESULT)))))
まとめ
sdl2:with-initの処理
- SDLの初期化
- メインスレッドの作成とメインチャネルの作成
- SDLイベント用の構造体を確保
- メインスレッドループのhandle-messageでメインチャネルの内容を受信し処理、結果を格納
- 受け取ったフォーム(一般に初期化用の処理が書かれたフォーム)をin-main-threadに渡す
in-main-threadの処理
- 与えられたフォームをメインチャネルにCons Cellを作って送信
- メインスレッドループのhandle-messageの結果の受け取り
終わりに
SDL本家のドキュメントは詳しいんですが、Common Lispパッケージ側はどのようなオプション指定ができるのか、SDL本家のAPIとどう対応しているのかがわかりにくいのと、マクロがどのように作られているのか興味があったので勢いで読みつつまとめました。次は以下のマクロを見ていこうかと思っています。
- sdl2:with-window
- sdl2:with-renderer
- sdl2:with-event-loop