<< Previous exercise (5.16) | Index | Next exercise (5.18) >>


 ;; add a field to instruction to include label. and change the code in extract-labels 
 (define (make-instruction text) 
  (list text '() '())) 
 (define (make-instruction-with-label text label) 
  (list text label '())) 
 (define (instruction-text inst) 
  (car inst)) 
 (define (instruction-label inst) 
  (cadr inst)) 
 (define (instruction-execution-proc inst) 
  (caddr inst)) 
 (define (set-instruction-execution-proc! inst proc) 
  (set-car! (cddr inst) proc)) 
 (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) 
                     (if (label-exist? labels next-inst) 
                             (error "the label has existed EXTRACT-LABELS" next-inst) 
                         (let ((insts                                                    
                                            (if (null? insts) 
                                                    (cons (make-instruction-with-label  
                                                                   (instruction-text (car insts)) 
                                                      (cdr insts))))) 
                                  (cons insts 
                                    (cons (make-label-entry next-inst insts) labels)))) 
                         (cons (cons (make-instruction next-inst) insts) 
 ;; change the code in execute in make-new-machine 
  (define (execute) 
         (let ((insts (get-contents pc))) 
          (if (null? insts) 
                   (if trace-on 
                        (if (not (null? (instruction-label (car insts))))                      
                                     (display (instruction-label (car insts))) 
                            (display (instruction-text (car insts))) 
                    ((instruction-execution-proc (car insts))) 
                    (set! instruction-number (+ instruction-number 1)) 


 ; This works but is is less efficient than meteorgans answer becuase it 
 ; searches for the label each time an instruction is executed. 
 ; added a `labels variable to `make-new-machine with a message `install-labels 
 ; and a message `print-labels. 
 ; The assemble will pass the `install-labels message in the recieve procedure 
 ; it passes to `extract-labels. 
 ; created a procedure `inst-label which takes and instruction as argument and 
 ; returns the label under which the instruction is. 
 ; This is know printed by the execute procedure also. 
 ; Each label has all the instruction starting from the one that follows it 
 ; till the last one. 
 ; this procedure is internal to make-new-machine 
 (define (inst-label inst) 
   (define (inst-label-iter inst lst) 
     (if (member inst (car lst)) 
         (caar lst) 
         (inst-label-iter inst (cdr lst)))) 
   (inst-label-iter inst (reverse labels)))  
 ; new messages in make-new-machine 
 ((eq? message 'install-labels) 
                (lambda (lbls) (set! labels lbls) 'done)) 
 ((eq? message 'print-labels) 
                (lambda () labels)) 
 ; modified assemble procedure. 
 (define (assemble controller-text machine) 
   (extract-labels controller-text 
                   (lambda (insts labels) 
                     ((machine 'install-labels) labels)  ; install the labels. 
                     (update-insts! insts labels machine) 


 ;;my solution trace the "goto" inst and "branch" inst to update the current-label. need a little more work to store the first-label 
 ;;add this at the begin of "make-new-machine" proc,  
 (current-label 'first-label) 
 ;;update execute 
 (define (execute) 
   (let ((insts (get-contents pc))) 
     (if (null? insts) 
         (let ((inst (car insts))) 
           (begin (cond ((trace-on) 
                         (display current-label);*** 
                         (display (instruction-text inst)) 
                  ((instruction-execution-proc inst)) 
                  (set! instruction-number (+ instruction-number 1)) 
                  (if (or (tagged-list? (instruction-text inst) 'goto) 
                          (and (tagged-list? (instruction-text inst) 'branch) 
                               (get-contents flag))) 
                      (set! current-label 
                            (label-exp-label (cadr (instruction-text)))))