LISPUSER

つらつらと comp.lang.lisp への投稿を眺めていたところ，面白い記事を発見 しました．Writing machine code from LISP スレッドへの Frank Buss 氏の投稿 http://groups.google.com/group/comp.lang.lisp/msg/6d9cbc0fd337431b です．なんと CFFI を使って配列を用意し，そこに機械語のコードを埋め込ん で関数として呼び出してしまうという荒技です．

元の投稿はリストの合計値を求めているだけだったので，32 ビットでフィボナッ チ数を求める処理にチャレンジしてみました．

;; フィボナッチ数計算
(defun fib (n)
  (loop with a = 0
        with b = 1
        repeat n
        do (psetf a b
                  b (+ a b))
        finally (return a)))

これを機械語に変換します．いきなり機械語はキツいので，一旦アセンブラで 考えます．

;; フィボナッチ数計算 (アセンブラ)
[必須レジスタの保存]
;; パラメータ n を受けとる
movl 4(%ebp), %edx
;; a = 0
xor  %eax, %eax
;; b = 1
xor  %ebx, %ebx 
inc  %ebx
;; repeat n
LOOP:
test %edx, %edx
jz   END
dec  %edx
;; ループ内の処理
;; ecx レジスタに a+b の値を計算
mov ecx, eax
add ecx, ebx
;; a <- b
mov eax, ebx
;; b <- a+b
mov ebx, ecx
;; ループの処理
jmp  LOOP
 END:
[必須レジスタの復元]

あとはこのコードに等しいベクタを作り，それを一引数の関数として呼び出します．

(defun assembler-fib (n)
  (let ((program
         '(
           #x55            ;      push ebp       ; save frame pointer
           #x8b #xec       ;      mov  ebp, esp  ; get stack pointer
           #x53            ;      push ebx       ; save ebx
           #x51            ;      push ecx       ; save ecx
           #x8b #x55 #x08  ;      mov  edx, DWORD PTR [ebp+4]  ; get start of list
           #x31 #xC0       ;      xor  eax, eax  ; a = 0
           #x31 #xDB       ;      xor  ebx, ebx  ; b = 0
           #x43            ;      inc  ebx       ; b = 1
           #x85 #xD2       ;  L0: test edx, edx  ; n == 0 ?
           #x74 #x0b       ;      jmp  END       ; end if n == 0
           #x4A            ;      dec  edx       ; n = n - 1
           #x89 #xC1       ;      mov  ecx, eax  ; tmp = a
           #x01 #xD9       ;      add  ecx, ebx  ; tmp += b
           #x89 #xD8       ;      mov  eax, ebx  ; a = b
           #x89 #xCB       ;      mov  ebx, ecx  ; b = tmp
           #xEB #xF1       ;      jmp  L0        ; LOOP
           #x59            ;      pop  ecx       ; restore ecx
           #x5b            ;      pop  ebx       ; restore ebx
           #x5d            ;      pop  ebp       ; restore frame point
           #xc3            ;      ret            ; return from subroutine
           )))
    (cffi:with-foreign-object (code :unsigned-char (length program))
      (loop for byte in program
            for i = 0 then (1+ i) do
            (setf (cffi:mem-aref code :unsigned-char i) byte))
        (cffi:foreign-funcall code :int n :int))))

で，ここまでで，ふと嫌な予感がして CLISP で計測してみたところ……この反 復アルゴリズムでは FFI 呼び出しオーバーヘッドのほうが効いてきますね…． 32 bit 範囲内だと CLISP VM でも十分に速く，かつ大きな数が計算できないデ メリットだけが残りました． orz

 ;; 機械語版
 102334155
 Real time: 0.001749 sec.
 Run time: 0.0 sec.
 Space: 568 Bytes
 ;; LISP 版
 102334155
 Real time: 9.42E-4 sec. == 0.000942 sec
 Run time: 0.0 sec.
 Space: 408 Bytes

もっと，使いどころを選ぶ必要があるようです．うーん…

CLISP の苦手なタイトループなどを比較すれば，次のような機械語の高性能が 体感できます．

(defun assembler-count (n)
  (let ((program
         '(
           #x55            ;      push ebp       ; save frame pointer
           #x8b #xEC       ;      mov  ebp, esp  ; get stack pointer
           #x53            ;      push ebx       ; save ebx
           #x51            ;      push ecx       ; save ecx
           #x8B #x4D #x08  ;      mov  ecx, DWORD PTR [ebp+8]  ; get start of list
           #x31 #xC0       ;      xor  eax, eax  ; a = 0
           #x40            ;      inc  eax       ; LOOP: a++
           #x49            ;      dec  ecx       ; n--
           #x85 #xC9       ;      test %ecx,%ecx ; jump LOOP if ecx == 0
           #x75 #xFA       ;      jnz  LOOP2     ;
           #x59            ;      pop  ecx       ; restore ecx
           #x5b            ;      pop  ebx       ; restore ebx
           #x5d            ;      pop  ebp       ; restore frame point
           #xc3            ;      ret            ; return from subroutine
           )))
    (cffi:with-foreign-object (code :unsigned-char (length program))
      (loop for byte in program
            for i = 0 then (1+ i) do
            (setf (cffi:mem-aref code :unsigned-char i) byte))
        (cffi:foreign-funcall code :int n :int))))
(defun lisp-count (n)
  (loop with a = 0
        while (/= n 0)
        do
        (incf a)
        (decf n)
        finally (return a)))
(compile 'assembler-count)
(compile 'lisp-count)

(let ((n 10000000))
  (time (print (assembler-count n)))
  (time (print (lisp-count n))))


(let ((n 100000000))
  (time (print (assembler-count n)))
  (time (print (lisp-count n))))

 10000000
 Real time: 0.010388 sec.
 Run time: 0.02 sec.
 Space: 552 Bytes
 10000000
 Real time: 0.551436 sec.
 Run time: 0.54 sec.
 Space: 328 Bytes
 100000000
 Real time: 0.119557 sec.
 Run time: 0.12 sec.
 Space: 568 Bytes
 100000000
 Real time: 114.75736 sec.
 Run time: 114.16 sec.
 Space: 2663129432 Bytes
 GC: 805, GC time: 16.46 sec.

特に Lisp の即値である FIXNUM の境界を超えたあたりの数値で Consing が発 生して性能劣化がはげしいです．CLISP だと most-positive-fixnum == 16777215 が fixnum の上限でこれより大きい数は多倍長整数 bignum として扱われるため演算時に consing が発生します．