SICP 5.5.7 Interfacing Compiled Code to the Evaluator
ついに最終節
ノート
REPLからコンパイラを呼び出して、REPLの環境で実行する。
explicit controller machineはインタープリタだが、コードをコンパイルする組み込みの手続きを用意する。変数として格納されている手続きをオペレータとしてprocに入れた後に、それがコンパイルされたコードだったらそのエントリーポイントにジャンプする。コードの実行が終わったらcontinueに入っているエントリーポイントにジャンプする。
REPLに入る前にflagレジスタがtrueになっていたらexternal-entryにジャンプするコードを挿入。external-entryに飛ぶ場合はvalにエントリーポイントが入っている事が前提。実行が終わるとREPLに入る。
variableのbound/unbound（Exercise 5.30）とlexical addressing（Section 5.5.6）が邪魔なのでこれらを取り除いて、compile-and-goを試して見る。
> (compile-and-go '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) ;;; EC-Eval value: ok ;;; EC-Eval input: (factorial 5) ;;; EC-Eval value: 120 ;;; EC-Eval input: .
期待通り。
5.4.4節に倣って、エントリーポイントprint-resultsに
(perform (op print-stack-statistics))
を足して、
> (compile-and-go '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) (total-pushes = 0 maximum-depth = 0) ;;; EC-Eval value: ok ;;; EC-Eval input: (factorial 5) (total-pushes = 31 maximum-depth = 14) ;;; EC-Eval value: 120 ;;; EC-Eval input: .
確かにかなり余分なpush/restoreは省かれている。
Interpretation and compilation
これで、インタープリタで解釈実行する事とコンパイルして実行する事の比較ができるようになった。
また、新しい計算機（新しいOSとかプロセッサとか）でLisp（ここではScheme）を動かしたいなら
Exercise 5.45
factorial専用のマシンとコンパイラが生成したコードとの性能の比較。
a.
コンパイルしたコード
| n | total push | max depth |
|---|---|---|
| 3 | 19 | 8 |
| 4 | 25 | 11 |
| 5 | 31 | 14 |
| 6 | 37 | 17 |
スピード（total push）は、スペース（max depth）は
| n | total push | max depth |
|---|---|---|
| 3 | 80 | 18 |
| 4 | 112 | 23 |
| 5 | 144 | 28 |
| 6 | 176 | 33 |
スピード（total push）は、スペース（max depth）は
| n | total push | max depth |
|---|---|---|
| 3 | 0.2375 | 0.4444 |
| 4 | 0.2232 | 0.4783 |
| 5 | 0.2153 | 0.5 |
| 6 | 0.2102 | 0.5152 |
nが大きくなると定数項は無視できるので、コンパイラのコードはインタープリタに対して6/32=18.75%の計算時間、3/5=60%のスペースで計算できると言える。
factorial machine
| n | total push | max depth |
|---|---|---|
| 3 | 4 | 4 |
| 4 | 6 | 6 |
| 5 | 8 | 8 |
| 6 | 10 | 10 |
スピード（total push）、スペース（max depth）ともに。
比率=コンパイラ/専用マシン
| n | total push | max depth |
|---|---|---|
| 3 | 4.75 | 2 |
| 4 | 4.167 | 1.833 |
| 5 | 3.875 | 1.75 |
| 6 | 3.7 | 1.7 |
nが大きくなった時を考えると、コンパイラのコードはインタープリタに対して300%の計算時間、150%のスペースを要する。
インタープリタと専用マシンのtotal pushの比は16倍。
b.
専用マシンのコード：
(controller (assign continue (label fact-done)) ; set up final return address fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) ;; Set up for the recursive call by saving n and continue. ;; Set up continue so that the computation will continue ;; at after-fact when the subroutine returns. (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) ; val now contains n(n - 1)! (goto (reg continue)) ; return to caller base-case (assign val (const 1)) ; base case: 1! = 1 (goto (reg continue)) ; return to caller fact-done)
専用マシンの
(test (op =) (reg n) (const 1))
の１行に相当するコンパイラが吐いたコードは
(assign proc (op lookup-variable-value) (const =) (reg env)) (assign val (const 1)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const n) (reg env)) (assign argl (op cons) (reg val) (reg argl)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch6)) primitive-branch6 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) after-call8 (restore env) (restore continue) (test (op false?) (reg val))
ここから見えることは
- 専用マシンがレジスタnを持っているのに対して、コンパイラのコードは変数nを環境に持っていること。環境からいちいちレジスタに値を読み出す必要が生じる。
- 手続き=がプリミティブである事を実行時に判断している
- 手続き=の引数はリストで受け取り、レジスタを直接比較する訳ではない
これらの不利な点を改善するとしたら
くらいでしょうか。実装は難しそうだけど。
Exercise 5.46
コンパイルしたコード
| n | total push | max depth |
|---|---|---|
| 3 | 27 | 8 |
| 4 | 47 | 11 |
| 5 | 77 | 14 |
| 6 | 127 | 17 |
| 7 | 207 | 20 |
| 8 | 337 | 23 |
| 9 | 547 | 26 |
| 10 | 887 | 29 |
max depthは。total pushはn=3の時は
から、n=10では
なので全体にはnの３乗弱辺りに落ち着くのか。
| n | total push | max depth |
|---|---|---|
| 3 | 128 | 18 |
| 4 | 240 | 23 |
| 5 | 408 | 28 |
| 6 | 688 | 33 |
| 7 | 1136 | 38 |
| 8 | 1864 | 43 |
| 9 | 3040 | 48 |
| 10 | 4944 | 53 |
max depthは相変わらずと線形。total pushはn=3で
、n=10で
。どの辺りに落ち着くのか。
| n | total push | max depth |
|---|---|---|
| 3 | 0.2109375 | 0.4444444444 |
| 4 | 0.1958333333 | 0.4782608696 |
| 5 | 0.1887254902 | 0.5 |
| 6 | 0.1845930233 | 0.5151515152 |
| 7 | 0.1822183099 | 0.5263157895 |
| 8 | 0.1807939914 | 0.5348837209 |
| 9 | 0.1799342105 | 0.5416666667 |
| 10 | 0.1794093851 | 0.5471698113 |
専用マシン
| n | total push | max depth |
|---|---|---|
| 3 | 8 | 4 |
| 4 | 16 | 6 |
| 5 | 28 | 8 |
| 6 | 48 | 10 |
| 7 | 80 | 12 |
| 8 | 132 | 14 |
| 9 | 216 | 16 |
| 10 | 352 | 18 |
max depthは。total pushはn=3で
、n=10で
。
比率=コンパイラ/専用マシン
| n | total push | max depth |
|---|---|---|
| 3 | 3.375 | 2 |
| 4 | 2.9375 | 1.8333333333 |
| 5 | 2.75 | 1.75 |
| 6 | 2.6458333333 | 1.7 |
| 7 | 2.5875 | 1.6666666667 |
| 8 | 2.553030303 | 1.6428571429 |
| 9 | 2.5324074074 | 1.625 |
| 10 | 2.5198863636 | 1.6111111111 |
と言う性能差。
Exercise 5.47
compile-procedure-callをコンパイルされていない、定義が環境に入っているだけの手続きも呼び出せる様に改造する。つまり評価機のcompound-applyにジャンプするコードを生成する事になるが、compound-applyと言うラベルを直接参照するコードは吐けないので、REPLに入る前にcompappと言うレジスタにラベルを代入しておく。
元のcompile-procedure-callはプリミティブでなければcompiledのコードに突入する様になっているが、もう一段compiled-procedure?を使って、compiledのコードにジャンプするコードを生成する。compound procedureの為のコードはcompile-proc-applを参考にして作る。
compile-proc-applで
- targetがvalでlinkageがreturnではない時、continueにlinkageを入れてcompappにジャンプ
- targetがvalではなくlinkageがretunでない時、continueに戻り先ラベルを入れてcompappにジャンプして、戻って来たらlinkageにジャンプ
- tagetがvalでlinkageがreturnの時、continueを設定する必要はなく、compappにジャンプ
compound-applyはev-sequenceにジャンプして、その前のev-applicationでセーブしたcontinueに戻るコードを辿るので、ev-sequenceから戻る場所をcontinueに入れておく必要がある。
(define (compile-procedure-call target linkage) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (after-call (make-label 'after-call))) (let ((compiled-linkage (if (eq? linkage 'next) after-call linkage))) (append-instruction-sequences (make-instruction-sequence '(proc) '() `((test (op primitive-procedure?) (reg proc)) (branch (label ,primitive-branch)) (test (op compiled-procedure?) (reg proc)) (branch (label ,compiled-branch)))) (parallel-instruction-sequences (parallel-instruction-sequences (append-instruction-sequences (compile-compound-proc target compiled-linkage)) (append-instruction-sequences compiled-branch (compile-proc-appl target compiled-linkage))) (append-instruction-sequences primitive-branch (end-with-linkage linkage (make-instruction-sequence '(proc argl) (list target) `((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))) after-call)))) (define (compile-compound-proc target linkage) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage)) (save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (not (eq? linkage 'return))) (let ((comp-proc-return (make-label 'comp-proc-return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,comp-proc-return)) (save continue) (goto (reg compapp)) ,comp-proc-return (assign ,target (reg val)) (goto (label ,linkage)))))) ((and (eq? target 'val) (eq? linkage 'return)) (make-instruction-sequence '(proc continue) all-regs '((save continue) (goto (reg compapp))))) ((and (not (eq? target 'val)) (eq? linkage 'return)) (error "return linkage, target not val -- COMPILE" target))))
分かりやすい様にプリミティブにdisplayとnewlineを追加して動作確認。
> (compile-and-go '(define (f) (display "f")(newline)(g))) (total-pushes = 0 maximum-depth = 0) ;;; EC-Eval value: ok ;;; EC-Eval input: (define (g) (display "g")(newline)) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (f) f g (total-pushes = 18 maximum-depth = 6) ;;; EC-Eval value: #<void> ;;; EC-Eval input:
一応シンプルなコードは動いている。
Exercise 5.48
従来は
- レジスタマシンを作った時点で指定されたプログラム（評価器）を実行するか、（start-eceval）
- 引数で指定されたプログラムをコンパイルして、それを最初に実行してからレジスタマシンを作った時点で指定されたプログラム（評価器）に入る（compile-and-go）
のどちらかだった。
compile-and-runはJust-In-Timeコンパイルをしてから実行する事を指定するので、レジスタマシンに対する命令と言える。レジスタマシンに対する命令をレジスタマシン上で動いているプログラム（評価器）から実行する事になるのでかなり特殊な状況を作る必要がある。
まずは評価機がcompile-and-runを解釈出来なければならないが、これは普通の手続き呼び出しの様な形式なので
- defineの様にspecial formにする
- プリミティブとして用意しておく
が考えられる。
compile-and-runの引数のプログラムをinstruction sequenceに変換（assemble）してREPLに戻るように準備した上で実行すれば良い。assembleには引数としてmachineが必要だが、レジスタマシンから自分自身を参照する手段がない。
上記のプリミティブはそもそもREPL入力の引数しか手続きに渡せないので無理。
special formであればレジスタマシンにselfと言うレジスタを用意して、ecevalをスタートさせる前にecevalにmachineを拘束しておいて、special formを処理するときにmachineを渡すコードにしておけば何とか可能。
もう一つ考えられるのは、primitiveとかcompiledの様な手続きの種類としてmeta-procedureと言う種類を用意しておく。手続きはあらかじめ環境に入れておき、評価器の手続き処理にひと種類追加する事になる。今回これを実装してみる。
meta-procedureとして用意するcompile-and-runの実装。assembleした結果のinstruction sequenceにジャンプしたいのだが、meta-procedureの処理から戻る前に実行する必要が有るので、強制的にpcをassembleした結果に設定するのだが、実行する前にpcをひとつ進めてしまうのでダミーをひとつ噛ませて、pcをひとつ進めてからinstructionの実行に移る様にする。
(define (compile-and-run args machine) (let ((instructions (assemble (statements (compile (car args) 'val 'return)) machine))) (set-register-contents! machine 'pc (cons 'dummy-instruction instructions))))
meta-procedureをサポートする手続き
(define (meta-procedure? proc) (tagged-list? proc 'meta-proc)) (define (meta-implementation proc) (cadr proc)) (define (apply-meta-procedure proc args machine) (apply-in-underlying-scheme (meta-implementation proc) (list args machine))) (define (meta-apply-succeeded? result) (car result)) (define (meta-apply-result result) (cdr result))
setup-environmentを拡張。meta-procedureのエントリーを追加。
(define meta-procedures (list (list 'compile-and-run compile-and-run) )) (define (meta-procedure-names) (map car meta-procedures)) (define (meta-procedure-objects) (map (lambda (proc) (list 'meta-proc (cadr proc))) meta-procedures)) (define (setup-environment) (let ((initial-env (extend-environment (meta-procedure-names) (meta-procedure-objects) (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment)))) (define-variable! 'true true initial-env) (define-variable! 'false false initial-env) initial-env))
eceval-operationsに追加
(define eceval-operations (list (list 'self-evaluating? self-evaluating?) （中略） (list 'meta-procedure? meta-procedure?) (list 'apply-meta-procedure apply-meta-procedure) ))
apply-dispatchを拡張。primitive-applyに比べて引数にmachineが増えている。
apply-dispatch
(test (op meta-procedure?) (reg proc))
(branch (label meta-apply))
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-apply))
(test (op compound-procedure?) (reg proc))
(branch (label compound-apply))
(test (op compiled-procedure?) (reg proc))
(branch (label compiled-apply))
(goto (label unknown-procedure-type))
compiled-apply
(restore continue)
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
meta-apply
(assign continue (label after-meta-apply))
(assign val (op apply-meta-procedure)
(reg proc)
(reg argl)
(reg machine))
after-meta-apply
(restore continue)
(goto (reg continue))
start-ecevalを拡張
(define (start-eceval) (set! the-global-environment (setup-environment)) (set-register-contents! eceval 'machine eceval) (set-register-contents! eceval 'flag false) (start eceval))
実行結果
> (start-eceval) ;;; EC-Eval input: (compile-and-run '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))) (total-pushes = 5 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (factorial 5) (total-pushes = 31 maximum-depth = 14) ;;; EC-Eval value: 120 ;;; EC-Eval input: (compile-and-run '(define (inc x) (+ x 1))) (total-pushes = 5 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (inc 3) (total-pushes = 5 maximum-depth = 3) ;;; EC-Eval value: 4 ;;; EC-Eval input: (define (increase x) (+ x 1)) (total-pushes = 3 maximum-depth = 3) ;;; EC-Eval value: ok ;;; EC-Eval input: (increase 3) (total-pushes = 13 maximum-depth = 5) ;;; EC-Eval value: 4 ;;; EC-Eval input: .
コンパイルした方が効率が良くなっている事が分かる。
Exercise 5.49
つまり常にread、compile-and-run、print-resultだけを行うレジスタマシンを実装する。
オペレーションとしてcompile、statements、assembleを登録。
(define rcepl-operations (list (list 'self-evaluating? self-evaluating?) （中略：ecevalと同じ） (list 'compile compile) (list 'statements statements) (list 'assemble assemble) ))
レジスタマシンはecevalのREPLを参考にcompile-and-runの内容を手動で（？）コンパイルして埋め込む。
(define rcepl (make-machine rcepl-operations '(read-compile-execute-print-loop (perform (op initialize-stack)) (perform (op prompt-for-input) (const ";;; RCEPL input:")) (assign exp (op read)) (assign env (op get-global-environment)) (assign continue (label print-result)) (assign val (op compile) (reg exp) (const val) (const return)) (assign val (op statements) (reg val)) (assign val (op assemble) (reg val) (reg machine)) (goto (reg val)) print-result (perform (op print-stack-statistics))
