SICP演習問題5.11

SICPと関係ないけれど，早く夏が終わらないかなぁ.....

a

(define fib-machine
  (make-machine
   '(continue val n)
   (list (list '< <) (list '= =) (list '- -) (list '+ +) (list 'print print))
   '(controller
     (assign continue (label fib-done))
    fib-loop
     (test (op <) (reg n) (const 2))
     (branch (label immediate-answer))
     ;; set up to compute Fib(n-1)
     (save continue)
     (assign continue (label afterfib-n-1))
     (save n)
     (assign n (op -) (reg n) (const 1))
     (perform (op print) (const 11))
     (goto (label fib-loop))
    afterfib-n-1
     (restore n)
     (perform (op print) (reg n))
     ;; set up to compute Fib(n-2)
     (assign n (op -) (reg n) (const 2))
     (assign continue (label afterfib-n-2))
     (save val)
     (perform (op print) (const 22))
     (goto (label fib-loop))
    afterfib-n-2
     (assign n (reg val)) ;; 省略可能
     (restore val)　　     ;; 省略可能
     (restore n)　　　　 ;; 上の2つを省略した場合，これを入れる
     (restore continue)
     (assign val
             (op +) (reg val) (reg n))
     (perform (op print) (const 33))
     (goto (reg continue))
    immediate-answer
     (assign val (reg n))
     (perform (op print) (const 44))
     (goto (reg continue))
    fib-done)))

いまいちよくわからなったので，手でスタックの動きを確かめた．

(assign n (reg val))
(restore val)

では，valの値をnに保存しておいて，valにスタックの先頭の値を入れる

; (assign n (reg val))
; (restore val)
(restore n)

では，valに値を入れるのでなく，nに入れる．valの値をnに保存しない．
そのため，valとnの値が逆になる．

b

saveするときに，レジスタの名前といっしょに保存する．
restoreするときに，名前が一致するかどうかを確認する．

;; exercise 5.11b
(define (make-save instruction machine stack pc)
  (let* ((reg-name (stack-instruction-reg-name instruction))
         (reg (get-register machine reg-name)))
    (lambda ()
      (push stack (cons reg-name (get-contents reg)))
      (advance-pc pc))
    ))
(define (make-restore instruction machine stack pc)
  (let* ((reg-name (stack-instruction-reg-name instruction))
         (reg (get-register machine reg-name)))
    (lambda ()
      (let ((st (pop stack)))
        (if (eq? reg-name (car st))
            (begin
              (set-contents! reg (cdr st))
              (advance-pc pc))
            (error "Bad register name -- RESTORE" instruction))))
    ))

c

変更するものは

1. make-register
2. make-new-machineのallocate-register
3. make-save
4. make-restore

方針としては，

1. 各レジスタにスタックの機能を持たせる
2. allocate-registerのときに各レジスタのスタックを初期化する
3. saveするときはレジスタのスタックを見る
4. restoreするときはレジスタのスタックを見る

(define (make-register name)
  (let ((contents '*unassigned*)
        (stack (make-stack)))
    (define (dispatch message)
      (cond [(eq? message 'get) contents]
            [(eq? message 'set)
             (lambda (value) (set! contents value))]
            [(eq? message 'push) (stack 'push)]
            [(eq? message 'pop) (stack 'pop)]
            [(eq? message 'initialize) (stack 'initialize)]
            [else
             (error "Unknown request -- REGISTER" message)]))
    dispatch))
(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (the-instruction-sequence '()))
         :
         :
      (define (allocate-register name)
        (if (assoc name register-table)
            (error "Multiply define register: " name)
            (begin
              (let ((reg (make-register name)))
                (set! register-table
                      (cons (list name reg)
                            register-table))
                (reg 'initialize))))
        'register-allocated)
          :
          :
)
(define (make-save instruction machine stack pc)
  (let ((reg (get-register machine
                           (stack-instruction-reg-name instruction))))
    (lambda ()
      (push reg (get-contents reg))
      (advance-pc pc))
    ))

(define (make-restore instruction machine stack pc)
  (let ((reg (get-register machine
                           (stack-instruction-reg-name instruction))))
    (lambda ()
      (set-contents! reg (pop reg))
      (advance-pc pc))
    ))