5.2  寄存器计算机模拟器

为了深入理解寄存器计算机的设计,我们必须测试我们设计的机器,看它们是否按预期执行。测试设计的一种方法是手动模拟控制器的操作,如练习 5.5 所示。但对于除了最简单机器之外的所有机器来说,这都极其繁琐。在本节中,我们将为用寄存器计算机语言描述的机器构建一个模拟器。该模拟器是一个 Scheme 程序,包含四个接口过程。第一个过程使用寄存器计算机的描述来构造机器的模型(一种数据结构,其部件对应于要模拟的机器的部件),另外三个过程允许我们通过操作该模型来模拟机器:

(make-machine <register-names> <operations> <controller>)
构造并返回具有给定寄存器、操作和控制器的机器模型。

(set-register-contents! <machine-model> <register-name> <value>)
在给定机器的模拟寄存器中存储一个值。

(get-register-contents <machine-model> <register-name>)
返回给定机器中模拟寄存器的内容。

(start <machine-model>)
模拟给定机器的执行,从控制器序列的开头开始,到达序列末尾时停止。

作为这些过程使用方法的示例,我们可以按照如下方式将 gcd-machine 定义为第 5.1.1 节中 GCD 机器的模型:

(define gcd-machine
  (make-machine
   '(a b t)
   (list (list 'rem remainder) (list '= =))
   '(test-b
       (test (op =) (reg b) (const 0))
       (branch (label gcd-done))
       (assign t (op rem) (reg a) (reg b))
       (assign a (reg b))
       (assign b (reg t))
       (goto (label test-b))
     gcd-done)))

make-machine 的第一个参数是一个寄存器名称列表。下一个参数是一个表格(由二元列表组成的列表),将每个操作名称与实现该操作的 Scheme 过程配对(即在给定相同输入值时产生相同输出值)。最后一个参数将控制器指定为标签和机器指令的列表,如第 5.1 节所示。

要用这台机器计算 GCD,我们设置输入寄存器,启动机器,然后在模拟终止时检查结果:

