Exercise 5.11. When we introduced save and restore in section 5.1.4, we didn’t specify what would happen if you tried to restore a register that was not the last one saved, as in the sequence
(save y)
(save x)
(restore y)There are several reasonable possibilities for the meaning of restore:
a. (restore y) puts into y the last value saved on the stack, regardless of what register that value came from. This is the way our simulator behaves. Show how to take advantage of this behavior to eliminate one instruction from the Fibonacci machine of section 5.1.4 (figure 5.12).
b. (restore y) puts into y the last value saved on the stack, but only if that value was saved from y; otherwise, it signals an error. Modify the simulator to behave this way. You will have to change save to put the register name on the stack along with the value.
c. (restore y) puts into y the last value saved from y regardless of what other registers were saved after y and not restored. Modify the simulator to behave this way. You will have to associate a separate stack with each register. You should make the initialize-stack operation initialize all the register stacks.
a
我们再看看这段代码
(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)
在计算完 (fib (- n 2)) 的时候，val 存了计算的结果，并且我们开始做 (+ (fib (- n 1)) (fib (- n 2)))，看看 afterfib-n-2 是怎么做的？
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))
把 fib(n-2) 的返回值从 val 复制给 n，然后获取 Fib(n-1) 的值给 val，然后两个相加作为当前的返回值。我们没有必要这样交换，直接改为
afterfib-n-2 ; upon return, val contains Fib(n - 2)
(restore n) ; val now contains Fib(n - 2), restore Fib(n-1) into n
(restore continue)
(assign val ; Fib(n - 1) + Fib(n - 2)
(op +) (reg val) (reg n))
(define test-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)
(restore n)
(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))
(define test-machine
(make-machine
'(n continue val)
(list (list '< <)
(list '- -)
(list '+ +))
test-controller))
(define (fib n)
(if (< n 2)
n
(+ (fib (- n 1)) (fib (- n 2)))))
(set-register-contents! test-machine 'n 10)
(start test-machine)
(assert= (get-register-contents test-machine 'val)
(fib 10))b
我们只需要修改 assemble 模块的 (save <register-name>) 和 (store <register-name>) ，在 push 时加入 register name， pop 之后判断当前的 register name 是否和 push 时候一致就可以。
测试用例我们使用 a 问修改过的 Fib。
(load "machine-stack-module.scm")
(load "machine-register-module.scm")
(load "machine-machine-module.scm")
(load "machine-assemble-module.scm")
; (save <register-name>) needs to save contents as well as register
; name on the stack.
(define (make-register-info name contents)
(cons name contents))
(define (get-register-info-name info)
(car info))
(define (get-register-info-contents info)
(cdr info))
(define (make-save inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let ((reg-info (make-register-info name (get-contents reg))))
(push stack reg-info)
(advance-pc pc)))))
(define (make-restore inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let* ((reg-info (pop stack))
(name-on-stack (get-register-info-name reg-info)))
(cond ((not (eq? name-on-stack name))
(error 'make-restore
"Invalid restore argument-- STORE " name))
(else
(set-contents! reg (get-register-info-contents reg-info))
(advance-pc pc)))))))
;; test b
(define test-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)
(restore n) ;; Invalid argument!
(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))
(define test-machine
(make-machine
'(n continue val)
(list (list '< <)
(list '- -)
(list '+ +))
test-controller))
(set-register-contents! test-machine 'n 10)
(assert/exn (start test-machine) "Invalid")c
我们需要修改的是 machine module 和 assemble module 中的 save restore 。
在每一个 machine 被分配的时候，我们需要为每一个 register 分配相应的 stack。然后初始化每一个 stack。
(define (make-new-machine regs)
; associate stack for each regs
(let ((stacks (map (lambda (reg) (cons reg (make-stack))) regs))
(flag (make-register))
(pc (make-register))
(the-instruction-sequence '()))
(let ((regs (list (cons 'pc pc)
(cons 'flag flag)))
;
(the-ops
(list (list 'initialize-stack
(lambda ()
(map (lambda (stk) (stk 'initialize)) stacks))))))
; Part1 ends
(define (allocate-register name)
(if (assoc name regs)
(error 'machine "register exists: " name)
(set! regs (cons (cons name (make-register)) regs)))
'register-allocated)
(define (lookup-register name)
(let ((r (assoc name regs)))
(if r
(cdr r)
(error 'machine "Unknown register: " name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
((instruction-execution-proc (car insts)))
(execute)))))
(define (dispatch msg)
(cond ((eq? msg 'allocate-register) allocate-register)
((eq? msg 'lookup-register) lookup-register)
((eq? msg 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? msg 'stack) stacks)
((eq? msg 'operations) the-ops)
((eq? msg 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? msg 'start)
(set-contents! pc the-instruction-sequence)
(execute))
(else
(error 'machine "Unknown message: " msg))))
dispatch)))
; Part2
(define (make-machine regs ops controller-text)
(let ((machine (make-new-machine regs))) ; pass regs for stack init
(for-each (lambda (name)
((machine 'allocate-register) name))
regs)
((machine 'install-operations) ops)
((machine 'install-instruction-sequence)
(assemble controller-text machine))
machine))
; Part2 ends
; Part3
;; change machine-assemble-module.scm
(define (make-save inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let* ((stk (assoc name stack))) ; no need to have run time checking
(begin
(push (cdr stk) (get-contents reg))
(advance-pc pc))))))
(define (make-restore inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let ((stk (assoc name stack)))
(set-contents! reg (pop (cdr stk)))
(advance-pc pc)))))
; Part3 ends
;; tests begin
(define test-controller
'((save x)
(save y)
(save z)
(assign x (const -1))
(assign y (const -1))
(assign z (const -1))
(restore y)
(restore x)
(restore z)))
(define test-machine
(make-machine
'(x y z)
(list (list))
test-controller))
(set-register-contents! test-machine 'x 1)
(set-register-contents! test-machine 'y 2)
(set-register-contents! test-machine 'z 3)
(start test-machine)
(assert= (get-register-contents test-machine 'x) 1)
(assert= (get-register-contents test-machine 'y) 2)
(assert= (get-register-contents test-machine 'z) 3)
因为我们修改了 make-new-machine 的接口，所以我们需要更改 make-machine （注意我们把以前的 stack 变成了一个 associate list–stacks ）
(define (make-machine regs ops controller-text)
(let ((machine (make-new-machine regs))) ; pass regs for stack init
(for-each (lambda (name)
((machine 'allocate-register) name))
regs)
((machine 'install-operations) ops)
((machine 'install-instruction-sequence)
(assemble controller-text machine))
machine))现在我们模块之间传递的就是 stacks ，记录着哪个 register 对应于哪个 stack。
然后修改 save 和 restore 。push 和 pop 之前需要找到 register 对应的 stack。
;; change machine-assemble-module.scm
(define (make-save inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let* ((stk (assoc name stack))) ; no need to have run time checking
(begin
(push (cdr stk) (get-contents reg))
(advance-pc pc))))))
(define (make-restore inst machine stack pc)
(let* ((name (stack-inst-reg-name inst))
(reg (get-register machine name)))
(lambda ()
(let ((stk (assoc name stack)))
(set-contents! reg (pop (cdr stk)))
(advance-pc pc)))))完成。最后是测试。
(define test-controller
'((save x)
(save y)
(save z)
(assign x (const -1))
(assign y (const -1))
(assign z (const -1))
(restore y)
(restore x)
(restore z)))
(define test-machine
(make-machine
'(x y z)
(list (list))
test-controller))
(set-register-contents! test-machine 'x 1)
(set-register-contents! test-machine 'y 2)
(set-register-contents! test-machine 'z 3)
(start test-machine)
(assert= (get-register-contents test-machine 'x) 1)
(assert= (get-register-contents test-machine 'y) 2)
(assert= (get-register-contents test-machine 'z) 3)