sicp-ex-5.17



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


meteorgan

  
  
 ;; 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)) 
                                                       next-inst) 
                                                      (cdr insts))))) 
                                  (cons insts 
                                    (cons (make-label-entry next-inst insts) labels)))) 
                         (cons (cons (make-instruction next-inst) insts) 
                               labels))))))) 
  
 ;; change the code in execute in make-new-machine 
  (define (execute) 
         (let ((insts (get-contents pc))) 
          (if (null? insts) 
              'done 
                  (begin 
                   (if trace-on 
                       (begin 
                        (if (not (null? (instruction-label (car insts))))                      
                                (begin  
                                     (display (instruction-label (car insts))) 
                                     (newline))) 
                            (display (instruction-text (car insts))) 
                        (newline))) 
                    ((instruction-execution-proc (car insts))) 
                    (set! instruction-number (+ instruction-number 1)) 
                    (execute))))) 

Rptx

  
 ; 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) 
                     insts)))