SICP 読書ノート#72 - 5.2 レジスタ計算機シミュレータ(1) (pp.306-317)

テキストを読んでも文字ばかりで全然頭に入ってこないので、まずはシミュレータをがっと実装した。

https://github.com/uents/sicp/blob/master/ch5-register-simulator

いつものようにRacketで動かせるように修正してます。他にもデバッグのために実行手続きは名前付きにしたりとちょこちょこ変えてます。

シミュレータの概要

インターフェースとしては、マシンの構築、レジスタへのアクセサ、マシンの実行からなる。

マシンの構築

レジスタ、演算手続き、コントローラ命令列からなるマシンを構築しそれを返す。

(make-machine <register-names> <operations> <controller>)

レジスタへのアクセサ

マシンのレジスタに対するsetter, getterがある。

(set-register-contents! <machine-model> <register-name> <value>)
(get-register-contents! <machine-model> <register-name>)

マシンの実行

マシンの実行をシミュレートする。コントローラ命令列の初めから開始し、最後まで実行すると終了する。

(start <machine-model>)

シミュレータを実行した時の結果はこんな感じ。

> (define gcd-machine
    (make-machine
     '(a b t) ;; register names
     (list (list 'rem remainder) (list '= =)) ;; operations
     '(test-b ;; controller instruction sequence
       (test (op =) (reg b) (const 0))
       (branch (label gcd-done))
       (assign t (op rem) (reg a) (reg b))
       (assign a (reg b))
       (assign b (reg t))
       (goto (label test-b))
       gcd-done)))

  #=> 命令シーケンス(アセンブルされたコントローラ命令列)を出力させるとこんな感じ
  (list
    (mcons '(test (op =) (reg b) (const 0)) #<procedure:test-proc>)
    (mcons '(branch (label gcd-done)) #<procedure:branch-proc>)
    (mcons '(assign t (op rem) (reg a) (reg b)) #<procedure:assign-proc>)
    (mcons '(assign a (reg b)) #<procedure:assign-proc>)
    (mcons '(assign b (reg t)) #<procedure:assign-proc>)
    (mcons '(goto (label test-b)) #<procedure:goto-label-proc>))

> gcd-machine
#<procedure:dispatch>

> (set-register-contents! gcd-machine 'a 206)
'done

> (set-register-contents! gcd-machine 'b 40)
'done

> (start gcd-machine)
'done

> (get-register-contents gcd-machine 'a)
2

処理の流れをフローで書いてみる。

(make-machine)および(start <machine-model>)の処理は、それぞれ次のようになるかと思う。

(make-machine)
1. 与えられたコントローラ命令列をアセンブラ(assemble)に通して命令シーケンス(instrcution sequence)に変換
2. 命令シーケンスはいったんthe-instruction-sequenceというレジスタにset
(start <machine-model>)
1. the-instruction-sequenceレジスタの内容をpcレジスタにset
2. (execute)という手続きを実行し、pcレジスタから命令シーケンスの先頭の実行手続きを取り出し、(instruction-exec-proc)で実行
3. 実行手続きの最後で(advance-pc)という手続きを実行し、残りの命令シーケンスをpcレジスタにset
4. 再び(execute)を実行。以下2〜4の繰り返し

ただしbranchおよびgoto命令は、以下の命令シーケンスを pcレジスタにsetして(execute)を実行する

branch命令は、flagレジスタ(test命令の実行結果が格納される)がtrueの場合、ラベルに紐づく命令シーケンスをpcレジスタにset
goto命令は、与えられたラベルまたはレジスタの内容をpcレジスタにset

また、アセンブルのフェーズでラベルを発見すると、ラベルのシンボルとそれに続く命令シーケンスを対にして保持することで、ラベルの管理を行っている。

問題 5.8

ラベルが重複しているコントローラ命令を与えるとどう振る舞うか？

racket@> ,enter "regsim.scm"
'(REGISTER SIMULATOR LOADED)

racket@regsim.scm> (define test-machine
                     (make-machine
                      '(a)
                      '()
                      '(start
                        (goto (label here))
                        here
                        (assign a (const 3)) (goto (label there))
                        here
                        (assign a (const 4)) (goto (label there))
                        there)))
racket@regsim.scm> (start test-machine)
'done

racket@regsim.scm> (get-register-contents test-machine 'a)
3

2つ目のhereへは処理が映らないから、結果は3になる。

ラベルの重複を許さないようにするには (extract-labels)でチェック処理を追加すればよい。こんな感じかな。

diff --git a/ch5-register-simulator/regsim.scm b/ch5-register-simulator/regsim.scm
index 8ec7d87..af416ad 100644
--- a/ch5-register-simulator/regsim.scm
+++ b/ch5-register-simulator/regsim.scm
@@ -138,9 +138,11 @@
                       (lambda (insts labels)
                         (let ((next-inst (car ctrl-text)))
                           (if (symbol? next-inst)
-                              (recieve insts
-                                       (cons (make-label-entry next-inst insts)
-                                             labels))
+                              (if (label-insts labels next-inst)
+                                  (error "[extract-labels] duplicate label:" next-inst)
+                                  (recieve insts
+                                           (cons (make-label-entry next-inst insts)
+                                                 labels)))
                               (recieve (cons (make-instruction next-inst)
                                              insts)
                                        labels)))))))
@@ -178,8 +180,11 @@
 (define (make-label-entry label-name insts)
   (cons label-name insts))

+(define (label-insts labels label-name)
+  (assoc label-name labels))
+
 (define (lookup-label labels label-name)
-  (let ((val (assoc label-name labels)))
+  (let ((val (label-insts labels label-name)))
        (if val
                (cdr val)
                (error "[lookup-label] undefined label:" label-name))))

問題 5.9

オリジナルの実装のままだとマシンはラベルに対しても演算しようとするらしい。試してみる。

racket@regsim.scm> (define test-machine
                     (make-machine
                      '(a)
                      (list (list '+ +))
                      '(test
                        (assign a (op +) (const 1) (label test)))))

racket@regsim.scm> (start test-machine)
+: contract violation
  expected: number?
  given: (list (mcons '(assign a (op +) (const 1) (label test)) #<procedure:assign-proc>))
  argument position: 2nd
  other arguments...:
   1
  context...:
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:222:8: assign-proc
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:47:8: dispatch
   /opt/homebrew-cask/Caskroom/racket/6.1.1/Racket v6.1.1/collects/racket/private/misc.rkt:87:7

そこで、アセンブルの段階でオペランドのチェックをするようにした。

diff --git a/ch5-register-simulator/regsim.scm b/ch5-register-simulator/regsim.scm
index af416ad..60e3432 100644
--- a/ch5-register-simulator/regsim.scm
+++ b/ch5-register-simulator/regsim.scm
@@ -329,7 +329,9 @@
 (define (make-operation-exp exp machine labels ops)
   (let ((op (lookup-prim (operation-exp-op exp) ops))
                (procs (map (lambda (exp)
-                                         (make-primitive-exp exp machine labels))
+                      (if (label-exp? exp)
+                          (error "[make-operation-exp] cannot use label:" + exp)
+                          (make-primitive-exp exp machine labels)))
                                        (operation-exp-operands exp))))
        (define (op-proc)
          (apply op (map (lambda (proc) (proc)) procs)))

マシンを作成するとアセンブルの段階で中断する。

racket@regsim.scm> (define test-machine
                     (make-machine
                      '(a)
                      (list (list '+ +))
                      '(test
                        (assign a (op +) (const 1) (label test)))))
[make-operation-exp] cannot use label: #<procedure:+> (label test)
  context...:
   /opt/homebrew-cask/Caskroom/racket/6.1.1/Racket v6.1.1/collects/racket/private/map.rkt:26:19: loop
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:329:0: make-operation-exp
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:216:0: make-assign
   /opt/homebrew-cask/Caskroom/racket/6.1.1/Racket v6.1.1/collects/racket/private/map.rkt:53:19: loop
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:128:34
   /Users/uents/work/sicp/ch5-register-simulator/regsim.scm:3:0: make-machine
   /opt/homebrew-cask/Caskroom/racket/6.1.1/Racket v6.1.1/collects/racket/private/misc.rkt:87:7