(wat-aro)

無職から有職者にランクアップしました

SICP 問題 5.11-a

図5.12のfibonacci計算から1命令除去する.

;;; ex5.06で変更したこれを使う.
(controller
    (assign continue (label fib-done))
  fib-loop
    (test (op <) (reg n) (const 2))
    (branch (label immediate-answer))
    (save continue)
    (assign continue (label afterfib-n-1))
    (save n)
    (assign n (op -) (reg n) (const 1))
    (goto (label fib-loop))
  afterfib-n-1
    (restore n)
    (assign n (op -) (reg n) (const 2))
    (assign continue (label afterfib-n-2))
    (save val)
    (goto (label fib-loop))
  afterfib-n-2
    (assign n (reg val))                ;ここを消して
    (restore val)                       ;ここで(restore n)
    (restore continue)
    (assign val
            (op +) (reg val) (reg n))
    (goto (reg continue))
  immediate-answer
    (assign val (reg n))
    (goto (reg continue))
    fib-done)

;; 変更後
(define fib-machine
  (make-machine
   '(n val continue)
   (list (list '< <) (list '- -) (list '+ +))
   '(controller
     (assign continue (label fib-done))
     fib-loop
     (test (op <) (reg n) (const 2))
     (branch (label immediate-answer))
     (save continue)
     (assign continue (label afterfib-n-1))
     (save n)
     (assign n (op -) (reg n) (const 1))
     (goto (label fib-loop))
     afterfib-n-1
     (restore n)
     (assign n (op -) (reg n) (const 2))
     (assign continue (label afterfib-n-2))
     (save val)
     (goto (label fib-loop))
     afterfib-n-2
     (restore n)
     (restore continue)
     (assign val
             (op +) (reg val) (reg n))
     (goto (reg continue))
     immediate-answer
     (assign val (reg n))
     (goto (reg continue))
     fib-done)))

test

gosh> (set-register-contents! fib-machine 'n 6)
done
gosh> (start fib-machine)
done
gosh> (get-register-contents fib-machine 'val)
8
gosh> (set-register-contents! fib-machine 'n 10)
done
gosh> (start fib-machine)
done
gosh> (get-register-contents fib-machine 'val)
55