SICP 読み (256) 5.2 レジスタ計算機での計算
数字的に縁起が良いので新たなエントリを起こす (謎
午後は借りてきた映画とか見ながらだらだらしてたので見終わってから検討着手。
問題 5.11 の b.
なんとなくレジスタの名前な部分が微妙だったのですが、先に試験から。
(test-section "make-save & make-restore (normal)") (let ((m (make-new-machine))) (for-each (lambda (register-name) ((m 'allocate-register) register-name)) '(a b)) (set-contents! ((m 'get-register) 'a) 1) (set-contents! ((m 'get-register) 'b) 2) (let ((thunk1 (make-save '(save a) m (m 'stack) ((m 'get-register) 'pc))) (thunk2 (make-restore '(restore a) m (m 'stack) ((m 'get-register) 'pc)))) (test* "stack is null" *test-error* ((m 'stack) 'pop)) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (thunk1) (set-contents! ((m 'get-register) 'a) 2) (test* "a" 2 (get-contents ((m 'get-register) 'a))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (thunk2) (test* "a" 1 (get-contents ((m 'get-register) 'a))))) (test-section "make-save & make-restore (error)") (let ((m (make-new-machine))) (for-each (lambda (register-name) ((m 'allocate-register) register-name)) '(a b)) (set-contents! ((m 'get-register) 'a) 1) (set-contents! ((m 'get-register) 'b) 2) (let ((thunk1 (make-save '(save a) m (m 'stack) ((m 'get-register) 'pc))) (thunk2 (make-restore '(restore b) m (m 'stack) ((m 'get-register) 'pc)))) (test* "stack is null" *test-error* ((m 'stack) 'pop)) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (thunk1) (test* "invalid pop" *test-error* (thunk2))))
で、本体に盛り込み。push または pop するレジスタの名前が入手できれば話は早い。
(define (make-save inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (push stack (list (stack-inst-reg-name inst) (get-contents reg))) (advance-pc pc)))) (define (make-restore inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (let ((s (pop stack))) (if (eq? (car s) (stack-inst-reg-name inst)) (set-contents! reg (pop stack)) (error "invalid register -- ASSEMBLE" inst))) (advance-pc pc))))
で試験してみると既存なソレ方面への盛り込みを忘れている。(とほほほ
てーか、make-restore 駄目だし。正しくは以下。
(define (make-restore inst machine stack pc) (let ((reg (get-register machine (stack-inst-reg-name inst)))) (lambda () (let ((s (pop stack))) (if (eq? (car s) (stack-inst-reg-name inst)) ; (set-contents! reg (pop stack)) (set-contents! reg (cadr s)) (error "invalid register -- ASSEMBLE" inst))) (advance-pc pc))))
あと直接
(test* "pop" 1 ((m 'stack) 'pop))
みてーなコトしてるナニがあった。これは試験の方法が微妙ってコトですな。c. は微妙に面倒なので今日なんとかなると思えないのですが、頑張れれば頑張ってみるとゆー事にしておきます。(を