Serendip

Web Studio

問題5.16

make-new-machine にトレースの実行フラグを追加し、フラグのON/OFFメッセージの処理手続きを追加する。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        ;; 省略
        (instruction-trace-flag #f)
        (the-instruction-sequence '()))
        ;; 省略
            (define (set-instruction-trace flag)
              (set! instruction-trace-flag flag))
            (define (dispatch message)
              ;; 省略
                    ((eq? message 'trace-on) (set-instruction-trace #t))
                    ((eq? message 'trace-off) (set-instruction-trace #f))
                    (else (error "Unknown request -- MACHINE" message))))
            dispatch)))

図5.11の階乗計算機でトレースの実行を試してみる。

(define fact-machine
  (make-machine
    '(continue val n)
    (list (list '= =) (list '- -) (list '* *))
    '(start
       (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)))

(fact-machine 'trace-on)
(set-register-contents! fact-machine 'n 3)
(start fact-machine)
(get-register-contents fact-machine 'val)
(fact-machine 'trace-off)
(set-register-contents! fact-machine 'n 5)
(start fact-machine)
(get-register-contents fact-machine 'val)

実行結果

gosh> instruction: (assign continue (label fact-done))
instruction: (test (op =) (reg n) (const 1))
instruction: (branch (label base-case))
instruction: (save continue)
instruction: (save n)
instruction: (assign n (op -) (reg n) (const 1))
instruction: (assign continue (label after-fact))
instruction: (goto (label fact-loop))
instruction: (test (op =) (reg n) (const 1))
instruction: (branch (label base-case))
instruction: (save continue)
instruction: (save n)
instruction: (assign n (op -) (reg n) (const 1))
instruction: (assign continue (label after-fact))
instruction: (goto (label fact-loop))
instruction: (test (op =) (reg n) (const 1))
instruction: (branch (label base-case))
instruction: (assign val (const 1))
instruction: (goto (reg continue))
instruction: (restore n)
instruction: (restore continue)
instruction: (assign val (op *) (reg n) (reg val))
instruction: (goto (reg continue))
instruction: (restore n)
instruction: (restore continue)
instruction: (assign val (op *) (reg n) (reg val))
instruction: (goto (reg continue))
done
gosh> 6
gosh> #f
gosh> done
gosh> done
gosh> 120

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る