問題5.14-5.17
シミュレータを作ると、設計したレジスタ計算機の正当性の評価だけではなく、性能の評価もできるよ、ということですね。続き。
5.14
(define factorial-machine (make-machine (list (list '- -) (list '* *) (list '= =)) '( (test (op initialize-stack)) (assign continue (label fact-done)) ... fact-done (test (op print-stack-statistics)))))
先頭と最後にinitialize-stackとprint-stack-statisticsを追加します。execute-machine-withで適当にやってみます。
> (execute-machine-with factorial-machine ((n 2)) val) (total-pushes = 2 maximum-depth = 2) val=2 > (execute-machine-with factorial-machine ((n 3)) val) (total-pushes = 4 maximum-depth = 4) val=6 > (execute-machine-with factorial-machine ((n 4)) val) (total-pushes = 6 maximum-depth = 6) val=24 > (execute-machine-with factorial-machine ((n 5)) val) (total-pushes = 8 maximum-depth = 8) val=120 > (execute-machine-with factorial-machine ((n 6)) val) (total-pushes = 10 maximum-depth = 10) val=720 > (execute-machine-with factorial-machine ((n 20)) val) (total-pushes = 38 maximum-depth = 38) val=2432902008176640000 > (execute-machine-with factorial-machine ((n 100)) val) (total-pushes = 198 maximum-depth = 198) val=93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
ということで、どちらも2n-2ですね。
5.15
命令計数の追加。これはプログラムカウンタの変更時を捕捉すればいいと思うので、make-new-machineの中にinst-countなる変数を追加して、the-opsにinitalize-inst-count,print-inst-count手続きを追加して、execute手続きを少し変更してやればいいと思います。
(define (make-new-machine) (let ((pc (make-register 'pc)) ... (inst-count 0)) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))) (list 'print-stack-statistics (lambda () (stack 'print-statistics))) (list 'initialize-inst-count (lambda () (set! inst-count 0))) (list 'print-inst-count (lambda () (display (list 'inst-count '= inst-count)) (newline))))) (register-table (list (list 'pc pc) (list 'flag flag)))) ... (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin (set! inst-count (+ inst-count 1)) ((instruction-execution-proc (car insts))) (execute))))) ... dispatch)))
こんな感じで。前問題と同様factorial-machineで試してみます。最初と最後にinitialize-inst-count,print-inst-countを追加して実行します。
> (execute-machine-with factorial-machine ((n 5)) val) (total-pushes = 8 maximum-depth = 8) (inst-count = 51) val=120 > (execute-machine-with factorial-machine ((n 10)) val) (total-pushes = 18 maximum-depth = 18) (inst-count = 106) val=3628800 > (execute-machine-with factorial-machine ((n 20)) val) (total-pushes = 38 maximum-depth = 38) (inst-count = 216) val=2432902008176640000
大丈夫そうです。
5.16
命令をトレースできるようにします。trace-switchを作っておき、execute手続きの中でいちいちこれを見るようにすればいいです。この時、executeのinstsは連想リスト形式でcarに命令のテキスト、cdrに実行命令が入っていました。instruction-textとinstruction-execution-procで抽象していたのでこれを使います。the-opsにはtrace-onとtrace-offを追加しておきます。
(define (make-new-machine) (let ((pc (make-register 'pc)) ... (trace-switch false)) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))) ... (list 'trace-on (lambda () (set! trace-switch true))) (list 'trace-off (lambda () (set! trace-switch false))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin (set! inst-count (+ inst-count 1)) (if trace-switch (begin (display (instruction-text (car insts))) (newline))) ((instruction-execution-proc (car insts))) (execute))))) ... dispatch)))
うーんどんどん縦長になってくな。実行します。例のごとくfactorial-machineの最初と最後にtrace-on,trace-offを追加して試します。
> (execute-machine-with factorial-machine ((n 3)) val) (assign continue (label fact-done)) (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) (test (op =) (reg n) (const 1)) (branch (label base-case)) (assign val (const 1)) (goto (reg continue)) (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) (test (op trace-off)) (total-pushes = 4 maximum-depth = 4) (inst-count = 31) val=6
まあよさそうです。
5.17
5.16を拡張します。いろいろ方法がありますが、まず一番楽そうな現在のラベル情報を保持する変数current-labelを作る方向で考えてみます。ラベル変更時の補足がちょっとやっかいかもしれません。branchやgoto命令の時は簡単に捕捉できますが、単純に(つまり上から下の順番そのままで)次のラベルに行った場合の捕捉が面倒な気がします。ラベルと命令列の対応表を作って保持しておけばいいのですが、そうするとこれはプログラムの大きさの2乗に比例する比較回数が必要になるような気がします。計算スペース的にもあまりよろしくないような感じ。
なので、別のアプローチにします。instsの形式を若干変更する方向で考えてみます。
いままではinstsには命令しか入れていませんでしたが、ここにlabel情報を入れてみます。もともとの制御器のテキストには含まれているのですが、これはextract-labelsで外されてます。なのでまずはここを変えます。
(define (extract-labels text receive) (if (null? text) (receive '() '()) (extract-labels (cdr text) (lambda (insts labels) (let ((next-inst (car text))) (if (symbol? next-inst) (if (assoc next-inst labels) (error "can't define same labels -- EXTRACT-LABELS" next-inst) (receive (cons next-inst insts) (cons (make-label-entry next-inst (cons next-inst insts)) labels))) (receive (cons (make-instruction next-inst) insts) labels)))))))
こんな風にして、instsにラベル情報を含むようにします。そうするとこのinstsはassembleを通してupdate-insts!に渡ります。update-insts!ではinstsの要素をmake-execution-procedureに渡していきます。このとき、instruction-textは実質的にはcarなので、symbolであるlabel情報に適用するとエラーになる。これを回避する必要があります。こんな感じ。
(define (update-insts! insts labels machine) (let ((pc (get-register machine 'pc)) (flag (get-register machine 'flag)) (stack (machine 'stack)) (ops (machine 'operations))) (for-each (lambda (inst) (if (symbol? inst) 'no-action (set-instruction-execution-proc! inst (make-execution-procedure (instruction-text inst) labels machine pc flag stack ops)))) insts)))
次にmake-execution-procedureを考える必要があります。さっきのextract-labelsの変更で、labelsはlabel名と先頭がlabel名のシンボルになった命令列の対になっています。なのでbranch命令やgoto命令によってmake-execution-procedureにlabelのシンボルが渡る可能性があるので、cond節に追加の記述が要ります。
(define (make-execution-procedure inst labels machine pc flag stack ops) (cond ((symbol? inst) inst) ... (else (error "Unknown instruction type -- ASSEMBLE" inst))))
これでラベルだけ読み飛ばすようになりました。するとmake-new-machineの中のexecute手続き内でpcの先頭がラベルを指している場合があり、この時がラベル変更を捕捉する時になります。5.15で追加した命令計数のカウントはpcがラベルを指しているときには行わないように注意しつつ、またpcを更新するのを忘れないようにしつつ、execute手続きをこんな感じに書きます。
(define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin (if (symbol? (car insts)) (begin (if trace-switch (begin (display (car insts)) (newline))) (advance-pc pc) (execute)) (begin (set! inst-count (+ inst-count 1)) (if trace-switch (begin (display (instruction-text (car insts))) (newline))) ((instruction-execution-proc (car insts))) (execute)))))))
以上の変更をしたあと、5.16のfactorial-machineを使って実行してみます。
> (execute-machine-with factorial-machine ((n 3)) val) (assign continue (label fact-done)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) base-case (assign val (const 1)) (goto (reg continue)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) (goto (reg continue)) fact-done (test (op trace-off)) (total-pushes = 4 maximum-depth = 4) (inst-count = 31) val=6
ということで、label情報を表示することができるようになりました。
この辺は問題を解くごとにコードが汚くなっていくのがなんかいやですね。でもあと二問あるみたいなので次もどんどん汚いコードを書くと思います。とりあえずここまで。