-
Notifications
You must be signed in to change notification settings - Fork 0
/
5_08.scm
40 lines (36 loc) · 1.27 KB
/
5_08.scm
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
(load "ch5-regsim.scm")
; In current implementation register 'a' would contain value 3.
(define (label-exists? labels label)
(memq label (map car labels)))
(define (extract-labels text receive)
(if (null? text)
(receive '() '())
(extract-labels (cdr text)
(lambda (insts labels)
(let ((next-inst (car text)))
(if (symbol? next-inst)
(if (not (label-exists? labels next-inst))
(receive insts
(cons (make-label-entry next-inst
insts)
labels))
(error "Label already exists -- EXTRACT-LABELS" next-inst))
(receive (cons (make-instruction next-inst)
insts)
labels)))))))
(define machine
(make-machine
'(a)
(list (list '= =) (list '* *) (list '+ +) (list '- -))
'(
start
(goto (label here))
here
(assign a (const 3))
(goto (label there))
here
(assign a (const 4))
(goto (label there))
there)))
(start machine)
(get-register-contents machine 'a)