sicp-ex-5.2

  
  
  
 (define fact-machine 
   (make-machine 
    '(c p n) 
    (list (list '* *) (list '+ +) (list '> >)) 
    '((assign c (const 1)) 
      (assign p (const 1)) 
      test-n 
      (test (op >) (reg c) (reg n)) 
      (branch (label fact-done)) 
      (assign p (op *) (reg c) (reg p)) 
      (assign c (op +) (reg c) (const 1)) 
      (goto (label test-n)) 
      fact-done))) 
  
 (set-register-contents! fact-machine 'n 5) 
 (start fact-machine) 
  
 (get-register-contents fact-machine 'p) 
 =>120 

  
  
  
 (controller  
  (assign p (const 1)) 
  (assign c (const 1)) 
  
  test-n 
  (test (op >) (reg c) (reg n)) 
  (branch (label done)) 
  (assign x (op *) (reg p) (reg c)) 
  (assign y (op +) (reg c) (const 1)) 
  (assign p (reg x)) 
  (assign c (reg y)) 
  (goto (label test-n)) 
  
  done) 

  
  
  
 (controller  
  (assign Prod (const 1)) 
  (assign Count (const 1)) 
  
  test-n 
  (test (op >) (reg Count) (reg n)) 
  (branch (label done)) 
  (assign t (op *) (reg Prod) (reg Count)) 
  (assign Prod (reg t)) 
  (assign t (op +) (reg Count) (const 1)) 
  (assign Prod (reg t)) 
  (goto (label test-n)) 
  done)