SICP Solutions

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
1 ]=> 
(define expt-machine
  (make-machine
   '(n b val continue)
   (list (list '* *) (list '- -) (list '= =))
   '(
	 (assign continue (label done))
	 loop
	 (test (op =) (reg n) (const 0))
	 (branch (label base-case))
	 (save continue)
	 (assign continue (label after))
	 (assign n (op -) (reg n) (const 1))
	 (goto (label loop))
	 after
	 (restore continue)
	 (assign val (op *) (reg val) (reg b))
	 (goto (reg continue))
	 base-case
	 (assign val (const 1))   
	 (goto (reg continue))
	 done)))

;Value: expt-machine

1 ]=> 
(set-register-contents! expt-machine 'n 5)

;Value: done

1 ]=> 
(set-register-contents! expt-machine 'b 4)

;Value: done

1 ]=> (start expt-machine)

;Value: done

1 ]=> (get-register-contents expt-machine 'val)

;Value: 1024

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
1 ]=> 
(define expt-machine
  (make-machine
   '(n b product)
   (list (list '* *) (list '- -) (list '= =))
   '(
	 (assign product (const 1))
	 loop
	 (test (op =) (reg n) (const 0))
	 (branch (label done))
	 (assign n (op -) (reg n) (const 1))
	 (assign product (op *) (reg product) (reg b))
	 (goto (label loop))
	 done)))

;Value: expt-machine

1 ]=> (set-register-contents! expt-machine 'n 5)

;Value: done

1 ]=> (set-register-contents! expt-machine 'b 4)

;Value: done

1 ]=> (start expt-machine)

;Value: done

1 ]=> (get-register-contents expt-machine 'product)

;Value: 1024