SICP 読み (260) 5.2 レジスタ計算機での計算

直前エントリですが、_レジスタのアクセスに get-register でなく、その中の手続きを使って試験を書いている箇所が多すぎた_と書いている。さらに抽象的な get-register-contents なんてのがあるんだよなぁ、と。(恥
疲労困憊気味なんで、このところ色々な意味で微妙ッス。以下、微妙な記述が続きます。 (を

問題 5.12

ええと意味不明な部分があるので手動で fib な計算機の制御器を_大きい_ソレで書き換えてみる事に。
これを書き換えるのか ...

(controller
 (assign continue (label fib-done))
 fib-loop
  (test (op <) (reg n) (const 2))
  (branch (label immediate-answer))
  ;; set up to compute Fib(n - 1)
  (save continue)
  (assign continue (label afterfib-n-1))
  (save n)                           ; save old value of n
  (assign n (op -) (reg n) (const 1)); clobber n to n - 1
  (goto (label fib-loop))            ; perform recursive call
 afterfib-n-1                         ; upon return, val contains Fib(n - 1)
  (restore n)
  (restore continue)
  ;; set up to compute Fib(n - 2)
  (assign n (op -) (reg n) (const 2))
  (save continue)
  (assign continue (label afterfib-n-2))
  (save val)                         ; save Fib(n - 1)
  (goto (label fib-loop))
 afterfib-n-2                         ; upon return, val contains Fib(n - 2)
  (assign n (reg val))               ; n now contains Fib(n - 2)
  (restore val)                      ; val now contains Fib(n - 1)
  (restore continue)
  (assign val                        ;  Fib(n - 1) +  Fib(n - 2)
          (op +) (reg val) (reg n))
  (goto (reg continue))              ; return to caller, answer is in val
 immediate-answer
  (assign val (reg n))               ; base case:  Fib(n) = n
  (goto (reg continue))
 fib-done)

どう書くかなあ。命令を先頭から見ていきながら書いてみるか。

(data-paths
 (registers
 ((name continue)
  (buttons ((name cont<-done) (source (label fib-done)))))
 )
 (operations
 )
 )
(controller
 (cont<-done)
 )

これは label の値が代入されたってコトで goto が参照するだろう、と判断して良いのだろうか。あるいはここで格納されている手続きは_a list of all instructions, with duplicates removed, sorted by instruction type (assign, goto, and so on);_と見て保存しておくべきなのだろうか。
そのまま続けてみます。次は

(data-paths
 (registers
 ((name continue)
  (buttons ((name cont<-done) (source (label fib-done)))))
 )
 (operations
 ((name <)
  (inputs (reg n) (const 2)))
 )
 )
(controller
 (cont<-done)
 (test <)
 (branch (label immediate-answer))
 )

む。これって assemble する時じゃなくって assemble した結果な手続きの中で machine の中にデータを蓄積、という事なんだろうか。てー事は、こんなコトしても仕方ないのかなぁ。あるいは assemble の実際はケツから評価されていくのでこの方法は適当でない??

再検討着手

assemble 時だろう、と判断して言われた通りにリストを作ってみる事に。今回は試験駆動ではない形でヤッてみる事に。
誤読を恐れず以下にヤる事を列挙。

label 指定な命令 (branch, goto, assign) で使われた label の cdr なリスト
goto で使用したレジスタのリスト
stack に格納されたレジスタのリスト
レジスタに代入された右辺値のリスト (これは assign 限定で OK??)

machine にこれらの情報を格納するリストの定義とアクセサ手続きの定義が必要。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (the-instruction-sequence '())
	(list-of-inst '())
	(hold-entry-points '())
	(saved-of-restored '())
	(list-of-reg '()))

みたいな定義。あとは assemble の中で cons してあげればケツから手続きに変換されるはずなんで先頭から順、なリストになるはず。あと_without duplicates_なソレはリストを走査して equal? な要素が無ければ、という判断で良いのかなぁ。
ちょっとへろへろ気味なんで、イケてれば下書きを追記するかも。

続き

make-new-machine 手続きに上記の属性を追加した上で以下のアクセサを定義。

      (define (get-list-of-inst) list-of-inst)
      (define (get-hold-entry-points) hold-entry-points)
      (define (get-saved-or-restored) saved-or-restored)
      (define (get-list-of-reg) list-of-reg)
      (define (dup-element? x y)
	(define (dup-elem-iter l)
	  (cond ((null? l) #t)
		((equal? x (car l)) #f)
		(else
		 (dup-elem-iter (cdr l)))))
	(dup-elem-iter y))
      (define (set-list-of-inst l)
	(set! list-of-inst (cons l list-of-inst))
	'done)
      (define (set-hold-entry-points l)
	(if (dup-element? l hold-entry-points)
	    (set! hold-entry-points (cons l hold-entry-points)))
	'done)
      (define (set-saved-or-restored l)
	(if (dup-element? l saved-of-restored)
	    (set! saved-of-restored (cons l saved-of-restored)))
	'done)
      (define (set-list-of-reg l)
	(if (dup-element? l list-of-reg)
	    (set! list-of-reg (cons l list-of-reg)))
	'done)

で、以下のソレを評価器に吸わせてみた。

gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.8/lib")
gosh> (load "ch5-regsim")
#t
gosh> (define m (make-machine
          '(n continue val)
          (list (list '< <) (list '- -) (list '+ +))
          '(controller
            (assign continue (label fib-done))
            fib-loop
            (test (op <) (reg n) (const 2))
            (branch (label immediate-answer))
            ;; set up to compute Fib(n - 1)
            (save continue)
            (assign continue (label afterfib-n-1))
            (save n)
            (assign n (op -) (reg n) (const 1))
            (goto (label fib-loop))
            afterfib-n-1
            (restore n)
            (restore continue)
            ;; set up to compute Fib(n - 2)
            (assign n (op -) (reg n) (const 2))
            (save continue)
            (assign continue (label afterfib-n-2))
            (save val)
            (goto (label fib-loop))
            afterfib-n-2
            (assign n (reg val))
            (restore val)
            (restore continue)
            (assign val
                    (op +) (reg val) (reg n)) 
            (goto (reg continue))
            immediate-answer
            (assign val (reg n))
            (goto (reg continue))
            fib-done)))
m
gosh>

あ、assemble に盛り込むの忘れてたよ。(クソ馬鹿
話はここから始まるんだ。とほほほ。

続々

assign なラベルについては make-primitive-exp で補足可能。branch は基本的にラベル指定でないと NG な模様。goto もラベル指定の特定はできるな。
goto が使うレジスタの特定も楽勝。save も restore も同様。最後の assign な右辺値とゆーが一番ハードル高いのか。あ、make-assign の中の value-exp が右辺値かな。なら話は早いですな。
多分これで何とかなりそうなので、今日は早目に寝ます。