Serendip

Web Studio

レジスタ名毎にスタックを用意し、スタック操作はレジスタ名を引数にとってチェックする。
スタックは連想リストを使ってレジスタ名と値のリストの形にする。

(define (make-stack)
  (let ((s '()))
       (define (push reg-name x)
         (let ((reg-stack (assoc reg-name s)))
              (if #?=reg-stack ;; リーダーマクロでスタックの中身を見る
                  (set-cdr! reg-stack (cons x (cdr reg-stack)))
                  (error "Wrong register -- PUSH" reg-name))))
       (define (pop reg-name)
         (let ((reg-stack (assoc reg-name s)))
              (if #?=reg-stack ;; リーダーマクロでスタックの中身を見る
                  (if (null? (cdr reg-stack))
                      (error "Empty stack of register -- POP" reg-name)
                      (let ((top (cadr reg-stack)))
                           (set-cdr! reg-stack (cddr reg-stack))
                           top))
                  (error "Wrong register -- POP" reg-name))))
       (define (add-register-to-stack reg-name)
         (if (assoc reg-name s)
             (error "Already registered -- STACK" reg-name)
             (set! s (cons (cons reg-name '()) s))))
       (define (initialize)
         (map (lambda (stack) (set-cdr! stack '())) s)
         'done)
       (define (dispatch message)
         (cond ((eq? message 'push) push)
               ((eq? message 'pop) pop)
               ((eq? message 'add-register) add-register-to-stack)
               ((eq? message 'initialize) (initialize))
               (else (error "Unknown request -- STACK"
                            message))))
       dispatch))

(define (pop stack reg-name)
  ((stack 'pop) reg-name))

(define (push stack reg-name value)
  ((stack 'push) reg-name value))

基本計算機を作る際にレジスタの登録と一緒にスタックへのレジスタ名の登録も行う。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
  ;; 省略
            (define (allocate-register name)
              (if (assoc name register-table)
                  (error "Multiply defined register: " name)
                  (begin
                    (set! register-table
                          (cons (list name (make-register name))
                                register-table))
                    ((stack 'add-register) name)
                    'register-allocated)))
  ;; 省略
            dispatch)))

make-save と make-restore の手続きも変更しておく。

(define (make-save inst machine stack pc)
  (let ((reg-name (stack-inst-reg-name inst)))
       (let ((reg (get-register machine reg-name)))
            (lambda ()
                    (push stack reg-name (get-contents reg))
                    (advance-pc pc)))))

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

以下の計算機でレジスタの内容を見ながら、動作を確認してみる。

(define test-machine
  (make-machine
    '(a b)
    '()
    '(start
       (assign a (const 1))
       (assign b (const 2))
       (save a)
       (save b)
       (restore a)
       (restore b)
       (goto (label done))
      done)))

(start test-machine)

(print "a is "
         (get-register-contents test-machine 'a))

(print "b is "
         (get-register-contents test-machine 'b))

実行結果

gosh> test-machine
gosh> #?=reg-stack
#?-    (a)
#?=reg-stack
#?-    (b)
#?=reg-stack
#?-    (a 1)
#?=reg-stack
#?-    (b 2)
done
gosh> a is 1
#<undef>
gosh> b is 2
#<undef>

スタックがレジスタ名毎に分かれている様子が確認できる。

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る