Serendip

Web Studio

問題5.15

make-new-machine 手続きに命令計数を保持する変数 instruction-count を追加し、execute 手続きに instruction-count をインクリメントする処理を追加する。
instruction-count を取り出す手続き get-instruction-count と、初期化手続き initialize-instruction-count を追加し、メッセージパッシング処理にそれぞれの処理を追加する。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        ;; 省略
        (instruction-count 0)
        (the-instruction-sequence '()))
        ;; 省略
            (define (execute)
              (let ((insts (get-contents pc)))
                   (if (null? insts)
                       'done
                       (begin
                         ((instruction-execution-proc (car insts)))
                         (set! instruction-count (+ 1 instruction-count))
                         (execute)))))
            (define (get-instruction-count)
              instruction-count)
            (define (initialize-instruction-count)
              (set! instruction-count 0))
            (define (dispatch message)
              ;; 省略
                    ((eq? message 'get-instruction-count)
                     (let ((cnt (get-instruction-count)))
                          (initialize-instruction-count)
                          cnt))
                    ((eq? message 'initialize-instruction-count) (initialize-instruction-count))
                    (else (error "Unknown request -- MACHINE" message))))
            dispatch)))

(define (get-instruction-counting machine)
  (machine 'get-instruction-count))

(define (initialize-instruction-counting machine)
  (machine 'initialize-instruction-count))

図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)))

(define (factorial n)
  (set-register-contents! fact-machine 'n n)
  (start fact-machine)
  (format #t "factorial ~2d => ~4d, instruction-count: ~4d\n"
          n
          (get-register-contents fact-machine 'val)
          (get-instruction-counting fact-machine)))

(map (lambda (n) (factorial n)) '(1 2 3 4 5))

実行結果

gosh> factorial  1 =>    1, instruction-count:    5
factorial  2 =>    2, instruction-count:   16
factorial  3 =>    6, instruction-count:   27
factorial  4 =>   24, instruction-count:   38
factorial  5 =>  120, instruction-count:   49
(#<undef> #<undef> #<undef> #<undef> #<undef>)

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

posted with amazlet at 08.11.07

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

Amazon.co.jp で詳細を見る