SICP 読み (250) 5.2 レジスタ計算機での計算
なんか年末までに 365 回とかになりそうな気もするなぁ。ってそりゃ良いのですが、直前エントリを投入する時には、単体試験は全部終了〜とか思っていたのですが、帰りのバスで本見てたら、未実施の試験がある事が判明。
- assemble
- extract-labels
- update-insts!
- make-machine
あたり。散々 UT で使ってるんだけどなぁ。現時点で良い試験を思いつかないので、練習問題の確認をしながら検討とゆー事にします。
確認の前に
とりあえず例示されているソレを評価器に吸わせてみる。
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.8/lib")
gosh> (load "ch5-regsim.scm")
#t
gosh> (define gcd-machine
(make-machine
'(a b t)
(list (list 'rem remainder) (list '= =))
'(test-b
(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)))
gcd-machine
gosh> (set-register-contents! gcd-machine 'a 206)
done
gosh> (set-register-contents! gcd-machine 'b 40)
done
gosh> (start gcd-machine)
done
gosh> (get-register-contents gcd-machine 'a)
2
gosh>一応動いている模様ですが、もう少し入力の手間を省きたいなぁ。
問題 5.2
問題の解から fact-machine を作る手続きは以下でしょうか。
(define fact-machine
(make-machine
'(c p t1 t2 n)
(list (list '> >) (list '+ +) (list '* *))
'(controller
(assign c (const 1))
(assign p (const 1))
test-b
(test (op >) (reg n) (reg c))
(branch (label factorial-done))
(assign t1 (op +) (reg c) (const 1))
(assign t2 (op *) (reg c) (reg p))
(assign c (reg t1))
(assign p (reg t2))
(goto (label test-b))
factorial-done)))これを吸わせてみます。n に数字をセットすりゃ良いはずだな。
gosh> (define fact-machine
(make-machine
'(c p t1 t2 n)
(list (list '> >) (list '+ +) (list '* *))
'(controller
(assign c (const 1))
(assign p (const 1))
test-b
(test (op >) (reg n) (reg c))
(branch (label factorial-done))
(assign t1 (op +) (reg c) (const 1))
(assign t2 (op *) (reg c) (reg p))
(assign c (reg t1))
(assign p (reg t2))
(goto (label test-b))
factorial-done)))
fact-machine
gosh> (set-register-contents! fact-machine 'n 3)
done
gosh> (start fact-machine)
done
gosh> (get-register-contents fact-machine 'p)
1
gosh>あら??もしかして不等号が逆ッスか?? (とほほほ
gosh> (define fact-machine
(make-machine
'(c p t1 t2 n)
(list (list '> >) (list '+ +) (list '* *))
'(controller
(assign c (const 1))
(assign p (const 1))
test-b
(test (op >) (reg c) (reg n))
(branch (label factorial-done))
(assign t1 (op +) (reg c) (const 1))
(assign t2 (op *) (reg c) (reg p))
(assign c (reg t1))
(assign p (reg t2))
(goto (label test-b))
factorial-done)))
fact-machine
gosh> (set-register-contents! fact-machine 'n 3)
done
gosh> (start fact-machine)
done
gosh> (get-register-contents fact-machine 'p)
6
gosh> (set-register-contents! fact-machine 'n 4)
done
gosh> (start fact-machine)
done
gosh> (get-register-contents fact-machine 'p)
24
gosh> (set-register-contents! fact-machine 'n 5)
done
gosh> (start fact-machine)
done
gosh> (get-register-contents fact-machine 'p)
120
gosh> いやはや。
問題 5.3
答えとして最終的に以下のリストが提示されている。
(controller test-b (assign t4 (op square) (reg g)) (assign t5 (op -) (reg t4) (reg g)) (assign t6 (op abs) (reg t5)) (test (op <) (reg t6) (constant 0.001)) (branch (label sqrt-done)) (assign t2 (op /) (reg x) (reg g)) (assign t3 (op +) (reg t2) (reg g)) (assign t1 (op /) (reg t3) (constant 2)) (assign g (reg t1)) (goto (label test-b)) sqrt-done)
これを手続きにするとどうなるか、というと
(define sqrt-machine
(make-machine
'(t1 t2 t3 t4 t5 t6 g x)
(list (list 'square (lambda (x) (* x x)))
(list '- -)
(list 'abs abs)
(list '/ /)
(list '< <)
(list '+ +))
'(test-b
(assign t4 (op square) (reg g))
(assign t5 (op -) (reg t4) (reg g))
(assign t6 (op abs) (reg t5))
(test (op <) (reg t6) (const 0.001))
(branch (label sqrt-done))
(assign t2 (op /) (reg x) (reg g))
(assign t3 (op +) (reg t2) (reg g))
(assign t1 (op /) (reg t3) (const 2))
(assign g (reg t1))
(goto (label test-b))
sqrt-done)))で、良いのかなぁ。ってか、解答コピペで手続き作ったらダウト満載。上記は適度に修正したものです。しかも不等号なソレがとても不安。
gosh> (define sqrt-machine
(make-machine
'(t1 t2 t3 t4 t5 t6 g x)
(list (list 'square (lambda (x) (* x x)))
(list '- -)
(list 'abs abs)
(list '/ /)
(list '< <)
(list '+ +))
'(test-b
(assign t4 (op square) (reg g))
(assign t5 (op -) (reg t4) (reg g))
(assign t6 (op abs) (reg t5))
(test (op <) (reg t6) (const 0.001))
(branch (label sqrt-done))
(assign t2 (op /) (reg x) (reg g))
(assign t3 (op +) (reg t2) (reg g))
(assign t1 (op /) (reg t3) (const 2))
(assign g (reg t1))
(goto (label test-b))
sqrt-done)))
sqrt-machine
gosh> (set-register-contents! sqrt-machine 'x 2)
done
gosh> (start sqrt-machine)
*** ERROR: operation * is not defined between *unassigned* and *unassigned*
Stack Trace:
_______________________________________
0 (map (lambda (p) (p)) aprocs)
At line 385 of "./ch5-regsim.scm"
1 value-proc
2 (set-contents! target (value-proc))
At line 258 of "./ch5-regsim.scm"
3 (instruction-execution-proc (car insts))
At line 139 of "./ch5-regsim.scm"
gosh> げ。ってか、g に 1.0 をセットしないと駄目なのかな??
gosh> (set-register-contents! sqrt-machine 'g 1.0) done gosh> (start sqrt-machine) done gosh> (get-register-contents sqrt-machine 'g) 1.0 gosh> (get-register-contents sqrt-machine 't6) 0.0 gosh>
これは不等号なソレが逆に違いないな。(とほほ
gosh> (define sqrt-machine
(make-machine
'(t1 t2 t3 t4 t5 t6 g x)
(list (list 'square (lambda (x) (* x x)))
(list '- -)
(list 'abs abs)
(list '/ /)
(list '> >)
(list '+ +))
'(test-b
(assign t4 (op square) (reg g))
(assign t5 (op -) (reg t4) (reg g))
(assign t6 (op abs) (reg t5))
(test (op >) (reg t6) (const 0.001))
(branch (label sqrt-done))
(assign t2 (op /) (reg x) (reg g))
(assign t3 (op +) (reg t2) (reg g))
(assign t1 (op /) (reg t3) (const 2))
(assign g (reg t1))
(goto (label test-b))
sqrt-done)))
sqrt-machine
gosh> (set-register-contents! sqrt-machine 'x 2)
done
gosh> (set-register-contents! sqrt-machine 'g 1.0)
done
gosh> (start sqrt-machine)
done
gosh> (get-register-contents sqrt-machine 't6)
0.75
gosh>は??
なんか上の手続きを見てみるになんか微妙じゃね??、と。とりあえず不等号は元のままで良いはず。てーか、手続きそのものが微妙に見えてきたぞ。ちょっと答えなエントリを確認してきます。
とほほ
大間違い。修正したのが以下。
(define sqrt-machine
(make-machine
'(t1 t2 t3 t4 t5 t6 g x)
(list (list 'square (lambda (x) (* x x)))
(list '- -)
(list 'abs abs)
(list '/ /)
(list '< <)
(list '+ +))
'(test-b
(assign t4 (op square) (reg g))
(assign t5 (op -) (reg t4) (reg x))
(assign t6 (op abs) (reg t5))
(test (op <) (reg t6) (const 0.001))
(branch (label sqrt-done))
(assign t2 (op /) (reg x) (reg g))
(assign t3 (op +) (reg t2) (reg g))
(assign t1 (op /) (reg t3) (const 2))
(assign g (reg t1))
(goto (label test-b))
sqrt-done)))これは呑んでヤッてるから、と言われても仕方がないソレだな。
gosh> (define sqrt-machine
(make-machine
'(t1 t2 t3 t4 t5 t6 g x)
(list (list 'square (lambda (x) (* x x)))
(list '- -)
(list 'abs abs)
(list '/ /)
(list '< <)
(list '+ +))
'(test-b
(assign t4 (op square) (reg g))
(assign t5 (op -) (reg t4) (reg x))
(assign t6 (op abs) (reg t5))
(test (op <) (reg t6) (const 0.001))
(branch (label sqrt-done))
(assign t2 (op /) (reg x) (reg g))
(assign t3 (op +) (reg t2) (reg g))
(assign t1 (op /) (reg t3) (const 2))
(assign g (reg t1))
(goto (label test-b))
sqrt-done)))
sqrt-machine
gosh> (set-register-contents! sqrt-machine 'x 2)
done
gosh> (set-register-contents! sqrt-machine 'g 1.0)
done
gosh> (start sqrt-machine)
done
gosh> (get-register-contents sqrt-machine 'x)
2
gosh> (get-register-contents sqrt-machine 'g)
1.4142156862745097
gosh> 最初に戻ってるんだよな。最初のソレが何故に失敗したのかは明日、このエントリ見ながら確認予定とゆー事で (を
腹立つ
原因は
(assign t5 (op -) (reg t4) (reg x))
だった模様。動作不良なバージョンでは
(assign t5 (op -) (reg t4) (reg g))
になっている。原因がなんであれ駄目すぎ。
