Chapter 5, Computing with Register Machines

Exercise 5.37


Changed code of preserving:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
(define (preserving regs seq1 seq2)
  (if (null? regs)
      (append-instruction-sequences seq1 seq2)
      (let ((first-reg (car regs)))
        (preserving (cdr regs)
					(make-instruction-sequence
					 (list-union (list first-reg)
								 (registers-needed seq1))
					 (list-difference (registers-modified seq1)
									  (list first-reg))
					 (append `((save ,first-reg))
							 (statements seq1)
							 `((restore ,first-reg))))
					seq2))))

Example 1 (compile '(+ 1 2 3) 'val 'next)

Note that with preserve no stack operations are generated!

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
|---------------------------------------------|----------------------------------------------|
| Without Preserve                            | With Preserve                                |
|---------------------------------------------|----------------------------------------------|
| ((env continue)                             | ((env)                                       |
| (env proc argl continue val)                | (env proc argl continue val)                 |
| (                                           | (                                            |
| (save continue)                             | (assign proc                                 |
| (save env)                                  | (op lookup-variable-value)                   |
| (save continue)                             | (const +)                                    |
| (assign proc                                | (reg env))                                   |
| (op lookup-variable-value)                  | (assign val (const 3))                       |
| (const +) (reg env))                        | (assign argl (op list) (reg val))            |
| (restore continue)                          | (assign val (const 2))                       |
| (restore env)                               | (assign argl (op cons) (reg val) (reg argl)) |
| (restore continue)                          | (assign val (const 1))                       |
| (save continue)                             | (assign argl (op cons) (reg val) (reg argl)) |
| (save proc)                                 | (test (op primitive-procedure?) (reg proc))  |
| (save env)                                  | (branch (label primitive-branch3))           |
| (save continue)                             | compiled-branch2                             |
| (assign val (const 3))                      | (assign continue (label after-call1))        |
| (restore continue)                          | (assign val                                  |
| (assign argl (op list) (reg val))           | (op compiled-procedure-entry)                |
| (restore env)                               | (reg proc))                                  |
| (save env)                                  | (goto (reg val))                             |
| (save argl)                                 | primitive-branch3                            |
| (save continue)                             | (assign val                                  |
| (assign val (const 2))                      | (op apply-primitive-procedure)               |
| (restore continue)                          | (reg proc)                                   |
| (restore argl)                              | (reg argl))                                  |
| (assign argl                                | after-call1))                                |
| (op cons)                                   |                                              |
| (reg val) (reg argl))                       |                                              |
| (restore env)                               |                                              |
| (save argl)                                 |                                              |
| (save continue)                             |                                              |
| (assign val (const 1))                      |                                              |
| (restore continue)                          |                                              |
| (restore argl)                              |                                              |
| (assign argl                                |                                              |
| (op cons)                                   |                                              |
| (reg val)                                   |                                              |
| (reg argl))                                 |                                              |
| (restore proc)                              |                                              |
| (restore continue)                          |                                              |
| (test (op primitive-procedure?) (reg proc)) |                                              |
| (branch (label primitive-branch3))          |                                              |
| compiled-branch2                            |                                              |
| (assign continue (label after-call1))       |                                              |
| (assign val                                 |                                              |
| (op compiled-procedure-entry)               |                                              |
| (reg proc))                                 |                                              |
| (goto (reg val))                            |                                              |
| primitive-branch3                           |                                              |
| (save continue)                             |                                              |
| (assign val                                 |                                              |
| (op apply-primitive-procedure)              |                                              |
| (reg proc)                                  |                                              |
| (reg argl))                                 |                                              |
| (restore continue)                          |                                              |
| after-call1))                               |                                              |
|---------------------------------------------|----------------------------------------------|

Example 2 (compile '(+ 1 (+ 2 3) 4) 'val 'next)

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|---------------------------------------------|---------------------------------------------|
| Without Preserve                            | With Preserve                               |
|---------------------------------------------|---------------------------------------------|
| ((env continue)                             | ((env) (env proc argl continue val)         |
| (env proc argl continue val)                | (                                           |
| (                                           | (assign proc                                |
| (save continue)                             | (op lookup-variable-value)                  |
| (save env)                                  | (const +)                                   |
| (save continue)                             | (reg env))                                  |
| (assign proc                                | (save proc)                                 |
| (op lookup-variable-value)                  | (assign val (const 4))                      |
| (const +)                                   | (assign argl (op list) (reg val))           |
| (reg env))                                  | (save argl)                                 |
| (restore continue)                          | (assign proc                                |
| (restore env)                               | (op lookup-variable-value)                  |
| (restore continue)                          | (const +)                                   |
| (save continue)                             | (reg env))                                  |
| (save proc)                                 | (assign val (const 3))                      |
| (save env)                                  | (assign argl (op list) (reg val))           |
| (save continue)                             | (assign val (const 2))                      |
| (assign val (const 4))                      | (assign argl                                |
| (restore continue)                          | (op cons)                                   |
| (assign argl (op list) (reg val))           | (reg val)                                   |
| (restore env)                               | (reg argl))                                 |
| (save env)                                  | (test (op primitive-procedure?) (reg proc)) |
| (save argl)                                 | (branch (label primitive-branch6))          |
| (save continue)                             | compiled-branch5                            |
| (save env)                                  | (assign continue (label after-call4))       |
| (save continue)                             | (assign val                                 |
| (assign proc                                | (op compiled-procedure-entry)               |
| (op lookup-variable-value)                  | (reg proc))                                 |
| (const +)                                   | (goto (reg val))                            |
| (reg env))                                  | primitive-branch6                           |
| (restore continue)                          | (assign val                                 |
| (restore env)                               | (op apply-primitive-procedure)              |
| (restore continue)                          | (reg proc)                                  |
| (save continue)                             | (reg argl))                                 |
| (save proc)                                 | after-call4                                 |
| (save env)                                  | (restore argl)                              |
| (save continue)                             | (assign argl                                |
| (assign val (const 3))                      | (op cons)                                   |
| (restore continue)                          | (reg val)                                   |
| (assign argl (op list) (reg val))           | (reg argl))                                 |
| (restore env)                               | (assign val (const 1))                      |
| (save argl)                                 | (assign argl                                |
| (save continue)                             | (op cons)                                   |
| (assign val (const 2))                      | (reg val)                                   |
| (restore continue)                          | (reg argl))                                 |
| (restore argl)                              | (restore proc)                              |
| (assign argl                                | (test (op primitive-procedure?) (reg proc)) |
| (op cons)                                   | (branch (label primitive-branch9))          |
| (reg val)                                   | compiled-branch8                            |
| (reg argl))                                 | (assign continue (label after-call7))       |
| (restore proc)                              | (assign val                                 |
| (restore continue)                          | (op compiled-procedure-entry)               |
| (test (op primitive-procedure?) (reg proc)) | (reg proc))                                 |
| (branch (label primitive-branch6))          | (goto (reg val))                            |
| compiled-branch5                            | primitive-branch9                           |
| (assign continue (label after-call4))       | (assign val                                 |
| (assign val                                 | (op apply-primitive-procedure)              |
| (op compiled-procedure-entry)               | (reg proc)                                  |
| (reg proc))                                 | (reg argl))                                 |
| (goto (reg val))                            | after-call7))                               |
| primitive-branch6                           |                                             |
| (save continue)                             |                                             |
| (assign val                                 |                                             |
| (op apply-primitive-procedure)              |                                             |
| (reg proc)                                  |                                             |
| (reg argl))                                 |                                             |
| (restore continue)                          |                                             |
| after-call4                                 |                                             |
| (restore argl)                              |                                             |
| (assign argl                                |                                             |
| (op cons)                                   |                                             |
| (reg val)                                   |                                             |
| (reg argl))                                 |                                             |
| (restore env)                               |                                             |
| (save argl)                                 |                                             |
| (save continue)                             |                                             |
| (assign val (const 1))                      |                                             |
| (restore continue)                          |                                             |
| (restore argl)                              |                                             |
| (assign argl                                |                                             |
| (op cons)                                   |                                             |
| (reg val)                                   |                                             |
| (reg argl))                                 |                                             |
| (restore proc)                              |                                             |
| (restore continue)                          |                                             |
| (test (op primitive-procedure?) (reg proc)) |                                             |
| (branch (label primitive-branch9))          |                                             |
| compiled-branch8                            |                                             |
| (assign continue (label after-call7))       |                                             |
| (assign val                                 |                                             |
| (op compiled-procedure-entry)               |                                             |
| (reg proc))                                 |                                             |
| (goto (reg val))                            |                                             |
| primitive-branch9                           |                                             |
| (save continue)                             |                                             |
| (assign val                                 |                                             |
| (op apply-primitive-procedure)              |                                             |
| (reg proc)                                  |                                             |
| (reg argl))                                 |                                             |
| (restore continue)                          |                                             |
| after-call7))                               |                                             |
|---------------------------------------------|---------------------------------------------|