sicp-ex-5.22

  
  
  
 ; a. append 
  
 (define append-machine 
   (make-machine 
    `((null? ,null?) (cons ,cons) (car ,car) 
                     (cdr ,cdr)) 
    '( 
      start 
        (assign x (reg x))               ; these 2 instruction are only here to 
        (assign y (reg y))               ; initialize the registers.  
        (assign continue (label done))   ; retrun addres 
        (save continue)                  ; save it. 
      append 
        (test (op null?) (reg x)) 
        (branch (label null)) 
        (assign temp (op car) (reg x))   ; push car as the arg to cons. 
        (save temp) 
        (assign continue (label after-rec)) ;return address for procedure call. 
        (save continue)                  ; push the return address 
        (assign x (op cdr) (reg x))      ; arg for recursive call to append. 
        (goto (label append))            ; recursive call to append. 
      after-rec 
        (restore x)                      ; get the argument pushed by append  
        (assign val (op cons) (reg x) (reg val)) ; consit to the return value 
        (restore continue)               ; get the return address 
        (goto (reg continue))            ; return to caller.  
      null 
        (assign val (reg y))             ; base case, return value = y. 
        (restore continue)               ; get return address 
        (goto (reg continue))            ; return to caller. 
      done))) 
  
 ; b. append! 
  
 (define append!-machine 
   (make-machine 
    `((set-cdr! ,set-cdr!) (null? ,null?) 
                           (cdr ,cdr)) 
    '( 
      start 
        (assign x (reg x))               ; as before just initiailze the regs. 
        (assign y (reg y)) 
        (assign temp1 (reg x))           ; must use temp to avoid changing x.  
        (goto (label last-pair)) 
      append! 
        (assign temp (op set-cdr!) (reg temp1) (reg y)) ;set-cdr! returns an 
        (goto (label done))              ; unspecified value, that we put in temp. 
      last-pair                          ; we want the side effect. 
        (assign temp (op cdr) (reg temp1)) ; test if (cdr temp1 is null) 
        (test (op null?) (reg temp))     ; if so, temp1 is the last pair. 
        (branch (label null)) 
        (assign temp1 (op cdr) (reg temp1)) 
      null 
        (goto (label append!))           ; splice the lists. 
      done 
      ))) 
  

  
  
 ;;a) 
 (define append-m 
   (make-machine '() 
                 (list (list 'null? null?) 
                       (list 'cdr cdr) 
                       (list 'car car) 
                       (list 'cons cons)) 
                 '(controller 
                   (assign continue (label append-done)) 
  
                   loop 
                   (test (op null?) (reg x)) 
                   (branch (label null-x)) 
                   (save continue) 
                   (assign continue (label cdr-done)) 
                   (assign car-x (op car) (reg x)) 
                   (save car-x) 
                   (assign x (op cdr) (reg x)) 
                   (goto (label loop)) 
  
                   null-x 
                   (assign x (reg y)) 
                   (goto (reg continue)) 
  
                   cdr-done 
                   (restore car-x) 
                   (assign x (op cons) (reg car-x) (reg x)) 
                   (restore continue) 
                   (goto (reg continue)) 
  
                   append-done))) 
  
 ;;b) 
 (define append-m! 
   (make-machine '() 
                 (list (list 'null? null?) 
                       (list 'cdr cdr) 
                       (list 'set-cdr! set-cdr!)) 
                 '(controller 
                   (assign iter-x (reg x)) 
                    
                   iter 
                   (assign cdr-x (op cdr) (reg iter-x)) 
                   (test (op null?) (reg cdr-x)) 
                   (branch (label do-append)) 
                   (assign iter-x (op cdr) (reg iter-x)) 
                   (goto (label iter)) 
  
                   do-append 
                   (perform (op set-cdr!) (reg iter-x) (reg y))))) 

  
  
  
  
  
  
  
  
 (define append-machine 
   (make-machine 
    '(result former latter continue) 
    (list (list 'null? null?) 
          (list 'integer? integer?) 
          (list 'symbol? symbol?) 
          (list '+ +) 
          (list 'car car) 
          (list 'cdr cdr) 
          (list 'cons cons)) 
    '( 
      (assign continue (label append-done)) 
       
      append-loop 
      (test (op null?) (reg former)) 
      (branch (label base-case)) 
       
      (save continue) 
      (save former) 
      (assign continue (label after-append)) 
      (assign former (op cdr) (reg former)) 
      (goto (label append-loop)) 
  
      after-append 
      (restore former) 
      (restore continue) 
      (assign former (op car) (reg former)) 
      (assign result 
              (op cons) (reg former) (reg result)) 
  
      (goto (reg continue)) 
       
      base-case 
      (assign result (reg latter)) 
      (goto (reg continue)) 
       
      append-done 
      ))) 
  
 (set-register-contents! append-machine 'former '(1 2 4 3)) 
 (set-register-contents! append-machine 'latter '(8 9 10)) 
 (start append-machine) 
 (printf "~a~%" (get-register-contents append-machine 'result)) 
  
  
 (define (append! x y) 
   (if (null? (cdr x)) 
       (set-cdr! x y) 
       (append! (cdr x) y))) 
  
 (define append!-machine 
   (make-machine 
    '(former latter aux-former rest) 
    (list (list 'null? null?) 
          (list 'integer? integer?) 
          (list 'symbol? symbol?) 
          (list '+ +) 
          (list 'car car) 
          (list 'cdr cdr) 
          (list 'cons cons) 
          (list 'set-cdr! set-cdr!)) 
    '( 
      (assign aux-former (reg former)) 
      (assign rest (op cdr) (reg aux-former)) 
       
      test-rest 
      (test (op null?) (reg rest)) 
      (branch (label append!-done)) 
       
      (assign aux-former (op cdr) (reg aux-former)) 
      (assign rest (op cdr) (reg aux-former)) 
      (goto (label test-rest)) 
  
      append!-done 
      (perform (op set-cdr!) (reg aux-former) (reg latter)) 
      ))) 
  
 (set-register-contents! append!-machine 'former '(1 2 4 3)) 
 (set-register-contents! append!-machine 'latter '(8 9 10)) 
 (start append!-machine) 
 (printf "~a~%" (get-register-contents append!-machine 'former))