Exercise 5.15. Add *instruction counting* to the register machine simulation. That is, have the machine model keep track of the number of instructions executed. Extend the machine model’s interface to accept a new message that prints the value of the instruction count and resets the count to zero.
增加的 instruction counting 如下。只需要在 execute 中 instruction 执行之前对 counting 增加就可以。
(load "machine-register-module.scm")
(load "machine-machine-module.scm")
(load "machine-assemble-module.scm")
(load "machine-new-stack-module.scm")
(define (make-machine regs ops controller-text)
(let ((machine (make-new-machine)))
(for-each (lambda (name)
((machine 'allocate-register) name))
regs)
((machine 'install-operations) ops)
((machine 'install-instruction-sequence)
(assemble controller-text machine))
machine))
(define (make-new-machine)
(let ((stack (make-stack))
(flag (make-register))
(pc (make-register))
(the-instruction-sequence '())
(inst-count 0))
(let ((regs (list (cons 'pc pc)
(cons 'flag flag))) ; assoc of name->register-object
(the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize))))))
(define (allocate-register name)
(if (assoc name regs)
(error 'machine "register exists: " name)
(set! regs (cons (cons name (make-register)) regs)))
'register-allocated)
(define (lookup-register name)
(let ((r (assoc name regs)))
(if r
(cdr r)
(error 'machine "Unknown register: " name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
(set! inst-count (+ 1 inst-count))
((instruction-execution-proc (car insts)))
(execute)))))
(define (reset)
(set! inst-count 0))
(define (print-inst-count)
(newline)
(display (list 'instructions '= inst-count)))
(define (dispatch msg)
(cond ((eq? msg 'allocate-register) allocate-register)
((eq? msg 'lookup-register) lookup-register)
((eq? msg 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? msg 'stack) stack)
((eq? msg 'operations) the-ops)
((eq? msg 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? msg 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? msg 'reset) (reset))
((eq? msg 'print-inst-count) (print-inst-count))
(else
(error 'machine "Unknown message: " msg))))
dispatch)))
进行下面的测试
(load "machine-register-module.scm")
(load "machine-machine-module.scm")
(load "machine-assemble-module.scm")
(load "machine-new-stack-module.scm")
(define (make-machine regs ops controller-text)
(let ((machine (make-new-machine)))
(for-each (lambda (name)
((machine 'allocate-register) name))
regs)
((machine 'install-operations) ops)
((machine 'install-instruction-sequence)
(assemble controller-text machine))
machine))
(define (make-new-machine)
(let ((stack (make-stack))
(flag (make-register))
(pc (make-register))
(the-instruction-sequence '())
(inst-count 0))
(let ((regs (list (cons 'pc pc)
(cons 'flag flag))) ; assoc of name->register-object
(the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize))))))
(define (allocate-register name)
(if (assoc name regs)
(error 'machine "register exists: " name)
(set! regs (cons (cons name (make-register)) regs)))
'register-allocated)
(define (lookup-register name)
(let ((r (assoc name regs)))
(if r
(cdr r)
(error 'machine "Unknown register: " name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
(set! inst-count (+ 1 inst-count))
((instruction-execution-proc (car insts)))
(execute)))))
(define (reset)
(set! inst-count 0))
(define (print-inst-count)
(newline)
(display (list 'instructions '= inst-count)))
(define (dispatch msg)
(cond ((eq? msg 'allocate-register) allocate-register)
((eq? msg 'lookup-register) lookup-register)
((eq? msg 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? msg 'stack) stack)
((eq? msg 'operations) the-ops)
((eq? msg 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? msg 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? msg 'reset) (reset))
((eq? msg 'print-inst-count) (print-inst-count))
(else
(error 'machine "Unknown message: " msg))))
dispatch)))
输出
(instructions = 16)
(instructions = 27)
(instructions = 38)
(instructions = 49)
(instructions = 60)
(instructions = 71)
;... done
;Unspecified return value