rowl VM/GC の実装
1. rowl-coreインタプリタを開発
LISPの様なS式で書かれたrowl-core言語を処理する簡易インタプリタを以前作ったrowl0で実装しました。
言語機能が低いうちはインタプリタの方が簡単に作れるので、開発を加速することができます。
rowl-coreインタプリタのコードはほんの3000行です。
こんな感じのプログラムが書けます。
; 関数定義
(define assoc (key list)
(cond
((nil? list) nil)
((== key (caar list)) (cdar list))
(otherwise (assoc key (cdr list)))
)
)
; マクロ
(rewrite foreach (it list body) `(do
(var ls @list)
(var last? nil)
(while ls (do
(var @it (car ls))
(set last? (nil? (cdr ls)))
@body
(set ls (cdr ls))
)
)
))
; 引数での簡易パターンマッチ
(define emit_return ((_ . arg) _ _) (do
(if arg (emit_expr (car arg) `%eax nil))
(emit "leave")
(emit "ret")
))
2. VM/GCコードの実装
rowl-core言語でVM/GCのコードをS式のオブジェクトとして作ります。
バッククオート(`)がクオート、アットマーク(@)がアンクオート演算子です。
(var vm-alloc-code `(
(fun mmap2 (addr size) (
(void* ptr (syscall @SYS_MMAP2 addr size
@(| PROT_READ PROT_WRITE PROT_EXEC) @(| MAP_ANONYMOUS MAP_PRIVATE) -1 0))
(if (&& (<= -128 ptr) (< ptr 0)) ((error "ERROR: mmap2 failed\n")))
(return ptr)
))
(fun munmap (addr size) (
(syscall @SYS_MUNMAP addr size)
))
(int num_block 0)
(void* next_addr 0)
(void* free_first 0)
(void* free_last 0)
(int[] @MAX_BLOCKS block_used)
(fun alloc_block (size) (
(+= size @BLOCK_SIZE)
(void* ptr (mmap2 0 size))
(void* slop (& ptr @BLOCK_MASK))
(if (< (munmap ptr (- @BLOCK_SIZE slop)) 0) ((error "ERROR: munmap failed\n")))
(if (&& (> slop 0) (< (munmap (- (+ ptr @BLOCK_SIZE) slop) slop) 0))
((error "ERROR: munmap failed\n")))
(= ptr (- (+ ptr size) slop))
(return ptr)
))
(fun alloc_block_fast () (
(void* addr)
(if (> (+ num_block 1) @MAX_BLOCKS) ((error "ERROR: too many blocks\n")))
(if (== next_addr 0)
((= addr (alloc_block @BLOCK_SIZE)))
(
(= addr (mmap2 @BLOCK_SIZE))
(if (!= (& addr @BLOCK_MASK) 0) (
(if (< (munmap addr @BLOCK_SIZE) 0) ((error "ERROR: munmap failed\n")))
(= addr (alloc_block @BLOCK_SIZE))
))
))
(= next_addr (+ addr @BLOCK_SIZE))
(= free_first addr)
(= free_last next_addr)
([]= block_used (/ addr @BLOCK_SIZE) @TRUE)
))
))
3. VM/GCコード→アセンブリのコンパイラを作成
上で作成したコードをアセンブリ言語に翻訳する専用のコンパイラをrowl-coreで作ります。
(define emit_call ((call func . args) dst ret) (do
(if (symbol? func) (emit_directcall func args dst) (emit_indirectcall func args dst))
(if ret (emit_return `(return) nil nil))
))
(define emit_directcall (func args dst) (do
(var narg (length args))
(foreach e (reverse args) (do
(emit_expr e `%eax nil)
(pushl `%eax)
))
(emit "call" `(label @func))
(if (> narg 0) (emit "addl" (* 4 narg) `%esp))
(if dst (movl `%eax dst))
))
(define emit_indirectcall (func args dst) (do
(var narg (length args))
(foreach e (reverse args) (do
(emit_expr e `%eax nil)
(pushl `%eax)
))
(emit "call" `(label @func))
(if (> narg 0) (emit "addl" (* 4 narg) `%esp))
(if dst (movl `%eax dst))
))
(define emit_def ((type sym . init) dst ret) (do
(var v (lookup_var sym))
(if init (do (emit_expr (car init) `%eax nil) (movl `%eax v)))
(if dst (movl v dst))
(if ret (emit_return `(return) nil nil))
))
...こんな感じのコードを式のタイプ毎に作って、ディスパッチャで呼び出します。
(var expr_dispatcher `(
(nop . @emit_nop)
(syscall . @emit_syscall)
(call . @emit_call)
(return . @emit_return)
(label . @emit_label)
(goto . @emit_goto)
(if . @emit_if)
(while . @emit_while)
(int . @emit_def)
(char . @emit_def)
(void* . @emit_def)
(*8 . @emit_deref8)
(+ . @emit_binexpr)
(- . @emit_binexpr)
(* . @emit_binexpr)
(/ . @emit_div)
(% . @emit_mod)
(& . @emit_binexpr)
(| . @emit_binexpr)
(^ . @emit_binexpr)
(== . @emit_comparison)
(!= . @emit_comparison)
(< . @emit_comparison)
(> . @emit_comparison)
(<= . @emit_comparison)
(>= . @emit_comparison)
(= . @emit_asgn)
(+= . @emit_opasgn)
(-= . @emit_opasgn)
(*= . @emit_opasgn)
(/= . @emit_opasgn)
(%= . @emit_opasgn)
([]= . @emit_arrasgn)
(incl . @emit_incldecl)
(decl . @emit_incldecl)
))
(define emit_expr args (dispatch expr_dispatcher emit_expr_default args))たとえば
(emit_expr `(+ 1 2) `%eax nil)
のようにするとemit_binexprに処理が移って下の様なアセンブリが生成されます。
movl $1, %eax
pushl %eax
movl $2, %ebx
popl %eax
addl %ebx, %eax最適化などが一切ない簡易的なコンパイラです。トータルでたったの570行程です。
