Exercise 5.16.  Augment the simulator to provide for instruction 
tracing. That is, before each instruction is executed, the simulator 
should print the text of the instruction. Make the machine model accept 
trace-on and trace-off messages to turn tracing on and off.

————————————————————————————————————————————————————————————————————————

Modified simulator is in 5.16.scm, the changes made are:

--- ch5-regsim.scm	2010-03-16 02:00:34.000000000 -0600
+++ 5.16.scm	2010-03-28 10:58:48.000000000 -0600
@@ -99,7 +99,8 @@
   (let ((pc (make-register 'pc))
         (flag (make-register 'flag))
         (stack (make-stack))
-        (the-instruction-sequence '()))
+        (the-instruction-sequence '())
+        (tracing false))
     (let ((the-ops
            (list (list 'initialize-stack
                        (lambda () (stack 'initialize)))
@@ -126,6 +127,7 @@
           (if (null? insts)
               'done
               (begin
+                (if tracing (begin (display (instruction-text (car insts))) (newline)))
                 ((instruction-execution-proc (car insts)))
                 (execute)))))
       (define (dispatch message)
@@ -140,6 +142,8 @@
                (lambda (ops) (set! the-ops (append the-ops ops))))
               ((eq? message 'stack) stack)
               ((eq? message 'operations) the-ops)
+              ((eq? message 'trace-on) (set! tracing true))
+              ((eq? message 'trace-off) (set! tracing false))
               (else (error "Unknown request -- MACHINE" message))))
       dispatch)))

REPL transcript follows:

1 ]=> (test 2)
(assign continue (label fact-done))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-fact))
(goto (label fact-loop))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(assign val (const 1))
(goto (reg continue))
(restore n)
(restore continue)
(assign val (op *) (reg n) (reg val))
(goto (reg continue))
;Value: 2

1 ]=> (test 4)
(assign continue (label fact-done))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-fact))
(goto (label fact-loop))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-fact))
(goto (label fact-loop))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-fact))
(goto (label fact-loop))
(test (op =) (reg n) (const 1))
(branch (label base-case))
(assign val (const 1))
(goto (reg continue))
(restore n)
(restore continue)
(assign val (op *) (reg n) (reg val))
(goto (reg continue))
(restore n)
(restore continue)
(assign val (op *) (reg n) (reg val))
(goto (reg continue))
(restore n)
(restore continue)
(assign val (op *) (reg n) (reg val))
(goto (reg continue))
;Value: 24