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-machine
itself, for printing or reading from the prompt likeread
,user-print
etc.
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: