60 lines
1.5 KiB
Scheme
60 lines
1.5 KiB
Scheme
(load "util.scm")
|
|
(load "misc/sicp-regsim.scm")
|
|
|
|
(display "\nex-5.7 - test-machines\n")
|
|
|
|
; We have already tested the machines in the previous exercises.
|
|
|
|
(display "[answered]\n")
|
|
|
|
; continue at 5.2.2 - the assembler
|
|
|
|
(display "\nex-5.8 - double-here\n")
|
|
|
|
(define (extract-labels text receive)
|
|
(define (warn-if-label-exists label labels)
|
|
(if (assoc label labels)
|
|
(begin
|
|
(display "WARNING duplicated label -- ")
|
|
(display label)
|
|
(newline))))
|
|
(if (null? text)
|
|
(receive '() '())
|
|
(extract-labels (cdr text)
|
|
(lambda (insts labels)
|
|
(let ((next-inst (car text)))
|
|
(if (symbol? next-inst)
|
|
(warn-if-label-exists next-inst labels))
|
|
(if (symbol? next-inst)
|
|
(receive insts
|
|
(cons (make-label-entry next-inst
|
|
insts)
|
|
labels))
|
|
(receive (cons (make-instruction next-inst)
|
|
insts)
|
|
labels)))))))
|
|
|
|
(define double-here-machine
|
|
(make-machine
|
|
'(a)
|
|
'()
|
|
'(start
|
|
(goto (label here))
|
|
here
|
|
(assign a (const 3))
|
|
(goto (label there))
|
|
here
|
|
(assign a (const 4))
|
|
(goto (label there))
|
|
there)))
|
|
|
|
(start double-here-machine)
|
|
(assert (get-register-contents double-here-machine 'a) 3)
|
|
|
|
; The register contains 3 because the assembler jumps to the first label in the
|
|
; list.
|
|
|
|
(display "\nex-5.9\n")
|
|
|
|
(display "\nex-5.10\n")
|