SBCLでVOPを使ってみよう — #:g1

Posted 2011-12-07 05:03:00 GMT

VOPとはVirtual Operationとのことで、SBCLのコンパイラのバックエンドが使っているアセンブリのような形式です。
面白そうなのでいじってみようということで、SBCL Internals: Adding VOPsを参考にfixnumの範囲でしか正しく機能しないfactを作ってみたいと思います。
マシンのアーキテクチャは、x86_64です。
とりあえず、既存の関数はどんな感じになっているのかを確認

(declaim (optimize (safety 0) (speed 3) (debug 0)))

(declaim (ftype (function (fixnum fixnum) fixnum) fact-recur))

(defun fact-recur (n a) (if (zerop n) a (fact-recur (1- n) (the fixnum (* n a)))))

(fact-recur 30 1) ;=> 458793068007522304

; disassembly for FACT-RECUR (assembled 42 bytes)
L0:     TEST RCX, RCX              ; no-arg-parsing entry point
        JEQ L1
        MOV RAX, RCX
        SAR RAX, 1
        MOV RBX, RAX
        SUB RBX, 1
        SAR RCX, 1
        IMUL RCX, RDX
        MOV RDX, RCX
        MOV RCX, RBX
        SHL RCX, 1
        JMP L0
L1:     MOV RSP, RBP
        CLC
        POP RBP
        RET
(dotimes (i (expt 10 8))
  (fact-recur 30 1))
;⇒ NIL
----------
Evaluation took:
  10.123 seconds of real time
  10.090000 seconds of total run time (10.090000 user, 0.000000 system)
  99.67% CPU
  24,235,906,392 processor cycles
  1,571,872 bytes consed

Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz

これを参考に書こうかと思いましたが、どうも余計なレジスタを使っているようなのでループで書いたものも見てみます。
(defun fact-loop (n)
  (declare (fixnum n))
  (prog ((a 1))
        (declare (fixnum a))
     L0 (cond ((zerop n)
               (go L1 )))
        (setq a (* a n))
        (decf n)
        (go L0)
     L1 (return a)))

(fact-loop 30) ;=> 458793068007522304

; disassembly for FACT-LOOP (assembled 36 bytes)
        MOV EDX, 2                 ; no-arg-parsing entry point
        JMP L1
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
L0:     SAR RDX, 1
        IMUL RDX, RCX
        SUB RCX, 2
L1:     TEST RCX, RCX
        JNE L0
        MOV RSP, RBP
        CLC
        POP RBP
        RET
(dotimes (i (expt 10 8))
  (fact-loop 30))
;⇒ NIL
----------
Evaluation took:
  6.631 seconds of real time
  6.630000 seconds of total run time (6.630000 user, 0.000000 system)
  99.98% CPU
  15,874,070,256 processor cycles
  32,768 bytes consed

Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz

使っているレジスタも少なくなって余計な計算もなくなったので速くなったようです。
これを件のVOPのページを参考に翻訳してみます。
引数が2つ(というか使うレジスタが2つ?)なので、fast-fixnum-binopを雛形に使います。 ちなみに雛形はこんな感じになっています。
(define-vop (fast-safe-arith-op)
  (:policy :fast-safe)
  (:effects)
  (:affected))

(define-vop (fast-fixnum-binop fast-safe-arith-op) (:args (x :target r :scs (any-reg) :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) (sc-is r control-stack) (location= x r)))) (y :scs (any-reg control-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0) :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) (sc-is r control-stack) (location= x r))))) (:result-types tagged-num) (:note "inline fixnum arithmetic"))

(in-package :sb-vm)

(defknown fact-loop-vop1 (fixnum fixnum) fixnum)

(define-vop (fact-loop-vop1 fast-fixnum-binop) (:translate fact-loop-vop1) (:generator 10 (inst jmp L1) L0 (inst sar y 1) (inst imul y x) (inst sub x (fixnumize 1)) L1 (inst test x x) (inst jmp :ne L0) (inst mov r y)))

(defun fact-loop-vop (n) (fact-loop-vop1 n 1))

(fact-loop-vop 30) ;=> 458793068007522304

; disassembly for FACT-LOOP-VOP (assembled 37 bytes)
        MOV EAX, 2                 ; no-arg-parsing entry point
        MOV EAX, 2
        JMP L1
L0:     SAR RAX, 1
        IMUL RAX, RDX
        SUB RDX, 2
L1:     TEST RDX, RDX
        JNE L0
        MOV RDX, RAX
        MOV RSP, RBP
        CLC
        POP RBP
        RET
という風にループで書いたのと大体同じになりました。
(dotimes (i (expt 10 8))
  (fact-loop-vop 30))
;⇒ NIL
----------
Evaluation took:
  6.661 seconds of real time
  6.670000 seconds of total run time (6.670000 user, 0.000000 system)
  100.14% CPU
  15,946,443,999 processor cycles
  66,240 bytes consed

Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz

タイムも大体同じ。
ここで目的コードを眺めてみると、ループの度に1つ右シフトしてるのは、なんでなんだろう、と気になりますが、SBCLでは下位ビットをタグとしているので(1.0.53から下位1ビットが0はfixnumということになった)引数でやってくる数は、CPUからすれば2倍されていることになります。IMULは符号付き乗算の命令ですが2倍された数を都度掛ければどんどん2倍されていってしまうので、右シフトで乗算前に2で割っておく、ということみたいです。
だったら入口と出口でfixnumとの変換をしてしまえば良いんじゃないかということで、
(defknown fact-loop-vop2 (fixnum fixnum) fixnum)

(define-vop (fact-loop-vop2 fast-fixnum-binop) (:translate fact-loop-vop2) (:generator 10 (inst sar x 1) (inst sar y 1) (inst jmp L1) L0 (inst imul y x) (inst dec x) L1 (inst test x x) (inst jmp :ne L0) (inst shl y 1) (inst mov r y)))

(defun fact-loop-vop-opt (n) (declare (fixnum n)) (fact-loop-vop2 n 1))

(fact-loop-vop-opt 30) ;=> 458793068007522304

こんな感じに書いてみました。
; disassembly for FACT-LOOP-VOP-OPT (assembled 37 bytes)
        MOV EAX, 2                 ; no-arg-parsing entry point
        SAR RDX, 1
        SAR RAX, 1
        JMP L1
L0:     IMUL RAX, RDX
        DEC RDX
L1:     TEST RDX, RDX
        JNE L0
        SHL RAX, 1
        MOV RDX, RAX
        MOV RSP, RBP
        CLC
        POP RBP
        RET
(dotimes (i (expt 10 8))
  (fact-loop-vop-opt 30))
;⇒ NIL
----------
Evaluation took:
  4.576 seconds of real time
  4.550000 seconds of total run time (4.550000 user, 0.000000 system)
  99.43% CPU
  10,954,448,910 processor cycles
  57,376 bytes consed

Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz

速度もちょっと速くなりました。めでたしめでたし。

VOPについては良く分かっていないので、だいぶ端折った紹介になりましたが、こういう高速化の最終手段もあるみたいですよという話でした。REPLでアセンブリレベルのものが書けるというのが手軽で楽しいです。
ソースの src/compiler/アーキテクチャ の下を覗くと色々な定義があるので参考になりますので興味がある方は試してみてはいかがでしょうか。

comments powered by Disqus