SICP 問題 5.15
命令数カウンタを追加する.
(define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '()) (the-instruction-counter 0)) ;counterの追加 (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))) (list 'print-stack-statistics (lambda () (stack 'print-statistics))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (define (allocate-register name) (if (assoc name register-table) (error "Multiply defined rgister: " name) (set! register-table (cons (list name (make-register name)) register-table))) 'register-allocated) (define (lookup-register name) (let ((val (assoc name register-table))) (if val (cadr val) (error "Unknown register: " name)))) (define (execute) (let ((insts (get-contents pc))) (if (null? insts) 'done (begin (set! the-instruction-counter (+ 1 the-instruction-counter)) ;; ここでインクリメント ((instruction-execution-proc (car insts))) (execute))))) (define (initialize-counter) (set! instruction-counter 0)) (define (dispatch message) (cond ((eq? message 'start) (set-contents! pc the-instruction-sequence) (execute)) ((eq? message 'install-instruction-sequence) (lambda (seq) (set! the-instruction-sequence seq))) ((eq? message 'allocate-register) allocate-register) ((eq? message 'get-register) lookup-register) ((eq? message 'install-operations) (lambda (ops) (set! the-ops (append the-ops ops)))) ((eq? message 'stack) stack) ((eq? message 'operations) the-ops) ((eq? message 'get-counter) the-instruction-counter) ;counterの取得 ((eq? message 'initilize-counter) (initilize-counter)) ;counterの初期化 (else (error "Unknown request -- MACHINE" message)))) dispatch)))
test
gosh> (get-register-contents fact-machine 'val) 3628800 gosh> (fact-machine 'counter) 104