SICP 問題 5.05

階乗とFibonacci計算機を机上シミュレート.

;; 再帰的な階乗計算を机上シミュレートする．
(controller
    (assign continue (label fact-done))
  fact-loop
    (test (op =) (reg n) (const 1))
    (branch (label base-case))
    ;; nと continue を退避し再帰呼び出しを設定する．
    ;; 再帰呼び出しから戻るとき after-fact から
    ;; 計算が続行するように continue を設定
    (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)

;; (assign (reg n) (const 3))を既に実行済みであると仮定する．

(assign continue (label fact-done))     ;continue <= fact-done

(test (op =) (reg n) (const 1))         ;(= 3 1) => #f

(save continue)                         ;fact-done => stack => fact-done

(save n)                                ;3 => stack => 3, fact-done

(assign n (op -) (reg n) (const 1))     ;n <= 2

(assign continue (label after-fact))    ;continue <= after-fact

(goto (label fact-loop))

(test (op =) (reg n) (const 1))         ;(= 2 1) => #f

(save continue)                         ;after-fact => stack => after-fact, 3, fact-done

(save n)                                ;2 => stack => 2, after-fact, 3, fact-done

(assign n (op -) (reg n) (const 1))     ;n <= 1

(assign continue (label after-fact))    ;continue <= after-fact

(goto (label fact-loop))

(test (op =) (reg n) (const 1))         ;(= 1 1) => #t

(branch (label base-case))

(assign val (const 1))                  ;val <= 1

(goto (reg continue))                   ;goto after-fact

(restore n)                             ;n <= 2 | stack => after-fact, 3, fact-done

(restore continue)                      ;continue <= after-fact | stack => 3, fact-done

(assign val (op *) (reg n) (reg val))   ;val <= 2 <= (* 2 1)

(goto (reg continue))                   ;goto after-fact

(restore n)                             ;n <= 3 | stack fact-done

(restore continue)                      ;continue <= fact-done | stack => null

(assign val (op *) (reg n) (reg val))   ;n <= 6 <= (* 2 3)

(goto (reg continue))                   ;goto fact-done

fact-done

;; 次はfibonacci計算を机上シミュレートする．
;; Fibonacci 数を計算する計算機の制御器
(controller
    (assign continue (label fib-done))
  fib-loop
    (test (op <) (reg n) (const 2))
    (branch (label immediate-answer))
    ;; Fib(n-1)を計算するよう設定
    (save continue)
    (assign continue (label afterfib-n-1))
    (save n)                            ;n の昔の値を退避
    (assign n (op -) (reg n) (const 1)) ;n を n-1 に変える
    (goto (label fib-loop))             ;再帰呼び出しを実行
  afterfib-n-1                          ;戻った時 Fib(n-1) は val にある
    (restore n)
    (restore continue)
    ;; Fib(n-2)を計算するよう設定
    (assign n (op -) (reg n) (const 2))
    (save continue)
    (assign continue (label afterfib-n-2))
    (save val)                          ;Fib(n-1) を退避
    (goto (label fib-loop))
  afterfib-n-2                          ;戻った時 Fib(n-2) の値は val にある
    (assign n (reg val))                ;n には Fib(n-2) がある
    (restore val)                       ;val には Fib(n-1) がある
    (restore continue)
    (assign val                         ;Fib(n-1) + Fib(n-2)
            (op +) (reg val) (reg n))
    (goto (reg continue))                 ;呼び出し側に戻る．答えは val にある
  immediate-answer
    (assign val (reg n))                ;基底の場合: Fib(n)=n
    (goto (reg continue))
    fib-done)

;; 階乗と同じく(assign n (const 3))を実行済みと仮定する
(assign continue (label fib-done))      ;continue <= fib-done

(test (op <) (reg n) (const 2))         ;(< 3 2) => #f

(save continue)                         ;fib-done => stack => fib-done

(assign continue (label afterfib-n-1))  ;continue <= afterfib-n-1

(save n)                                ;3 => stack => 3, fib-done

(assign n (op -) (reg n) (const 1))     ;n <= 2

(goto (label fib-loop))

(test (op <) (reg n) (const 2))         ;(< 2 2) => #f

(save continue)                         ;afterfib-n-1 => stack => afterfib-n-1, 3, fib-done

(assign continue (label afterfib-n-1))  ;continue <= afterfib-n-1

(save n)                                ;2 => stack => 2, afterfib-n-1, 3, fib-done

(assign n (op -) (reg n) (const 1))     ;n <= 1

(goto (label fib-loop))

(test (op <) (reg n) (const 2))         ;(< 1 2) => #t

(branch (label immediate-answer))

(assign val (reg n))                    ;val <= 1

(goto (reg continue))                   ;(goto afterfib-n-1)

(restore n)                             ;n <= 2 | stack => afterfib-n-1, 3, fib-done

(restore continue)                      ;continue <= afterfib-n-1 | stack => 3, fib-done

(assign n (op -) (reg n) (const 2))     ;n <= 0

(save continue)                         ;afterfib-n-1 => stack =>afterfib-n-1, 3, fib-done

(assign continue (label afterfib-n-2))  ;continue <= afterfib-n-2

(save val)                              ;1 => stack => 1, afterfib-n-1, 3, fib-done

(goto (label fib-loop))

(test (op <) (reg n) (const 2))         ;(< 0 2) => #t

(branch (label immediate-answer))

(assign val (reg n))                    ;val <= 0

(goto (reg continue))                   ;(goto afterfib-n-2)

(assign n (reg val))                    ;n <= 0

(restore val)                           ;val <= 1 | stack => afterfib-n-1, 3, fib-done

(restore continue)                      ;continue <= afterfib-n-1 | stack => 3, fib-done

(assign val (op +) (reg val) (reg n))   ;val <= 1 <= (+ 1 0)

(goto (reg continue))                   ;(goto afterfib-n-1)

(restore n)                             ;n <= 3 | stack => fib-done

(restore continue)                      ;continue <= fib-done | stack => null

(assign n (op -) (reg n) (const 2))     ;n <= 1 <= (- 3 2)

(save continue)                         ;fib-done => stack => fib-done

(assign continue (label afterfib-n-2))  ;continue <= afterfib-n-2

(save val)                              ;1 => stack => 1, fib-done

(goto (label fib-loop))

(test (op <) (reg n) (const 2))         ;(< 1 2) => #t

(brach (label immediate-answer))

(assign val (reg n))                    ;val <= 1

(goto (reg continue))                   ;(goto afterfib-n-2)

(assign n (reg val))                    ;n <= 1

(restore val)                           ;val <= 1 | stack => fib-done

(restore continue)                      ;continue <= fib-done

(assign val (op +) (reg val) (reg n))   ;val <= 2 <= (+ 1 1)

(goto (reg continue))                   ;(goto fib-done)

fib-done