Chapter 5, Computing with Register Machines
Exercise 5.11
(a)
These two lines under label afterfib-n-2
:
1
2
(assign n (reg val)) ; n now contains Fib(n - 2)
(restore val) ; val now contains Fib(n - 1)
..can be replaced by a single line:
1
(restore n)
(b)
Here are the changes:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
(define (make-save inst machine stack pc)
(let ((reg-name (stack-inst-reg-name inst)))
(let ((reg (get-register machine
reg-name)))
(lambda ()
(push stack (cons reg-name
(get-contents reg)))
(advance-pc pc)))))
(define (make-restore inst machine stack pc)
(let ((reg-name (stack-inst-reg-name inst)))
(let ((reg (get-register machine reg-name)))
(lambda ()
(if (eq? reg-name (car (top stack)))
(begin (set-contents! reg (cdr (pop stack)))
(advance-pc pc))
(error "Reg at stack top and Reg restored are not equal!"
reg-name
(car (top stack))))))))
;; install a new procedure top in stack
;;inside stack add top in dispatch:
(define (dispatch message)
(cond ((eq? message 'push) push)
((eq? message 'pop) (pop))
((eq? message 'top) (car s))
((eq? message 'initialize) (initialize))
((eq? message 'print-statistics)
(print-statistics))
(else
(error "Unknown request -- STACK" message))))
(define (top stack)
(stack 'top))
Output:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
1 ]=>
(define temp-machine
(make-machine
'(a b)
'()
'((assign a (const 100))
(assign b (const 200))
(save a)
(save b)
(restore b)
(restore b))))
;;last line should produce error because element at top of
;;stack is from reg a but we are reading it in reg b.
;Value 11: (register simulator loaded)
1 ]=>
;Value: temp-machine
1 ]=> (start temp-machine)
;Reg at stack top and Reg restored are not equal! b a
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.
2 error>
(c)
Changes are marked with ;;;
. I created stacks for pc
and flag
too. Well, these stacks are not required, added them mindlessly :)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(the-instruction-sequence '()))
(let ((stacks (list (list 'pc (make-stack)) ;;;
(list 'flag (make-stack))))) ;;;
(let ((the-ops
(list (list 'initialize-stack
(lambda () (map (lambda(stack)
(stack 'initialize))
stacks)))
;;**next for monitored stack (as in section 5.2.4)
;; -- comment out if not wanted
(list 'print-stack-statistics
(lambda () (map (lambda(stack)
(stack 'print-statistics))
stacks)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(begin
(set! register-table
(cons (list name (make-register name))
register-table))
(set! stacks ;;;
(cons (list name (make-stack)) ;;;
stacks)))) ;;;
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
((instruction-execution-proc (car insts)))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stacks) ;;;renamed stacks
((eq? message 'operations) the-ops)
(else (error "Unknown request -- MACHINE" message))))
dispatch))))
;;new procedure
(define (get-stack stacks reg-name)
(let ((stack (assoc reg-name stacks)))
(if stack
(cadr stack)
(error "Can not find stack for reg:" reg-name))))
;; modified restore and save
(define (make-save inst machine stacks pc)
(let ((reg-name (stack-inst-reg-name inst)))
(let ((reg (get-register machine
reg-name)))
(lambda ()
(push (get-stack stacks reg-name) ;;;
(get-contents reg))
(advance-pc pc)))))
(define (make-restore inst machine stacks pc)
(let ((reg-name (stack-inst-reg-name inst)))
(let ((reg (get-register machine reg-name)))
(lambda ()
(set-contents! reg (pop (get-stack stacks reg-name))) ;;;
(advance-pc pc)))))
Output:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
;;example, i used in part (b) now gives different error as expected.
1 ]=>
(define temp-machine
(make-machine
'(a b)
'()
'((assign a (const 100))
(assign b (const 200))
(save a)
(save b)
(restore b)
(restore b))))
;Value 14: (register simulator loaded)
1 ]=>
;Value: temp-machine
1 ]=> (start temp-machine)
;Empty stack -- POP
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.
2 error> (restart 1)
1 ]=>
(define temp-machine
(make-machine
'(a b)
'()
'((assign a (const 100))
(assign b (const 200))
(save b)
(save a)
(save b)
(restore b)
(restore b))))
;Value: temp-machine
1 ]=> (start temp-machine)
;Value: done
1 ]=>