Chapter 5, Computing with Register Machines

Exercise 5.10


Well, new syntax can also just mean to rename the syntax for eg: instead of the name assign we may have set. This is quite trivial and perhaps the point of the exercise is same that because of abstraction we can indeed change the syntax without impacting the non-syntax procedures.

Another way is to create new syntax in the existing evaluator which might not be available before. I implemented the new expression (add <r1> <r2> <r3>). This expression adds the values in r1 and r2 and puts the sum in r3.

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
(define (make-add inst machine pc)
  (let ((first (get-register machine (add-first-reg-name inst)))
		(second (get-register machine (add-second-reg-name inst)))
		(rs (get-register machine (add-result-reg-name inst))))
	(lambda ()
	  (set-contents! rs (+ (get-contents first)
						   (get-contents second)))
	  (advance-pc pc))))

(define (add-first-reg-name inst)
  (cadr inst))

(define (add-second-reg-name inst)
  (caddr inst))

(define (add-result-reg-name inst)
  (car (cdddr inst)))

;;add in main procedure
(define (make-execution-procedure inst labels machine
                                  pc flag stack ops)
  (cond ((eq? (car inst) 'assign)
         (make-assign inst machine labels ops pc))
        ((eq? (car inst) 'add)
         (make-add inst machine pc))
        ((eq? (car inst) 'test)
         (make-test inst machine labels ops flag pc))
        ((eq? (car inst) 'branch)
         (make-branch inst machine labels flag pc))
        ((eq? (car inst) 'goto)
         (make-goto inst machine labels pc))
        ((eq? (car inst) 'save)
         (make-save inst machine stack pc))
        ((eq? (car inst) 'restore)
         (make-restore inst machine stack pc))
        ((eq? (car inst) 'perform)
         (make-perform inst machine labels ops pc))
        (else (error "Unknown instruction type -- ASSEMBLE"
                     inst))))

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
1 ]=>
(define temp-machine
  (make-machine
   '(a b c)
   '()
   '(
	 (add a b c))))

;Value 10: (register simulator loaded)

1 ]=> 
;Value: temp-machine

1 ]=> (set-register-contents! temp-machine 'a 10)

;Value: done

1 ]=> (set-register-contents! temp-machine 'b 100)

;Value: done

1 ]=> (start temp-machine)

;Value: done

1 ]=> (get-register-contents temp-machine 'c)

;Value: 110

1 ]=>