SICP 読み (270) 5.2 レジスタ計算機での計算
次の問題はなんとなくボリューム少なそげ。ってか、試験が書けそうにない感じ。
問題 5.18
最初、試験からと思ったんですが、レジスタのトレース機能として印字しか無いってコトは test* で試験できないでないの、と。面倒臭いのでどんどん機能を盛り込んでしまう。
まずは make-register からなんですがこんな感じ??
(define (make-register name)
(let ((contents '*unassigned*)
(trace #f))
(define (dispatch message)
(cond ((eq? message 'get) contents)
((eq? message 'set)
(lambda (value)
(if trace
(begin
(newline)
(display (list name contents value))))
(set! contents value)))
((eq? message 'trace-on)
(set! trace #t))
((eq? message 'trace-off)
(set! trace #f))
(else
(error "Unknown request -- REGISTER" message))))
dispatch))gosh 上で動作の確認。
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "ch5-regsim")
#t
gosh> (define reg (make-register 'a))
reg
gosh> (reg 'get)
*unassigned*
gosh> ((reg 'set) 1)
1
gosh> (reg 'get)
1
gosh> (reg 'trace-on)
#t
gosh> ((reg 'set) 2)
(a 1 2)
2
gosh> (reg 'get)
2
gosh> トレイスなメセジが微妙ですがスルー (を
次は machine への盛り込みですか。
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(inst-ctr 0) ;; 5.15
(trace #f) ;; 5.16
(the-instruction-sequence '()))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))
;;**next for monitored stack (as in section 5.2.4)
;; -- comment out if not wanted
(list 'print-stack-statistics
(lambda () (stack 'print-statistics)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (init-inst-ctr) ;; 5.15
(set! inst-ctr 0)) ;; 5.15
(define (get-inst-ctr) ;; 5.15
inst-ctr) ;; 5.15
(define (trace-on) (set! trace #t)) ;; 5.16
(define (trace-off) (set! trace #f)) ;; 5.16
(define (reg-trace-on) ;; 5.18
(lambda (reg-name) ;; 5.18
((lookup-register reg-name) 'trace-on))) ;; 5.18
(define (reg-trace-off) ;; 5.18
(lambda (reg-name) ;; 5.18
((lookup-register reg-name) 'trace-off))) ;; 5.18
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " 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
(if trace ;; 5.16
(begin ;; 5.16
; (display (instruction-text (car insts))) ;; 5.16
(display (car (car insts))) ;; 5.17
(newline))) ;; 5.16
((instruction-execution-proc (car insts)))
(set! inst-ctr (+ inst-ctr 1)) ;; 5.15
(execute)))))
(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 'init-inst-ctr) (init-inst-ctr)) ;; 5.15
((eq? message 'get-inst-ctr) (get-inst-ctr)) ;; 5.15
((eq? message 'trace-on) (trace-on)) ;; 5.16
((eq? message 'trace-off) (trace-off)) ;; 5.16
((eq? message 'reg-trace-on) (reg-trace-on)) ;; 5.18
((eq? message 'reg-trace-off) (reg-trace-off)) ;; 5.18
(else (error "Unknown request -- MACHINE" message))))
dispatch)))えらく make-new-machine がデカくなったな、と言いつつ gosh で動作の確認。
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.7/lib")
gosh> (load "ch5-regsim")
#t
gosh> (define m (make-machine '(n continue val)
(list (list '= =)
(list '- -)
(list '* *))
'(controller
(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)))
m
gosh> ((m 'reg-trace-on) 'n)
#t
gosh> (set-register-contents! m 'n 3)
(n *unassigned* 3)
done
gosh> (m 'start)
(n 3 2)
(n 2 1)
(n 1 2)
(n 2 3)
done
gosh> (get-register-contents m 'val)
6
gosh> ((m 'reg-trace-off) 'n)
#f
gosh> (set-register-contents! m 'n 3)
done
gosh> (m 'start)
done
gosh> (get-register-contents m 'val)
6
gosh> 順に引いてって 1 になったら順に restore しているのが分かる。continue とかを trace したら微妙な出力が (以下略
ってーかレジスタがトレース可能ってコトは pc も trace 可能なのか。てーか次の問題の解が出たら色々な意味で遊べそう。わははは。
追記
えらい簡単にできたのでもう少し追試を予定。あと 5.17 あたりで既存の試験にパスしなくなってるんで現実トウヒがてら試験も修正してから次に着手かも。何かネタになればさらに追記するかもしれません。
