(load "5.17.scm")

(define fact-machine
  (make-machine
    '(continue n val)
    (list (list '= =) (list '- -) (list '* *))
    '(   (assign continue (label fact-done))
       fact-loop
         (test (op =) (reg n) (const 1))
         (branch (label base-case))
         (save continue)
         (save n)
         (assign n (op -) (reg n) (const 1))
         (assign continue (label after-fact))
         (goto (label fact-loop))
       after-fact
         (restore n)
         (restore continue)
         (assign val (op *) (reg n) (reg val))
         (goto (reg continue))
       base-case
         (assign val (const 1))
         (goto (reg continue))
       fact-done)))

(define (test n)
  (set-register-contents! fact-machine 'n n)
  (set-register-contents! fact-machine 'val 1)
  (fact-machine 'trace-on)
  (fact-machine 'start)
  (get-register-contents fact-machine 'val))