5.17 Exercise 5.17

Printing labels alongside instructions is slightly trickier because we aren’t currently associating instructions with their preceding labels.

We could use an auxiliary data structure to store the associations between instructions and labels (where applicable), but it seems a little cleaner to me to expand the instruction type to optionally include a label. Since the underlying data structure is hidden behind accessing functions, the change should be relatively painless.

extract-labels is procedure which iterates over the labels and instructions in the program and separates them. One might assume that this is the best location to associate instructions with their label(s), but this happens to iterate over the instructions in reverse order. However, the iteration occurs in reverse order. If labels are discovered after the instruction at which they point, we need to be slightly more careful in how we track this.

I would still like to maintain the association between labels and instructions by instrumenting extract-labels, because this is the function that is canonically responsible for constructing both of these. The main change that I need to make now is to maintain a reference to the last instruction which I have created and add labels to it where necessary. In essence, I can do this by adding a new argument to the internal function that this uses.

First, here are the updated constructor/accessor functions for instructions:

(define (make-instruction text)

(list text '()))

(define (instruction-text inst)

(car inst))

(define (instruction-labels inst)

(cadr inst))

(define (instruction-execution-proc inst)

(cddr inst))

(define (add-instruction-label! inst label)

(set-cdr! inst (cons (cons label (instruction-labels inst))

(instruction-execution-proc inst))))

(define (set-instruction-execution-proc! inst proc)

(set-cdr! (cdr inst) proc))

As you can see, the new representation is to include a list of labels as the second item in a list, with the instruction text being first and the execution procedure being last. This choice is arbitrary. (I’ve not added the ability to clear the labels that point to an instruction to the public interface.)

Next, here is the new definition of extract-labels. Note the new argument to the internal procedure, and the fact that we only associate an instruction with a new label if we have one.

(define (extract-labels text receive)

(if (null? text)

(receive '() '() #f)

(extract-labels (cdr text)

(lambda (insts labels last-instruction)

(let ((next-inst (car text)))

(if (symbol? next-inst)

(if (assoc next-inst labels)

(error "Duplicate label -- ASSEMBLE" next-inst)

(begin

(if last-instruction

(add-instruction-label! last-instruction next-inst))

(receive insts

(cons (make-label-entry next-inst insts)

labels)

last-instruction)))

(let ((next-instruction (make-instruction next-inst)))

(receive (cons next-instruction insts)

labels

next-instruction))))))))

assemble, the only caller of this method, also needs to be modified:

(define (assemble controller-text machine)

(extract-labels controller-text

(lambda (insts labels last-instruction)

(update-insts! insts labels machine)

insts)))

Lastly, I can update display-instruction to also print the labels. For legibility, I will unconditionally indent real instruction text to keep it distinct from labels:

(define (display-instruction inst)

(if (instruction-labels inst)

(for-each displayln (instruction-labels inst)))

(displayln "  " (car inst)))

To see these changes in action, here’s a modified version of the recursive exponentiation machine which contains two labels above one of the instructions:

(define recursive-exponentiation-machine

(make-machine

(list (list '= =) (list '- -) (list '* *))

'(start-machine

(perform (op initialize-instruction-count))

(assign continue (label expt-done))

expt-loop

other-label-expt-loop

(test (op =) (reg n) (const 0))

(branch (label base-case))

(save continue)

(assign n (op -) (reg n) (const 1))

(save n)

(assign continue (label after-expt))

(goto (label expt-loop))

after-expt

(restore n)

(restore continue)

(assign val (op *) (reg b) (reg val))

(goto (reg continue))

base-case

(assign val (const 1))

(goto (reg continue))

expt-done

(perform (op print-instruction-count)))))

And in use:

As you can see, the result and the instruction counts are both identical, and the instructions have been traced correctly.