SICP Solutions

Chapter 5, Computing with Register Machines

Exercise 5.47

May 12, 2018

Interesting!

Few points how it will work by using the example suggested for testing(compiled f calls interpreted g):

When f is compiled, it creates a compiled procedure and stores it in env.
Since f contains a call to g, the compiled procedure will also contain instructions to invoke g which required first to lookup g and store the result of lookup in proc.
Then compiled procedure will contain instructions to evaluate all the arguments of g and place those arguments in argl.
Now, let’s talk about evaluator. When g is evaluated/interpreted, it also gets stored in the same env. Thus the instructions generated by compiler to lookup g will now return the procedure g!
How evaluator invokes a compund procedure? It starts from entry point compound-apply, and at that point, reg proc should contain the required procedure to be evaluated and arguments should be in argl.
Well, this has already been done by the instructions generated by compiler for invoking g.
So, what’s the missing piece? Just two things: (i) how to transfer the control to evaluator from compiler and then (ii) how to return back to the compiler intructions after procedure gets executed by the evaluator instructions.
For (i), while calling the procedure in the compiler, we just have to do one more test apart from the existing test of primitive-procedure?, now we also check for compound-procedure? and jump to the code for calling compound procedure. As suggested in the exercise we jump to the location compound-apply stored in compapp.
For (ii), We use continue for return. We know that evaluator expects that while in compound-apply the place to return is stored on top of the stack. So we just need to save the place where we have to return on top of the stack! This can be done by writing a parallel a new procedure, say compound-proc-appl similar to compiled-proc-appl. And for each of the cases we save the register where we have to return on top of the stack!

That’s it!

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
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
(define (compile-procedure-call target linkage)
  (let ((primitive-branch (make-label 'primitive-branch))
        (compiled-branch (make-label 'compiled-branch))               
        (compound-branch (make-label 'compound-branch))                 ;;;
        (after-call (make-label 'after-call)))
    (let ((compiled-or-compound-linkage
           (if (eq? linkage 'next) after-call linkage)))
      (append-instruction-sequences
       (make-instruction-sequence '(proc) '()
        `((test (op primitive-procedure?) (reg proc))
          (branch (label ,primitive-branch))))
       (parallel-instruction-sequences
		(append-instruction-sequences                                   ;;;
		 (make-instruction-sequence '(proc) '()                         ;;;
		  `((test (op compound-procedure?) (reg proc))                  ;;;
			(branch (label ,compound-branch))))                         ;;;
		 (parallel-instruction-sequences                                ;;;
		  (append-instruction-sequences                                 ;;;
           compiled-branch                                              ;;;
           (compile-proc-appl target compiled-or-compound-linkage))     ;;;
		  (append-instruction-sequences                                 ;;;
		   compound-branch                                              ;;;
		   (compound-proc-appl target compiled-or-compound-linkage))))  ;;;
        (append-instruction-sequences
         primitive-branch
         (end-with-linkage linkage
          (make-instruction-sequence '(proc argl)
                                     (list target)
           `((assign ,target
                     (op apply-primitive-procedure)
                     (reg proc)
                     (reg argl)))))))
       after-call))))


;;;new procedure
;;;applying compound procedures

(define (compound-proc-appl target linkage)
  (cond ((and (eq? target 'val) (not (eq? linkage 'return)))
         (make-instruction-sequence '(proc) all-regs
			`((assign continue (label ,linkage))
			  (save continue)
             (goto (reg compapp)))))
        ((and (not (eq? target 'val))
              (not (eq? linkage 'return)))
         (let ((proc-return (make-label 'proc-return)))
           (make-instruction-sequence '(proc) all-regs
            `((assign continue (label ,proc-return))
			  (save continue)
			  (goto (reg compapp))
              ,proc-return
              (assign ,target (reg val))
              (goto (label ,linkage))))))
        ((and (eq? target 'val) (eq? linkage 'return))
         (make-instruction-sequence '(proc continue) all-regs
          '((save continue)
			(goto (reg compapp)))))
        ((and (not (eq? target 'val)) (eq? linkage 'return))
         (error "return linkage, target not val -- COMPILE"
                target))))

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
1 ]=> (compile-and-go '(define (f x) (g x)))

(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(define (g x) x)

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(f 'hello)

(total-pushes = 6 maximum-depth = 3)
;;; EC-Eval value:
hello

;;; EC-Eval input:
(define (g x) 'ignored-x)

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(f 'hello)

(total-pushes = 6 maximum-depth = 3)
;;; EC-Eval value:
ignored-x

;;; EC-Eval input:
(define (g x) (+ x 100))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(f 2)

(total-pushes = 14 maximum-depth = 5)
;;; EC-Eval value:
102

;;; EC-Eval input:

Comments

It’s amazing to see this inter-operatibility. The evaluator was already designed/setup with this in mind that things won’t get in conflict with compiler and the two can even co-exist together and can even invoke procedures from each other.