(set-register-contents! gcd-machine 'a 206)
done
(set-register-contents! gcd-machine 'b 40)
done
(start gcd-machine)
done
(get-register-contents gcd-machine 'a)
2

这个计算将比用 Scheme 编写的 gcd 过程运行得慢得多,因为我们将用更复杂的操作来模拟底层的机器指令,例如 assign

练习 5.7.  使用模拟器测试你在练习 5.4 中设计的机器。

5.2.1  机器模型

make-machine 生成的机器模型被表示为一个具有局部状态的过程,使用了第 3 章中开发的

消息传递技术。为了构建这个模型,make-machine 首先调用 make-new-machine 过程来构造所有寄存器计算机共有的机器模型部分。由 make-new-machine 构造的这个基本机器模型本质上是一个容器,包含一些寄存器和一个堆栈,以及一个逐条处理控制器指令的执行机制。

Make-machine 然后扩展这个基本模型(通过向其发送消息),以包含正在定义的特定机器的寄存器、操作和控制器。首先,它为每个提供的寄存器名称在新机器中分配一个寄存器,并将指定的操作安装到机器中。然后,它使用一个汇编器(在下面第 5.2.2 节中描述)将控制器列表转换为新机器的指令,并将这些指令安装为机器的指令序列。Make-machine 返回修改后的机器模型作为其值。

(define (make-machine register-names ops controller-text)
  (let ((machine (make-new-machine)))
    (for-each (lambda (register-name)
                ((machine 'allocate-register) register-name))
              register-names)
    ((machine 'install-operations) ops)    
    ((machine 'install-instruction-sequence)
     (assemble controller-text machine))
    machine))

寄存器

我们将寄存器表示为一个具有局部状态的过程,如同第 3 章那样。过程 make-register 创建一个寄存器,它持有一个可以被访问或修改的值:

(define (make-register name)
  (let ((contents '*unassigned*))
    (define (dispatch message)
      (cond ((eq? message 'get) contents)
            ((eq? message 'set)
             (lambda (value) (set! contents value)))
            (else
             (error "Unknown request -- REGISTER" message))))
    dispatch))

以下过程用于访问寄存器:

(define (get-contents register)
  (register 'get))

(define (set-contents! register value)
  ((register 'set) value))

堆栈

我们也可以将堆栈表示为一个具有局部状态的过程。过程 make-stack 创建一个堆栈,其局部状态由堆栈上的项列表组成。堆栈接受请求:将一项 push(压入)堆栈,pop(弹出)堆栈顶部的项并返回它,以及将堆栈 initialize(初始化)为空。

(define (make-stack)
  (let ((s '()))
    (define (push x)
      (set! s (cons x s)))
    (define (pop)
      (if (null? s)
          (error "Empty stack -- POP")
          (let ((top (car s)))
            (set! s (cdr s))
            top)))
    (define (initialize)
      (set! s '())
      'done)
    (define (dispatch message)
      (cond ((eq? message 'push) push)
            ((eq? message 'pop) (pop))
            ((eq? message 'initialize) (initialize))
            (else (error "Unknown request -- STACK"
                         message))))
    dispatch))

以下过程用于访问堆栈:

(define (pop stack)
  (stack 'pop))

(define (push stack value)
  ((stack 'push) value))

基本机器

图 5.13 中所示的 make-new-machine 过程构造了一个对象,其局部状态包括一个堆栈、一个初始为空的指令序列、一个初始包含一个用于初始化堆栈的操作的操作列表,以及一个寄存器表,该表初始包含两个寄存器,分别命名为 flagpc (代表"程序计数器")。内部过程 allocate-register 向寄存器表添加新条目,内部过程 lookup-register 在表中查找寄存器。

flag 寄存器用于控制模拟机器中的分支。Test 指令将 flag 的内容设置为测试的结果(真或假)。Branch 指令通过检查 flag 的内容来决定是否进行分支。

pc 寄存器决定机器运行时指令的顺序。这个顺序由内部过程 execute 实现。 在模拟模型中,每条机器指令是一个数据结构,包含一个无参数的过程,称为 指令执行过程,调用此过程即模拟执行该指令。在模拟运行时,pc 指向指令序列中以下一条要执行的指令开始的位置。Execute 获取该指令,通过调用指令执行过程来执行它,并重复这个循环,直到没有更多的指令需要执行(即直到 pc 指向指令序列的末尾)。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (the-instruction-sequence '()))
    (let ((the-ops
           (list (list 'initialize-stack
                       (lambda () (stack 'initialize)))))
          (register-table
           (list (list 'pc pc) (list 'flag flag))))
      (define (allocate-register name)
        (if (assoc name register-table)
            (error "Multiply defined register: " name)
            (set! register-table
                  (cons (list name (make-register name))
                        register-table)))
        'register-allocated)
      (define (lookup-register name)
        (let ((val (assoc name register-table)))
          (if val
              (cadr val)
              (error "Unknown register:" name))))
      (define (execute)
        (let ((insts (get-contents pc)))
          (if (null? insts)
              'done
              (begin
                ((instruction-execution-proc (car insts)))
                (execute)))))
      (define (dispatch message)
        (cond ((eq? message 'start)
               (set-contents! pc the-instruction-sequence)
               (execute))
              ((eq? message 'install-instruction-sequence)
               (lambda (seq) (set! the-instruction-sequence seq)))
              ((eq? message 'allocate-register) allocate-register)
              ((eq? message 'get-register) lookup-register)
              ((eq? message 'install-operations)
               (lambda (ops) (set! the-ops (append the-ops ops))))
              ((eq? message 'stack) stack)
              ((eq? message 'operations) the-ops)
              (else (error "Unknown request -- MACHINE" message))))
      dispatch)))

图 5.13:  make-new-machine 过程,它实现了基本的机器模型。

作为其操作的一部分,每个指令执行过程都会修改 pc 以指示下一条要执行的指令。Branchgoto 指令改变 pc,使其指向新的目的地。所有其他指令简单地推进 pc,使其指向序列中的下一条指令。请注意,每次调用 execute 都会再次调用 execute,但这不会产生无限循环,因为运行指令执行过程会改变 pc 的内容。

Make-new-machine 返回一个 dispatch 过程,该过程实现了对内部状态的消息传递访问。注意,启动机器是通过将 pc 设置为指令序列的开头并调用 execute 来实现的。

为方便起见,我们提供了机器 start 操作的另一种过程接口,以及设置和检查寄存器内容的过程,正如第 5.2 节开头所指定的:

(define (start machine)
  (machine 'start))
(define (get-register-contents machine register-name)
  (get-contents (get-register machine register-name)))
(define (set-register-contents! machine register-name value)
  (set-contents! (get-register machine register-name) value)
  'done)

这些过程(以及第 5.2.2 节和5.2.3 节中的许多过程)使用以下过程在给定机器中查找具有给定名称的寄存器:

(define (get-register machine reg-name)
  ((machine 'get-register) reg-name))

5.2.2  汇编器

汇编器将机器的控制器表达式序列转换为相应的机器指令列表,每条指令都带有其执行过程。总体而言,汇编器很像我们在第 4 章中研究的求值器——这里有一个输入语言(在本例中是寄存器计算机语言),我们必须为语言中的每种表达式类型执行适当的动作。

为每条指令生成执行过程的技术正是我们在第 4.1.7 节中用来通过将分析与运行时执行分离来加速求值器的技术。正如我们在第 4 章中看到的,无需知道变量的实际值就可以对 Scheme 表达式进行许多有用的分析。类似地,在这里,无需知道机器寄存器的实际内容就可以对寄存器计算机语言表达式进行许多有用的分析。例如,我们可以将对寄存器的引用替换为对寄存器对象的指针,并将对标签的引用替换为对标签所指示的指令序列中位置的指针。

在生成指令执行过程之前,汇编器必须知道所有标签引用的是什么,因此它首先扫描控制器文本,将标签与指令分开。在扫描文本时,它同时构造一个指令列表和一个将每个标签与指向该列表的指针相关联的表。然后汇编器通过为每条指令插入执行过程来扩充指令列表。

assemble 过程是汇编器的主要入口。它接受控制器文本和机器模型作为参数,并返回要存储在模型中的指令序列。Assemble 调用 extract-labels 从提供的控制器文本构建初始指令列表和标签表。extract-labels 的第二个参数是一个过程,将被调用来处理这些结果:该过程使用 update-insts! 来生成指令执行过程并将它们插入到指令列表中,并返回修改后的列表。

(define (assemble controller-text machine)
  (extract-labels controller-text
    (lambda (insts labels)
      (update-insts! insts labels machine)
      insts)))

Extract-labels 接受一个列表 text(控制器指令表达式序列)和一个 receive 过程作为参数。Receive 将用两个值调用:(1) 指令数据结构列表 insts,每个结构包含来自 text 的一条指令;以及 (2) 一个称为 labels 的表,它将来自 text 的每个标签与该标签所指示的 insts 列表中的位置关联起来。

(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)
               (receive insts
                        (cons (make-label-entry next-inst
                                                insts)
                              labels))
               (receive (cons (make-instruction next-inst)
                              insts)
                        labels)))))))

Extract-labels 通过顺序扫描 text 的元素并累积 instslabels 来工作。如果某个元素是一个符号(因此是一个标签),则向 labels 表中添加一个适当的条目。否则,该元素被累积到 insts 列表中。4

Update-insts! 修改指令列表(最初仅包含指令文本),使其包含相应的执行过程:

(define (update-insts! insts labels machine)
  (let ((pc (get-register machine 'pc))
        (flag (get-register machine 'flag))
        (stack (machine 'stack))
        (ops (machine 'operations)))
    (for-each
     (lambda (inst)
       (set-instruction-execution-proc! 
        inst
        (make-execution-procedure
         (instruction-text inst) labels machine
         pc flag stack ops)))
     insts)))

机器指令数据结构简单地将指令文本与相应的执行过程配对。当 extract-labels 构造指令时,执行过程尚不可用,之后由 update-insts! 插入。

(define (make-instruction text)
  (cons text '()))
(define (instruction-text inst)
  (car inst))
(define (instruction-execution-proc inst)
  (cdr inst))
(define (set-instruction-execution-proc! inst proc)
  (set-cdr! inst proc))

我们的模拟器不使用指令文本,但保留它便于调试(参见练习 5.16)。

标签表的元素是序对:

(define (make-label-entry label-name insts)
  (cons label-name insts))

表中的条目将使用以下过程进行查找

(define (lookup-label labels label-name)
  (let ((val (assoc label-name labels)))
    (if val
        (cdr val)
        (error "Undefined label -- ASSEMBLE" label-name))))

练习 5.8.  以下寄存器计算机代码是有歧义的,因为标签 here 被定义了多次:

start
  (goto (label here))
here
  (assign a (const 3))
  (goto (label there))
here
  (assign a (const 4))
  (goto (label there))
there

按照当前的模拟器,当控制到达 there 时,寄存器 a 的内容是什么?修改 extract-labels 过程,使得如果同一个标签名称被用来指示两个不同的位置,汇编器将发出错误信号。

5.2.3  生成指令的执行过程

汇编器调用 make-execution-procedure 来为一条指令生成执行过程。与第 4.1.7 节求值器中的 analyze 过程类似,它根据指令的类型进行分派,以生成适当的执行过程。

(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) '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))))

对于寄存器计算机语言中的每种指令类型,都有一个生成器来构建适当的执行过程。这些过程的细节决定了寄存器计算机语言中各条指令的语法和含义。我们使用数据抽象将寄存器机器表达式的详细语法与一般的执行机制隔离开来,就像我们在第 4.1.2 节中为求值器所做的那样,通过使用语法过程来提取和分类指令的各个部分。

Assign 指令

make-assign 过程处理 assign 指令:

(define (make-assign inst machine labels operations pc)
  (let ((target
         (get-register machine (assign-reg-name inst)))
        (value-exp (assign-value-exp inst)))
    (let ((value-proc
           (if (operation-exp? value-exp)
               (make-operation-exp
                value-exp machine labels operations)
               (make-primitive-exp
                (car value-exp) machine labels))))
      (lambda ()                assign 的执行过程
        (set-contents! target (value-proc))
        (advance-pc pc)))))

Make-assign 使用选择器从 assign 指令中提取目标寄存器名称(指令的第二个元素)和值表达式(构成指令的列表的其余部分)

(define (assign-reg-name assign-instruction)
  (cadr assign-instruction))
(define (assign-value-exp assign-instruction)
  (cddr assign-instruction))

使用 get-register 查找寄存器名称以产生目标寄存器对象。如果值是操作的结果,则将值表达式传递给 make-operation-exp,否则传递给 make-primitive-exp。这些过程(如下所示)解析值表达式并为该值生成一个执行过程。这是一个无参数的过程,称为 value-proc,将在模拟期间被求值以产生要赋给寄存器的实际值。注意,查找寄存器名称和解析值表达式的工作只执行一次,在汇编时完成,而不是在每次模拟指令时都做。这种工作量的节省正是我们使用执行过程的原因,并且与我们在第 4.1.7 节的求值器中通过将程序分析与执行分离所获得的工作量节省直接对应。

Make-assign 返回的结果是 assign 指令的执行过程。当这个过程被调用时(由机器模型的 execute 过程),它将目标寄存器的内容设置为执行 value-proc 所得到的结果。然后它通过运行以下过程将 pc 推进到下一条指令

(define (advance-pc pc)
  (set-contents! pc (cdr (get-contents pc))))

Advance-pc 是所有指令(branchgoto 除外)的正常终止方式。

Testbranchgoto 指令

Make-test 以类似的方式处理 test 指令。它提取指定要测试的条件的表达式,并为其生成一个执行过程。在模拟时,调用条件的过程,将结果赋给 flag 寄存器,然后推进 pc

(define (make-test inst machine labels operations flag pc)
  (let ((condition (test-condition inst)))
    (if (operation-exp? condition)
        (let ((condition-proc
               (make-operation-exp
                condition machine labels operations)))
          (lambda ()
            (set-contents! flag (condition-proc))
            (advance-pc pc)))
        (error "Bad TEST instruction -- ASSEMBLE" inst))))
(define (test-condition test-instruction)
  (cdr test-instruction))

branch 指令的执行过程检查 flag 寄存器的内容,并将 pc 的内容设置为分支目的地(如果执行分支)或者仅推进 pc(如果不执行分支)。注意,branch 指令中指示的目的地必须是一个标签,make-branch 过程强制执行这一点。还要注意,标签是在汇编时查找的,而不是每次模拟 branch 指令时查找。

(define (make-branch inst machine labels flag pc)
  (let ((dest (branch-dest inst)))
    (if (label-exp? dest)
        (let ((insts
               (lookup-label labels (label-exp-label dest))))
          (lambda ()
            (if (get-contents flag)
                (set-contents! pc insts)
                (advance-pc pc))))
        (error "Bad BRANCH instruction -- ASSEMBLE" inst))))
(define (branch-dest branch-instruction)
  (cadr branch-instruction))

goto 指令与 branch 类似,不同之处在于目的地可以指定为标签或寄存器,并且没有需要检查的条件——pc 总是设置为新的目的地。

(define (make-goto inst machine labels pc)
  (let ((dest (goto-dest inst)))
    (cond ((label-exp? dest)
           (let ((insts
                  (lookup-label labels
                                (label-exp-label dest))))
             (lambda () (set-contents! pc insts))))
          ((register-exp? dest)
           (let ((reg
                  (get-register machine
                                (register-exp-reg dest))))
             (lambda ()
               (set-contents! pc (get-contents reg)))))
          (else (error "Bad GOTO instruction -- ASSEMBLE"
                       inst)))))
(define (goto-dest goto-instruction)
  (cadr goto-instruction))

其他指令

堆栈指令 saverestore 简单地使用带有指定寄存器的堆栈并推进 pc

(define (make-save inst machine stack pc)
  (let ((reg (get-register machine
                           (stack-inst-reg-name inst))))
    (lambda ()
      (push stack (get-contents reg))
      (advance-pc pc))))
(define (make-restore inst machine stack pc)
  (let ((reg (get-register machine
                           (stack-inst-reg-name inst))))
    (lambda ()
      (set-contents! reg (pop stack))    
      (advance-pc pc))))
(define (stack-inst-reg-name stack-instruction)
  (cadr stack-instruction))

最后一种指令类型,由 make-perform 处理,为要执行的动作生成一个执行过程。在模拟时,执行动作过程并推进 pc

(define (make-perform inst machine labels operations pc)
  (let ((action (perform-action inst)))
    (if (operation-exp? action)
        (let ((action-proc
               (make-operation-exp
                action machine labels operations)))
          (lambda ()
            (action-proc)
            (advance-pc pc)))
        (error "Bad PERFORM instruction -- ASSEMBLE" inst))))
(define (perform-action inst) (cdr inst))

子表达式的执行过程

reglabelconst 表达式的值可能在赋值给寄存器(make-assign)或作为操作的输入(make-operation-exp,见下文)时被需要。以下过程生成执行过程,用于在模拟期间为这些表达式产生值:

(define (make-primitive-exp exp machine labels)
  (cond ((constant-exp? exp)
         (let ((c (constant-exp-value exp)))
           (lambda () c)))
        ((label-exp? exp)
         (let ((insts
                (lookup-label labels
                              (label-exp-label exp))))
           (lambda () insts)))
        ((register-exp? exp)
         (let ((r (get-register machine
                                (register-exp-reg exp))))
           (lambda () (get-contents r))))
        (else
         (error "Unknown expression type -- ASSEMBLE" exp))))

reglabelconst 表达式的语法由以下过程确定

(define (register-exp? exp) (tagged-list? exp 'reg))
(define (register-exp-reg exp) (cadr exp))
(define (constant-exp? exp) (tagged-list? exp 'const))
(define (constant-exp-value exp) (cadr exp))
(define (label-exp? exp) (tagged-list? exp 'label))
(define (label-exp-label exp) (cadr exp))

Assignperformtest 指令可能包含将机器操作(由 op 表达式指定)应用于某些操作数(由 regconst 表达式指定)。以下过程为"操作表达式"(一个包含指令中的操作和操作数表达式的列表)生成一个执行过程:

(define (make-operation-exp exp machine labels operations)
  (let ((op (lookup-prim (operation-exp-op exp) operations))
        (aprocs
         (map (lambda (e)
                (make-primitive-exp e machine labels))
              (operation-exp-operands exp))))
    (lambda ()
      (apply op (map (lambda (p) (p)) aprocs)))))

操作表达式的语法由以下过程确定

(define (operation-exp? exp)
  (and (pair? exp) (tagged-list? (car exp) 'op)))
(define (operation-exp-op operation-exp)
  (cadr (car operation-exp)))
(define (operation-exp-operands operation-exp)
  (cdr operation-exp))

注意,操作表达式的处理与第 4.1.7 节求值器中的 analyze-application 过程对过程应用的处理非常相似,因为我们为每个操作数生成一个执行过程。在模拟时,我们调用操作数过程,并将模拟该操作的 Scheme 过程应用于得到的值。模拟过程是通过在机器的操作表中查找操作名称找到的:

(define (lookup-prim symbol operations)
  (let ((val (assoc symbol operations)))
    (if val
        (cadr val)
        (error "Unknown operation -- ASSEMBLE" symbol))))

练习 5.9.  上面机器操作的处理允许它们对标签以及常量和寄存器内容进行操作。修改表达式处理过程,以强制执行操作只能与寄存器和常量一起使用的条件。

练习 5.10.  为寄存器计算机指令设计一种新语法,并修改模拟器以使用你的新语法。你能否在不修改本节中语法过程之外的任何模拟器部分的情况下实现你的新语法?

练习 5.11.  我们在第 5.1.4 节中引入 saverestore 时,没有指定如果试图恢复一个不是最后保存的寄存器会发生什么,如下列序列所示:

(save y)
(save x)
(restore y)

对于 restore 的含义,有几种合理的可能性:

a.  (restore y) 将最后保存在堆栈上的值放入 y,无论该值来自哪个寄存器。这是我们的模拟器的行为方式。展示如何利用这种行为从第 5.1.4 节(图 5.12)的 Fibonacci 机器中消除一条指令。

b.  (restore y) 将最后保存在堆栈上的值放入 y,但仅当该值是从 y 保存的;否则,它发出错误信号。修改模拟器使其按此方式行为。你需要修改 save 以将寄存器名称与值一起放在堆栈上。

c.  (restore y) 将从 y 保存的最后值放入 y,无论 y 之后保存了哪些其他寄存器且未被恢复。修改模拟器使其按此方式行为。你需要为每个寄存器关联一个单独的堆栈。你应该让 initialize-stack 操作初始化所有寄存器堆栈。

练习 5.12.  模拟器可以用来帮助确定实现具有给定控制器的机器所需的数据路径。扩展汇编器以在机器模型中存储以下信息:

扩展机器的消息传递接口以提供对这些新信息的访问。为测试你的分析器,定义图 5.12 中的 Fibonacci 机器并检查你构造的列表。

练习 5.13.  修改模拟器,使其使用控制器序列来确定机器具有哪些寄存器,而不是要求将寄存器列表作为 make-machine 的参数。不必在 make-machine 中预先分配寄存器,你可以在指令汇编期间首次看到寄存器时逐个分配它们。

5.2.4  监控机器性能

模拟不仅对于验证所提议的机器设计的正确性有用,而且对于测量机器性能也有用。例如,我们可以在模拟程序中安装一个"计量器",用于测量计算中使用的堆栈操作次数。为此,我们修改模拟堆栈以跟踪寄存器被保存到堆栈上的次数和堆栈达到的最大深度,并向堆栈的接口添加一个打印统计信息的消息,如下所示。我们还在基本机器模型中添加一个操作来打印堆栈统计信息,方法是将 make-new-machine 中的 the-ops 初始化为

(list (list 'initialize-stack
            (lambda () (stack 'initialize)))
      (list 'print-stack-statistics
            (lambda () (stack 'print-statistics))))

以下是 make-stack 的新版本:

(define (make-stack)
  (let ((s '())
        (number-pushes 0)
        (max-depth 0)
        (current-depth 0))
    (define (push x)
      (set! s (cons x s))
      (set! number-pushes (+ 1 number-pushes))
      (set! current-depth (+ 1 current-depth))
      (set! max-depth (max current-depth max-depth)))
    (define (pop)
      (if (null? s)
          (error "Empty stack -- POP")
          (let ((top (car s)))
            (set! s (cdr s))
            (set! current-depth (- current-depth 1))
            top)))    
    (define (initialize)
      (set! s '())
      (set! number-pushes 0)
      (set! max-depth 0)
      (set! current-depth 0)
      'done)
    (define (print-statistics)
      (newline)
      (display (list 'total-pushes  '= number-pushes
                     'maximum-depth '= max-depth)))
    (define (dispatch message)
      (cond ((eq? message 'push) push)
            ((eq? message 'pop) (pop))
            ((eq? message 'initialize) (initialize))
            ((eq? message 'print-statistics)
             (print-statistics))
            (else
             (error "Unknown request -- STACK" message))))
    dispatch))

练习 5.15 至 5.19 描述了可以添加到寄存器计算机模拟器中的其他有用的监控和调试功能。

练习 5.14.  使用图 5.11 所示的阶乘机器,测量计算各种小值 nn! 所需的 push 次数和最大堆栈深度。根据你的数据,确定以 n 表示的公式,用于计算任何 n > 1 时 push 操作的总次数和最大堆栈深度。注意,这些值都是 n 的线性函数,因此由两个常数确定。为了打印统计信息,你需要用指令扩充阶乘机器以初始化堆栈并打印统计信息。你可能还想修改机器,使其重复读取 n 的值,计算阶乘并打印结果(就像我们为图 5.4 中的 GCD 机器所做的那样),这样你就不必重复调用 get-register-contentsset-register-contents!start

练习 5.15.  向寄存器计算机模拟添加指令计数功能。也就是说,让机器模型跟踪已执行的指令数量。扩展机器模型的接口以接受一条新消息,该消息打印指令计数的值并将计数重置为零。

练习 5.16.  扩充模拟器以提供指令跟踪功能。也就是说,在执行每条指令之前,模拟器应该打印指令的文本。让机器模型接受 trace-ontrace-off 消息以打开和关闭跟踪。

练习 5.17.  扩展练习 5.16 的指令跟踪功能,使得在打印指令之前,模拟器打印控制器序列中紧接在该指令之前的任何标签。注意,要以不干扰指令计数(练习 5.15)的方式执行此操作。你需要让模拟器保留必要的标签信息。

练习 5.18.  修改第 5.2.1 节中的 make-register 过程,使得寄存器可以被跟踪。寄存器应该接受打开和关闭跟踪的消息。当跟踪一个寄存器时,给寄存器赋值应该打印寄存器的名称、寄存器的旧内容和正在被赋值的新内容。扩展机器模型的接口,允许你打开和关闭指定机器寄存器的跟踪。

练习 5.19.  Alyssa P. Hacker 希望模拟器中有一个断点功能来帮助她调试机器设计。你被雇用来为她安装这个功能。她希望能够指定控制器序列中的一个位置,模拟器将在那里停止并允许她检查机器的状态。你要实现一个过程

(set-breakpoint <machine> <label> <n>)

该过程在给定标签后的第 n 条指令之前设置一个断点。例如,

(set-breakpoint gcd-machine 'test-b 4)

gcd-machine 中,恰好在给寄存器 a 赋值之前安装一个断点。当模拟器到达断点时,它应该打印断点的标签和偏移量,并停止执行指令。然后 Alyssa 可以使用 get-register-contentsset-register-contents! 来操作模拟机器的状态。然后她应该能够通过以下方式继续执行

(proceed-machine <machine>)

她还应该能够通过以下方式移除特定断点

(cancel-breakpoint <machine> <label> <n>)

或者通过以下方式移除所有断点

(cancel-all-breakpoints <machine>)


4 在这里使用 receive 过程是一种让 extract-labels 有效返回两个值(labelsinsts)而不显式创建复合数据结构来保存它们的方法。另一种实现方式显式返回一个值对,如下所示:

(define (extract-labels text)
  (if (null? text)
      (cons '() '())
      (let ((result (extract-labels (cdr text))))
        (let ((insts (car result)) (labels (cdr result)))
          (let ((next-inst (car text)))
            (if (symbol? next-inst)
                (cons insts
                      (cons (make-label-entry next-inst insts) labels))
                (cons (cons (make-instruction next-inst) insts)
                      labels)))))))

它将被 assemble 如下调用:

(define (assemble controller-text machine)
  (let ((result (extract-labels controller-text)))
    (let ((insts (car result)) (labels (cdr result)))
      (update-insts! insts labels machine)
      insts)))

你可以将我们对 receive 的使用视为展示了一种优雅的返回多个值的方式,或者仅仅是一个炫耀编程技巧的借口。像 receive 这样作为下一个要调用的过程的参数被称为"延续"。回忆一下,我们在第 4.3.3 节的 amb 求值器中也使用了延续来实现回溯控制结构。