次にmake-machineはこの基本モデルを, (メッセージを送ることで)定義しようとする特定の計算機のレジスタ, 演算および制御器を含むように拡張する. まず渡されたレジスタ名のそれぞれに新しい計算機のレジスタを割り当て, 指示された演算を計算機に組み込む. 次に(次の5.2.2節に述べる) アセンブラ(assembler)を使い, 制御器のリストを新しい計算機の命令に変換し, これを計算機の命令列として組み込む. make-machineは, 修正した計算機モデルをその値として返す.
(define (make-machine register-names ops controller-text) (let ((machine (make-new-machine))) (for-each (lambda (register-name) ((machine 'allocate-register) register-name)) register-names) ((machine 'install-operations) ops) ((machine 'install-instruction-sequence) (assemble controller-text machine)) machine))
(define (make-register name) (let ((contents '*unassigned*)) (define (dispatch message) (cond ((eq? message 'get) contents) ((eq? message 'set) (lambda (value) (set! contents value))) (else (error "Unknown request -- REGISTER" message)))) dispatch))次の手続きはレジスタにアクセスするのに使う:
(define (get-contents register) (register 'get)) (define (set-contents! register value) ((register 'set) value))
(define (make-stack) (let ((s '())) (define (push x) (set! s (cons x s))) (define (pop) (if (null? s) (error "Empty stack -- POP") (let ((top (car s))) (set! s (cdr s)) top))) (define (initialize) (set! s '()) 'done) (define (dispatch message) (cond ((eq? message 'push) push) ((eq? message 'pop) (pop)) ((eq? message 'initialize) (initialize)) (else (error "Unknown request -- STACK" message)))) dispatch))次の手続きは, スタックにアクセスするのに使う.
(define (pop stack) (stack 'pop)) (define (push stack value) ((stack 'push) value))
flagレジスタはシミュレートされる計算機で分岐を制御するのに使う. test命令はflagの内容をテストの結果(真または偽)に設定する. branch命令はflagの内容を調べ, 分岐する, しないを決定する.
pcレジスタは, 計算機が走る時の命令の進行を制御する. この進行は内部手続きexecuteが実装する. シミュレーションモデルでは,
各機械命令は,
命令実行手続き(instruction execution procedure)という, その手続きの呼出しがその命令の実行をシミュレートすることになる, 引数のない手続きを含むデータ構造である. シミュレーションが進むと, pcは実行すべき次の命令から始る命令列の場所を指す.
executeは, その命令をとり, その命令実行手続きを呼び出してそれを実行し, このサイクルを実行する命令がなくなる(つまりpcが命令列の終りを指す)まで繰り返す.
(define (make-new-machine) (let ((pc (make-register 'pc)) (flag (make-register 'flag)) (stack (make-stack)) (the-instruction-sequence '())) (let ((the-ops (list (list 'initialize-stack (lambda () (stack 'initialize))))) (register-table (list (list 'pc pc) (list 'flag flag)))) (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 ((instruction-execution-proc (car insts))) (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) (else (error "Unknown request -- MACHINE" message)))) dispatch)))図5.13 基本計算機モデルを実装するmake-new-machine手続き
各命令実行手続きは実行すべき次の命令を示すため, 演算の一部としてpcを修正する. branchとgoto命令は新しい行き先を指すようにpcを変更する. 他の命令はすべて列の中の次の命令を指すように単にpcを進める. executeの各呼出しがもう一度executeを呼び出すことに注意しよう. しかし命令実行手続きの実行はpcの内容を変更するので, 無限ループになることはない.
make-new-machineは内部状態へのメッセージパッシングアクセスを実装するdispatch手続きを返す. 計算機の実行開始はpcを命令列の先頭に設定し, executeを呼び出すことで実現する.
5.2節の先頭で示したような, レジスタの内容の設定と検査の手続きの他に, 便宜のため, 計算機のstart演算の手続きインターフェースをもう一つ用意する.
(define (start machine) (machine 'start)) (define (get-register-contents machine register-name) (get-contents (get-register machine register-name))) (define (set-register-contents! machine register-name value) (set-contents! (get-register machine register-name) value) 'done)これらの手続き(と, 5.2.2節, 5.2.3節の多くの手続き)は, 与えられた計算機の与えられた名前のレジスタを探すのに, 次を使う:
(define (get-register machine reg-name) ((machine 'get-register) reg-name))