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