2016/01/28
SICP 問題 5.11-b
;;; stackに退避するときにレジスタを指定しておき,そのレジスタにresotre出来るように修正する.
(define (make-restore inst machine stack pc)
(let ((reg (get-register machine
(stack-inst-reg-name inst))))
(lambda ()
(let ((val (pop stack)))
;; valのcarにregisterが入っているので呼び出し側のregと比較し#fならエラーを返す
(cond ((eq? reg (car val))
(set-contents! reg (cdr val))
(advance-pc pc))
(else
(error "RESTORE require the same register as save, but" reg)))))))
(define (make-save inst machine stack pc)
(let ((reg (get-register machine
(stack-inst-reg-name inst))))
(lambda ()
(push stack (cons reg (get-contents reg))) ;regも一緒にconsする.
(advance-pc pc))))
ex5.11-aで作ったfib-machineでテスト.これは失敗してほしい.
(define fib-machine
(make-machine
'(n val continue)
(list (list '< <) (list '- -) (list '+ +))
'(controller
(assign continue (label fib-done))
fib-loop
(test (op <) (reg n) (const 2))
(branch (label immediate-answer))
(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)
(assign n (op -) (reg n) (const 2))
(assign continue (label afterfib-n-2))
(save val)
(goto (label fib-loop))
afterfib-n-2
(restore n)
(restore continue)
(assign val
(op +) (reg val) (reg n))
(goto (reg continue))
immediate-answer
(assign val (reg n))
(goto (reg continue))
fib-done)))
gosh> (set-register-contents! fib-machine 'n 10)
done
gosh> (start fib-machine)
*** ERROR: operation - is not defined between (#<closure (make-register dispatch)> ((restore n) . #<closure (make-restore make-restore)>) ((assign n (op -) (reg n) (const 2)) . #<closure (make-assign make-assign)>) ((assign continue (label afterfib-n-2)) . #<closure (make-assign make-assign)>) ((save val) . #<closure (make-save make-save)>) ((goto (label fib-loop)) . #<closure (make-goto make-goto)>) ((restore n) . #<closure (make-restore make-restore)>) ((restore continue) . #<closure (make-restore make-restore)>) ((assign val (op +) (reg val) (reg n)) . #<closure (make-assign make-assign)>) ((goto (reg continue)) . #<closure (make-goto make-goto)>) ((assign val (reg n)) . #<closure (make-assign make-assign)>) ((goto (reg continue)) . #<closure (make-goto make-goto)>)) and 2
Stack Trace:
_______________________________________
0 (value-proc)
At line 341 of "/Users//work/scheme/SICP/5.2.scm"
1 (set-contents! target (value-proc))
At line 341 of "/Users//work/scheme/SICP/5.2.scm"
2 ((instruction-execution-proc (car insts)))
At line 444 of "(standard input)"
3 (eval expr env)
At line 179 of "/usr/local/Cellar/gauche/0.9.4/share/gauche-0.9/0.9.4/lib/gauche/interactive.scm"
ex5.06で作ったfib-machine2.これは成功してほしい.
(define fib-machine2
(make-machine
'(n val continue)
(list (list '< <) (list '- -) (list '+ +))
'(controller
(assign continue (label fib-done))
fib-loop
(test (op <) (reg n) (const 2))
(branch (label immediate-answer))
(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)
(assign n (op -) (reg n) (const 2))
(assign continue (label afterfib-n-2))
(save val)
(goto (label fib-loop))
afterfib-n-2
(assign n (reg val)) ;ここを消して
(restore val) ;ここで(restore n)
(restore continue)
(assign val
(op +) (reg val) (reg n))
(goto (reg continue))
immediate-answer
(assign val (reg n))
(goto (reg continue))
fib-done)))
gosh> (set-register-contents! fib-machine2 'n 10)
done
gosh> (start fib-machine2)
done
gosh> (get-register-contents fib-machine2 'val)
55