簡易スタック型VM(JITコンパイラもどき)でのフィボナッチ数計算速度
前々々回でスタック型言語をバイトコードにコンパイルする部分を、前々回でCommonLispアセンブラによるマシン語生成を、前回でそのアセンブラ上にスタック型言語のラップするところを扱った。
今回はそれらをまとめて、最初に作成したバイトコードインタプリタ型(?)のVMを、実行時にネイティブコードを生成するJIT型(のようなもの)に置き換えて、実行速度を比較してみる。
バイトコード生成部
ここは前々回と全く同様なので省略。
以下にフィボナッチ数計算用のプログラムを再掲しておく。
(pvmc:compile-to-file "fib.bc" '( 35 ; fib(35) (:addr fib-beg) :call ; fib(25) (:addr finish) :jump fib-beg :dup 2 :less (:addr fib-end) :jump-if ; if(n < 2) :dup 2 :sub (:addr fib-beg) :call ; fib(n - 2) :swap 1 :sub (:addr fib-beg) :call ; fib(n - 1) :add fib-end :return finish)) #| $ od -h fib.bc 0000000 2301 0000 0100 0011 0000 0113 003a 0000 0000020 0911 0201 0000 0800 3901 0000 1200 0109 0000040 0002 0000 0103 0011 0000 0b13 0101 0000 0000060 0300 1101 0000 1300 1402 |#
バイトコード実行(VM)部
前々回はこの部分をC++で作成したが、今回はCommonLispで実装する。
まずはバイトコード実行用の関数の定義。
;;; ファイル名: pvm-execute.lisp ;; アセンブラを読み込んでおく (asdf:load-system :cl-asm) ;; パッケージ定義 (defpackage pvm-execute (:use :common-lisp :sb-alien) (:nicknames :pvme) (:export execute ; バイトコードのファイルパスを受け取り実行結果を返す関数 make-command)) ; バイトコード実行用のコマンドを生成する (in-package :pvm-execute) ;; 前回定義した@pushや@pop、その他の関数定義がここにくる ;; ... 省略 ... ;; ;; バイトコードのファイルパスを受け取り評価・実行する (defun execute (filepath) (with-open-file (in filepath :element-type '(unsigned-byte 8)) (cl-asm:execute (convert-to-executable (read-bytecodes in)) (function int)))) ;; 入力ストリームからバイトコードを読み込み、cl-asmのニーモニック形式に変換する (defun read-bytecodes (in) (loop FOR pos = (file-position in) FOR op = (read-op in) WHILE op COLLECT ;; 各バイトコードを(開始位置 ニーモニック)形式に変換する ;; 開始位置は、後にアドレス解決を行う際に使用される (list pos (ecase op (1 `(@int ,(read-int in))) (2 '(@add)) ; @で始まる関数群は、前回定義したもの (3 '(@sub)) (4 :mul (error "unsupported")) ; 未対応 (5 :div (error "unsupported")) (6 :mod (error "unsupported")) (7 '(@eql)) (8 '(@less)) (9 '(@dup)) (10 '(@drop)) (11 '(@swap)) (12 '(@over)) (13 '(@rot)) (14 :rpush (error "unsupported")) (15 :rpop (error "unsupported")) (16 :rcopy (error "unsupported")) (17 '(unresolve @jump)) ; アドレス解決が必要 (resolve-addrs関数内で行う) (18 '(unresolve @jump-if)) ; 同上 (19 '(unresolve @call)) ; 同上 (20 '(@return)))))) ;; 読み込んだニーモニック(の中間形式)を、実行可能な(= cl-asm:executeに渡せる)に変換する (defun convert-to-executable (mnemonics) (eval `(body ,@(mapcar #'second (resolve-addrs mnemonics)) ; 本体 (@pop %eax)))) ; 結果を取り出して返す ;; 各種補助関数 (defun read-op (in) ; バイト読み込み (read-byte in nil nil)) (defun read-uint (in) ; unsigned int読み込み (+ (ash (read-byte in) 00) (ash (read-byte in) 08) (ash (read-byte in) 16) (ash (read-byte in) 24))) (defun read-int (in) ; signed int読み込み (let ((n (read-uint in))) (if (< n #x80000000) n (- n #x100000000)))) (defun symb (&rest args) ; シンボル生成: (symb "ABC" 1) => 'abc1 (intern (format nil "~{~a~}" args))) ;; jump命令やcall命令が参照するアドレスをcl-asmが扱える形式に変換する ;; ;; バイトコードでは遷移系の命令の直前に遷移先(絶対アドレス)が指定されているので、 ;; mnemonics内の'((@int 10) (unresolve @call))のようになっている部分を '((@call &10)) のように置き換える。 ;; ※ 変換時に生成したアドレス用のラベル(上の場合は'&10)は、最後にまとめてmnemonics内の適切な位置に挿入する。 (defun resolve-addrs (mnemonics) (labels ((recur (list acc addrs) (if (null list) (values (nreverse acc) (remove-duplicates addrs)) (let ((tag (first (second (car list))))) (case tag (unresolve (destructuring-bind ((_ (__ addr)) . acc2) acc (declare (ignore _ __)) (let ((pos (first (car list))) (op (second (second (car list))))) (recur (cdr list) (cons `(,pos (,op ,(symb "&" addr))) acc2) (cons addr addrs))))) (otherwise (recur (cdr list) (cons (car list) acc) addrs))))))) (multiple-value-bind (mnemonics refered-addrs) (recur mnemonics '() '()) (sort (append mnemonics (loop FOR addr IN refered-addrs COLLECT `(,(- addr 0.5) ,(symb "&" addr)))) #'< :key #'first))))
resolve-addrs関数が若干複雑*1なことを除いては、バイトコードからのほぼ一対一の単純な変換となっている。
後は、前々回に合わせて実行部は通常のUnixコマンドとして使えるようにしておく。
;;; main関数作成用の補助関数 (eval-when (:compile-toplevel :load-toplevel :execute) ;; "/dir/file.ext" -> "file.ext" (defun basename (pathstring) (let ((path (parse-namestring pathstring))) (format nil "~A~@[.~A~]" (pathname-name path) (pathname-type path)))) ;; '(a b c &optional c &key (d e)) -> '(a b c d) (defun collect-varsym (args) (mapcar (lambda (a) (if (consp a) (car a) a)) (remove-if (lambda (a) (and (symbolp a) (string= "&" a :end2 1))) args)))) ;;; main関数定義関数 (defmacro defmain (fn-name args &body body) (let ((usage nil)) ;; If first expression of body is string type, it treated as command documentation (when (stringp (car body)) (setf usage (car body) body (cdr body))) `(defun ,fn-name () ;; Need to override *invoke-debugger-hook* (let ((sb-ext:*invoke-debugger-hook* (lambda (condition hook) (declare (ignore hook)) (format *error-output* "Error: ~A~%" condition) (sb-ext:quit :unix-status 1)))) ;; When failed arguments destructuring, show documentation and exit ,(when usage `(handler-case (destructuring-bind ,args (cdr sb-ext:*posix-argv*) (declare (ignore ,@(collect-varsym args)))) (error () (format *error-output* "~&~?~%~%" ,usage (list (basename (car sb-ext:*posix-argv*)))) (sb-ext:quit :unix-status 1)))) (destructuring-bind ,args (cdr sb-ext:*posix-argv*) ,@body (sb-ext:quit :unix-status 0)))))) ;;; main関数 ;;; 引数で指定されたファイルパスに対してexecute関数を呼び出すだけ (defmain main (bytecode-filepath) "Usage: ~a BYTECODE_FILEPTAH" (print (execute bytecode-filepath)) (terpri)) ;;; コマンド生成関数 (defun make-command (command-name) (sb-ext:save-lisp-and-die command-name :executable t :toplevel #'main))
コマンド生成＆実行。
$ sbcl > (load "pvm-execute.lisp") > (pvme:make-command "pvm-jit") [undoing binding stack and other enclosing state... done] [saving current Lisp image into pvm-jit: writing 6336 bytes from the read-only space at 0x20000000 writing 4000 bytes from the static space at 0x20100000 writing 46170112 bytes from the dynamic space at 0x1000000000 done] ; pvm-jitコマンドが生成される $ ./pvm-jit Usage: pvm-jit BYTECODE_FILEPTAH # フィボナッチ数計算 $ time ./pvm-jit fib.bc 9227465 # fib(35) = 9227465 real 0m0.169s user 0m0.156s sys 0m0.008s # 前々回のコマンドの場合 $ time ./pvm fib.bc [data stack] 0# 9227465 [return stack] real 0m3.636s user 0m3.632s sys 0m0.000s
比較
比較表に今回の結果を追記(pvm-jit)。
| 言語 | 所要時間(最適化オプションなし) | 所要時間(最適化オプションあり) |
|---|---|---|
| gcc-4.6.1 | 0.112s | 0.056s |
| sbcl-1.0.54 | 0.320s | 0.110s |
| pvm | 3.600s | |
| pvm-jit | 0.156s | |
| ruby1.9.1 | 2.816s | |
| ruby1.8.7 | 14.497s | |
| cl-asm | 0.059s |
不完全なアセンブラ及び最適化一切無しの単純な変換(バイトコード=>マシン語)という条件化でも、やはりインタプリタよりは桁違い(20倍程度)に速くなっている*2。
データスタック操作周りで明らかに冗長な部分の最適化を簡単にでも行ったら、最適化オプション無しのgccになら結構すぐに追いつけるかもしれない。
