Chapter 5, Computing with Register Machines
Exercise 5.49
We need to create a machine that calls compiler internally and assembles the intructions and load them in the same assembler.
Like in the last exercise, i created a procedure compile-and-assemble which returns the compiled and assembled version of the intructions. Note that here we used compiler-machine created for this exercise instead of eceval compared to last exercise.
And now, we just need to add the operatons which are required by:
- Instructions generated by the compiler for eg:
extend-environment,set-variable!etc are used in the instructions generated by compiler. - By the
compiler-machineitself, for printing or reading from the prompt likeread,user-printetc.
In the machine’s controller code, we just call the compile-and-assemble and set these results in val and execute them by jumping to val.
For return, we set the continue register to so that we are back to the loop.
One more thing, since we do not need to invoke procedures from the evaluator - which was required in previous exercise 5.47 and 5.48 - we should disable the code generated from calling the procedures generated by evaluator. Thus i reverted the changes in procedure compile-procedure-call which were done as part of ex-5.47.
Created a new file ch5-compiler-machine.scm which contains the above mentioned 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
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
(load "ch5-compiler")
(load "ch5-regsim")
(load "ch5-eceval-support")
(define the-global-environment (setup-environment))
(define (prompt-for-input string)
(newline) (newline) (display string) (newline))
(define (announce-output string)
(newline) (display string) (newline))
;; Modification of section 4.1.4 procedure
;; **replaces version in syntax file
(define (user-print object)
(cond ((compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>)))
((compiled-procedure? object)
(display '<compiled-procedure>))
(else (display object))))
(define (compile-and-assemble expression)
(assemble (statements
(compile expression 'val 'return the-empty-cenv))
compiler-machine))
(define compiler-operations
(list
;;primitive Scheme operations
(list 'read read)
(list 'list list)
(list 'cons cons)
(list 'compile-and-assemble compile-and-assemble)
;;operations in eceval-support.scm
(list 'false? false?)
(list 'extend-environment extend-environment)
(list 'lookup-variable-value lookup-variable-value)
(list 'set-variable-value! set-variable-value!)
(list 'define-variable! define-variable!)
(list 'primitive-procedure? primitive-procedure?)
(list 'apply-primitive-procedure apply-primitive-procedure)
(list 'prompt-for-input prompt-for-input)
(list 'announce-output announce-output)
(list 'user-print user-print)
(list 'get-global-environment get-global-environment)
;;for compiled code (also in eceval-support.scm)
(list 'make-compiled-procedure make-compiled-procedure)
(list 'compiled-procedure? compiled-procedure?)
(list 'compiled-procedure-entry compiled-procedure-entry)
(list 'compiled-procedure-env compiled-procedure-env)
;;for open-code ex-5.38
(list 'lexical-address-lookup lexical-address-lookup)
(list 'lexical-address-set! lexical-address-set!)
;;added few operations for testing ex-5.38 as machine intructions
(list '+ +)
(list '= =)
(list '- -)
(list '* *)
(list '< <)))
(define compiler-machine
(make-machine
'(exp env val proc argl continue unev
arg1 arg2
)
compiler-operations
'(
read-compile-execute-print-loop
(perform (op initialize-stack))
(perform
(op prompt-for-input) (const ";;; RCEPL input:"))
(assign exp (op read))
(assign val (op compile-and-assemble) (reg exp))
(assign env (op get-global-environment))
(assign continue (label print-result))
(goto (reg val))
print-result
;;**following instruction optional -- if use it, need monitored stack
(perform (op print-stack-statistics))
(perform
(op announce-output) (const ";;; RECEPL value:"))
(perform (op user-print) (reg val))
(goto (label read-compile-execute-print-loop)))))
Example/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
47
48
49
50
51
52
53
54
55
56
1 ]=> (start compiler-machine)
;;; RCEPL input:
(define (factorial n)
(if (= n 1)
1
(* (factorial (- n 1)) n)))
(total-pushes = 0 maximum-depth = 0)
;;; RECEPL value:
ok
;;; RCEPL input:
(factorial 5)
(total-pushes = 8 maximum-depth = 8)
;;; RECEPL value:
120
;;; RCEPL input:
(+ 5 3)
(total-pushes = 0 maximum-depth = 0)
;;; RECEPL value:
8
;;; RCEPL input:
(define x 100)
(total-pushes = 0 maximum-depth = 0)
;;; RECEPL value:
ok
;;; RCEPL input:
(set! x (+ x 10))
(total-pushes = 0 maximum-depth = 0)
;;; RECEPL value:
ok
;;; RCEPL input:
(factorial 10)
(total-pushes = 18 maximum-depth = 18)
;;; RECEPL value:
3628800
;;; RCEPL input:
(if (null? '()) 'null-testing (cons 'cons 'testing))
(total-pushes = 2 maximum-depth = 2)
;;; RECEPL value:
null-testing
;;; RCEPL input: