Exercise 5.18.  Modify the make-register procedure of section 5.2.1 so 
that registers can be traced. Registers should accept messages that turn 
tracing on and off. When a register is traced, assigning a value to the 
register should print the name of the register, the old contents of the 
register, and the new contents being assigned. Extend the interface to 
the machine model to permit you to turn tracing on and off for 
designated machine registers.

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

The modified simulator is in 5.18.scm, the changes are:


--- ch5-regsim.scm	2010-03-16 02:00:34.000000000 -0600
+++ 5.18.scm	2010-03-28 12:40:54.000000000 -0600
@@ -12,11 +12,16 @@
     machine))
 
 (define (make-register name)
-  (let ((contents '*unassigned*))
+  (let ((contents '*unassigned*)
+        (tracing false))
     (define (dispatch message)
       (cond ((eq? message 'get) contents)
             ((eq? message 'set)
-             (lambda (value) (set! contents value)))
+             (lambda (value)
+               (if tracing (begin (display (list 'set name 'old contents 'new value)) (newline)))
+               (set! contents value)))
+            ((eq? message 'trace-on) (set! tracing true))
+            ((eq? message 'trace-off) (set! tracing false))
             (else
              (error "Unknown request -- REGISTER" message))))
     dispatch))
@@ -157,6 +162,12 @@
 (define (get-register machine reg-name)
   ((machine 'get-register) reg-name))
 
+(define (set-register-trace-on! machine register-name)
+  ((get-register machine register-name) 'trace-on))
+
+(define (set-register-trace-off! machine register-name)
+  ((get-register machine register-name) 'trace-off))
+
 (define (assemble controller-text machine)
   (extract-labels controller-text
     (lambda (insts labels)

The test is the same factorial function with tracing turned on in the 
val and n registers, in 5.18-test.scm

REPL transcript:

1 ]=> (test 2)
(set n old 2 new 1)
(set val old 1 new 1)
(set n old 1 new 2)
(set val old 1 new 2)
;Value: 2

1 ]=> (test 4)
(set n old 2 new 4)
(set val old 2 new 1)
(set n old 4 new 3)
(set n old 3 new 2)
(set n old 2 new 1)
(set val old 1 new 1)
(set n old 1 new 2)
(set val old 1 new 2)
(set n old 2 new 3)
(set val old 2 new 6)
(set n old 3 new 4)
(set val old 6 new 24)
;Value: 24