Toy VM(5) - cranebirdの日記

SECD マシンをちょっと変形してみよう。

スタックだけなのが元々の SECD マシンだ。SECD マシンを何となく動かすことはできた。簡単だけどとても面白いVM-仮想マシンだ。こいつに V レジスタ - 計算結果を保持するようなレジスタを足してみよう。gauche VM に少しだけ近づけてみるんだ。V(VAL0) レジスタがどんなふうに（高速化に？）役に立っているかはまだ分からないけど、まずはマネをして少しずつ理解しよう。

当然だけどVM命令もちょっと変える必要がある。例えば元々の SECD マシンの LDC 命令- スタックに定数を積む基本命令 - は、V に値を積む CONST 命令と、V の値をスタックに積む PUSH 命令に分解される。パターンマッチの match があるから、実装は非常にシンプルだ。

disasm を使ってVM命令を出力してみる。実現したいのはこれだ。

gosh> (disasm (lambda () (+ 13 5)))
main_code (name=#f, code=0xc5730, size=10, const=1, stack=5):
args: #f
     0 CONST 13
     2 PUSH 
     3 CONST 5
     5 PUSH 
     6 GREF #<identifier secd#+>; +
     8 TAIL-CALL(2)             ; (+ 13 5)
     9 RET 
#<undef>

CONST, PUSH, CONST, PUSH。これはSとVを使うだけだ。GREF, (TAIL)CALL, RET。GREF はVレジスタにプロシージャを置くものとしよう(Reading Gauche 参照)。CALL n はスタックから n 個の引数を取り出して V レジスタのプロシージャを適用しよう。RET は継続の扱いと関係するから、ちょっと怪しいけどとりあえずSECDのRTNをマネしておこう。

適当にコンパイラを作って、動かしてみた。

gosh> (compile-g () '(+ 13 5))
(CONST 13 PUSH CONST 5 PUSH GREF + CALL 2)

gosh> (secdv 's 'e (compile-g () '(+ 13 5)) 'd 'v)
(s e (CONST 13 PUSH CONST 5 PUSH GREF + CALL 2) d v)
(s e (PUSH CONST 5 PUSH GREF + CALL 2) d 13)
((13 . s) e (CONST 5 PUSH GREF + CALL 2) d ())
((13 . s) e (PUSH GREF + CALL 2) d 5)
((5 13 . s) e (GREF + CALL 2) d ())
((5 13 . s) e (CALL 2) d #<subr +>)
(s e () d 18)
(s e () d 18)
stop

;; SECD + V register machine
(define (secdv s e c d v)
  (match (list s e c d v)
    ((s e ('PUSH . c) d v)
     (secdv (cons v s) e c d ()))

    ((s e ('CONST val . c) d v)
     (secdv s e c d val))

    ;; s e (PRE-CALL . c) d v TODO
    ;;((s e ('PRE-CALL location . c) d v)
    ;; (secdv s e c (append (list s e location) d) v))

    ;; RET TODO;
    ((s2 e2 ('RET . cx) (s e c . d) v)
     (secdv s e c d v))

    ;; GREF +
    ((s e ('GREF '+ . c) d v)
     (secdv s e c d +))
    ;; GREF -
    ((s e ('GREF '- . c) d v)
     (secdv s e c d -))

    ;; CALL argc
    ((s e ('CALL 0 . c) d (? procedure? v))
     (secdv s e c d (v)))
    (((a0 . s) e ('CALL 1 . c) d (? procedure? v))
     (secdv s e c d (v a0)))
    (((a1 a0 . s) e ('CALL 2 . c) d (? procedure? v))
     (secdv s e c d (v a0 a1)))

    ;; base condition
    ((s e c d v)
     (values (list s e c d v) 'stop))))

(define (compile-g env exp)
  (cond
   ;;((eq? exp 'NIL)
   ;; '(NIL))
   ((number? exp)
    `(CONST ,exp))
   (else
    (match exp
      (('+ a b)
       `(,@(compile-g env a) PUSH
         ,@(compile-g env b) PUSH
         GREF +
         CALL 2))
      (('- a b)
       `(,@(compile-g env a) PUSH
         ,@(compile-g env b) PUSH
         GREF -
         CALL 2))
      ))))

次は PRE-CALL 相当をやる。継続だ。あんまり自信はないけど、SECD マシンの AP 命令とそんなに違いはないはずだ。

多分続く。