这一题稍微复杂。

我们可以在运行时处理 label 的信息。比如运行到 goto 的时候，记录 goto 到的标签；branch 时，查看是否会跳转，如果跳转，则更新标签信息。但这么做会打乱模块间的独立性。

这里的解法是在 assemble 时，分析得到每一个 instruction 和对应的 label，保存在一个 associate list 里面。每一次在执行的时候直接从这个 list 取就可以。

在 assemble 的时候，有一个非常重要的函数 extract-labels 。关于它的作用，我们可以从下面这个 assertion 看出来：

(let ((text
       '(label1
         (inst1 arg)
         (inst2 arg)
         label2
         (inst3 arg)
         (inst4 arg)
         label3)))
  (let ((labels (extract-labels text (lambda (labels insts) labels)))
        (insts (extract-labels text (lambda (labels insts) insts))))
    (begin
      (assertequal?
       labels
       '((label1 ((inst1 arg)) ((inst2 arg)) ((inst3 arg)) ((inst4 arg)))
         (label2 ((inst3 arg)) ((inst4 arg)))
         (label3)))
      (assertequal?
       insts
       '(((inst1 arg))
         ((inst2 arg))
         ((inst3 arg))
         ((inst4 arg))))
      (assertequal? (lookup-label labels 'label1)
                    '(((inst1 arg)) ((inst2 arg)) ((inst3 arg)) ((inst4 arg)))))))

它能把 label 和之后的 instruction 都对应起来（信息保存在 labels 参数中）。我们只需要从后往前对每一个 instruction 都构造一个 (inst . label) 的 pair，然后把这些 pair 再组成 associate list。每一个 inst 开始执行的时候就匹配（使用 eq? 而不是 equal?）对应的 label。

(define (assemble constroller-text machine)
  (extract-labels constroller-text
                  (lambda (labels insts)
                    ;; labels contains useful information
                    (set-inst-label! labels machine)
                    (update-insts! insts labels machine)
                    insts)))
;; 2
(define (set-inst-label! labels machine)
  (define (make-inst-label labels-insts)
    (if (null? labels-insts)
        '()
        (let* ((label-insts (car labels-insts))
               (label (car label-insts))
               (insts (cdr label-insts)))
          (append (make-inst-label (cdr labels-insts))
                  (map (lambda (inst) (cons (car inst) label)) insts)))))
  ((machine 'install-label-info) (make-inst-label labels)))

在 set-inst-label! 中， (make-inst-label labels) 将会返回

((inst1 . label1)
 (inst2 . label2)
 (inst3 . label3)
 ...
 )

然后把这些信息传递给 machine。machine 在 execute 的函数中调用

      (define (print-inst-label inst)
        (if trace-flag
            (begin
              (newline)
              (cond ((assv inst inst-label)
                     (display (cdr (assv inst inst-label)))
                     (display ": "))
                    (else
                     (display "NO LABEL: ")))
              (display inst))))

注意这里使用 assv 而不是 assoc 。内容一样的 instruction 不一定就是同一个 instruction。我们要用 assv 匹配指针的位置。另外要注意有的 instruction 可能没有标签。

然后是测试，这个测试里面有两条内容一样但属于不同标签的 (goto (reg continue)) instruction。

(load "../testframe.scm")
(define controller
  '((assign continue (label fact-done))     ; set up final return address
   fact-loop
    (test (op =) (reg n) (const 1))
    (branch (label base-case))
    ;; Set up for the recursive call by saving n and continue.
    ;; Set up continue so that the computation will continue
    ;; at after-fact when the subroutine returns.
    (save continue)
    (save n)
    (assign n (op -) (reg n) (const 1))
    (assign continue (label after-fact))
    (goto (label fact-loop))
   after-fact
    (restore n)
    (restore continue)
    (assign val (op *) (reg n) (reg val))   ; val now contains n(n - 1)!
    (goto (reg continue))                   ; return to caller
   base-case
    (assign val (const 1))                  ; base case: 1! = 1
    (goto (reg continue))                   ; return to caller
   fact-done))

(define (factorial n)
  (if (< n 2)
      1
      (* n (factorial (- n 1)))))

(define fact-machine
  (make-machine
   '(n val continue)
   (list (list '= =)
         (list '- -)
         (list '* *))
   controller))

(define (run-fact n)
  (fact-machine 'reset)
  (set-register-contents! fact-machine 'n n)
  (fact-machine 'trace-on)
  (start fact-machine)
  (fact-machine 'print-inst-count)
  (get-register-contents fact-machine 'val))

(assert= (run-fact 2) (factorial 2))
(assert= (run-fact 3) (factorial 3))
(assert= (run-fact 4) (factorial 4))
(assert= (run-fact 5) (factorial 5))
(assert= (run-fact 6) (factorial 6))
(assert= (run-fact 7) (factorial 7))