and, or, not を用いて排他的論理和を求める関数 xor p q を定義してください。
| p | q | xor |
|---|---|---|
| #f | #f | #f |
| #f | #t | #t |
| #t | #f | #t |
| #t | #t | #f |
gosh> (xor #f #f) #f gosh> (xor #f #t) #t gosh> (xor #t #f) #t gosh> (xor #t #t) #f
2 つの真偽値 p, q を与えたとき、次に示すような真偽値 s, c を出力する関数 half-adder p q を定義してください。s, c は多値で返すものとします。
| p | q | s | c |
|---|---|---|---|
| #f | #f | #f | #f |
| #f | #t | #t | #f |
| #t | #f | #t | #f |
| #t | #t | #f | #t |
gosh> (half-adder #f #f) #f #f gosh> (half-adder #f #t) #t #f gosh> (half-adder #t #f) #t #f gosh> (half-adder #t #t) #f #t
3 つの真偽値 p, q, r を与えたとき、次に示すような真偽値 s, c を出力する関数 full-adder p q を定義してください。s, c は多値で返すものとします。
| p | q | r | s | c |
|---|---|---|---|---|
| #f | #f | #f | #f | #f |
| #f | #t | #f | #t | #f |
| #t | #f | #f | #t | #f |
| #t | #t | #f | #f | #t |
| #f | #f | #t | #t | #f |
| #f | #t | #t | #f | #t |
| #t | #f | #t | #f | #t |
| #t | #t | #t | #t | #t |
gosh> (full-adder #f #f #f) #f #f gosh> (full-adder #t #t #f) #f #t gosh> (full-adder #f #f #t) #t #f gosh> (full-adder #t #t #t) #t #t
#t, #f とリストで n ビットの無符号整数を表すことにします。これを uint と呼ぶことにしましょう。たとえば、0 と 255 を 8 桁の unit で表すと次のようになります。
MSB LSB
0 : (#f #f #f #f #f #f #f #f)
255 : (#t #t #t #t #t #t #t #t)
0 以上の整数値 n を m 桁の uint に変換する関数 int->uint n m と、uint を整数値に変換する関数 uint->int x を定義してください。
gosh> (int->uint 0 8) (#f #f #f #f #f #f #f #f) gosh> (int->uint 127 8) (#f #t #t #t #t #t #t #t) gosh> (int->uint 128 8) (#t #f #f #f #f #f #f #f) gosh> (int->uint 255 8) (#t #t #t #t #t #t #t #t) gosh> (uint->int '(#f #f #f #f)) 0 gosh> (uint->int '(#f #t #t #t)) 7 gosh> (uint->int '(#t #t #t #t)) 15
uint で論理演算を行う関数 uint-and, uint-or, uint-xor, uint-not を定義してください。
gosh> (uint-and '(#t #t #f #f) '(#t #f #t #f)) (#t #f #f #f) gosh> (uint-or '(#t #t #f #f) '(#t #f #t #f)) (#t #t #t #f) gosh> (uint-xor '(#t #t #f #f) '(#t #f #t #f)) (#f #t #t #f) gosh> (uint-not '(#t #f #t #f)) (#f #t #f #t)
2 つの uint を加算する関数 uint-add x y を定義してください。uint-add は多値を返します。桁あふれが生じた場合、2 番目の返り値は #t になります。なお、x, y の桁は同じものとします。
gosh> (uint-add '(#f #f #f #t) '(#f #f #t #t)) (#f #t #f #f) #f gosh> (uint-add '(#f #f #f #t) '(#t #t #t #t)) (#f #f #f #f) #t
uint を +1 する関数 uint-inc x を定義してください。uint-inc は多値を返します。桁あふれが生じた場合、2 番目の返り値は #t になります。
gosh> (uint-inc '(#f #f #f #f)) (#f #f #f #t) #f gosh> (uint-inc '(#t #t #t #t)) (#f #f #f #f) #t
2 つの uint を減算する関数 uint-sub x y を定義してください。uint-sub は多値を返します。桁借りが生じた場合、2 番目の返り値は #t になります。なお、x, y の桁は同じものとします。
gosh> (uint-sub '(#t #t #t #f) '(#f #t #f #t)) (#t #f #f #t) #f gosh> (uint-sub '(#t #t #t #f) '(#t #t #t #t)) (#t #t #t #t) #t gosh> (uint-sub '(#t #t #t #t) '(#t #t #t #t)) (#f #f #f #f) #f
uint を左へ 1 ビット論理シフトする関数 uint-sll と、右へ 1 ビット論理シフトする関数 uint-srl を定義してください。uint-sll と uint-srl は多値を返します。2 番目の返り値は uint-sll であれば MSB、uint-srl であれば LSB になります。
gosh> (uint-srl '(#t #f #t #f)) (#f #t #f #t) #f gosh> (uint-srl '(#f #t #f #t)) (#f #f #t #f) #t gosh> (uint-sll '(#t #f #t #f)) (#f #t #f #f) #t gosh> (uint-sll '(#f #t #f #f)) (#t #f #f #f) #f
uint を使って次に示す仮想計算機のシミュレータを作ってください。
| 命令 | Code | 機能 |
|---|---|---|
| jump | 000 | of が偽の場合、指定した番地 (adr) へジャンプする of が真の場合はジャンプしない |
| add | 001 | acc += memory[adr] |
| sub | 010 | acc -= memory[adr] |
| load | 011 | acc = memory[adr] |
| store | 100 | memory[adr] = acc |
| sll | 101 | acc を adr ビット左シフトする |
| srl | 110 | acc を adr ビット右シフトする |
| svc | 111 | adr = 0 : 仮想マシンを停止する adr = 1 : 数値を入力して acc にセットする adr = 2 : acc を出力する |
なお、仮想計算機の仕様は スロースキャンコンピュータ を参考にさせていただきました。
真偽値 p, q の論理演算は全部で 16 通りあります。これらの論理演算は not, and, or の組み合わせで実現することができます。
否定
p not
----------
#f #t
#t #f
論理積 論理和 否定論理積 否定論理和 排他的論理和
p q and or nand nor xor
-------------------------------------------------------------
#f #f #f #f #t #t #f
#f #t #f #t #t #f #t
#t #f #f #t #t #f #t
#t #t #t #t #f #f #f
演算結果が #t となる所に注目します。排他的論理和の場合、p = #f, q = #t または p = #t, q = #f のときに結果は #t になります。最初の条件は (and (not p) q) で、2 番目の条件は (and p (not q)) で表すことができます。あとは 2 つの条件式を or で結合すればいいわけです。プログラムは次のようになります。
リスト : 排他的論理和 (define (xor p q) (or (and (not p) q) (and p (not q)))) ; 別解 (define (xor p q) (and (or p q) (not (and p q))))
別解はブール代数の定理を用いて求めることができます。上図の or と nand の and を計算すると、確かに xor になることがわかります。
真理値表から s = p xor q, c = p and q であることがすぐにわかります。
リスト : 半加算器 (define (half-adder p q) (values (xor p q) (and p q)))
これを論理回路で実現すると「半加算器」になります。s は 1 ビットの加算、c が桁上がりを表します。ただし、半加算器は入力が 2 つしかないので、下位の桁上がりを受け取ることができません。整数の加算回路を実現するには、次に示す全加算器を使います。
r を桁上がりと考えると、真理値表は 1 ビットの加算を表していることがわかります。この真理値表を出力する論理回路を「全加算器」といいます。全加算器は 2 つの半加算器と or を使って実現することができます。
リスト : 全加算器
(define (full-adder p q r)
(receive (a b) (half-adder p q)
(receive (c d) (half-adder a r)
(values c (or b d)))))
最初に p と q を half-adder で加算します。値は a, b にセットします。次に、a と r を half-adder で加算します。値は c と d にセットします。加算の結果は c になり、桁上がりは (or b d) で求めることができます。
リスト : 数値を m 桁の uint に変換
(define (int->uint n m)
(let loop ((n n) (a '()))
(if (= (length a) m)
a
(loop (ash n -1) (cons (odd? n) a)))))
int->uint は簡単です。ビットオンを #t に、ビットオフを #f に変換するだけです。数値 n が奇数の場合、LSB は 1 なので累積変数 a に #t を追加します。そうでなければ #f を追加します。この処理は述語 odd? を使うと簡単です。あとは n を右へ 1 ビットシフトして、ビットを順番に調べていくだけです。
リスト : uint を数値に変換 (define (uint->int x) (fold (lambda (n a) (+ (* a 2) (if n 1 0))) 0 x))
uint->int も簡単です。fold で要素を順番に取り出し、要素 n が #t ならば累積変数 a を 2 倍して 1 を足し算します。#f ならば 1 を足し算しません。
リスト : 論理演算 ; 論理積 (define (uint-and x y) (map (lambda (a b) (and a b)) x y)) ; 論理和 (define (uint-or x y) (map (lambda (a b) (or a b)) x y)) ; 排他的論理和 (define (uint-xor x y) (map xor x y)) ; 否定 (define (uint-not x) (map not x))
論理演算は map を使うと簡単です。and と or はシンタックス形式なので、直接 map に渡すことはできません。このため、ラムダ式の中で (and a b) と (or a b) を評価しています。
リスト : 加算
(define (uint-add x y)
(apply
values
(fold-right
(lambda (n m a)
(receive (s c) (full-adder n m (cadr a))
(list (cons s (car a)) c)))
(list '() #f)
x
y)))
uint-add は fold-right と full-adder を使うと簡単です。fold-right でリスト x, y の最後尾の要素から full-adder を順番に適用して加算処理を行います。ラムダ式の引数 n がリスト x の要素、m がリスト y の要素、a が累積変数です。a はリストで先頭要素が uint を表すリスト、次の要素が桁上がりの有無を表す真偽値です。初期値は空リストと #f に設定します。最後に apply で values を評価して結果を多値で返します。
リスト : uint をインクリメントする
(define (uint-inc x)
(apply
values
(fold-right
(lambda (n a)
(receive (s c) (half-adder n (cadr a))
(list (cons s (car a)) c)))
(list '() #t)
x)))
uint-inc は uint-add とほとんど同じです。fold-right に渡す初期値を空リストと #t に設定します。これで引数 x を +1 することができます。
減算は 2 の補数を使って計算します。簡単な例として 4 ビットの整数値を考えてみましょう。負の整数を 2 の補数で表した場合、4 ビットで表される整数は -8 から 7 になります。次の図を見てください。
0 : 0000
1 : 0001 -1 : 1111
2 : 0010 -2 : 1110
3 : 0011 -3 : 1101
4 : 0100 -4 : 1100
5 : 0101 -5 : 1011
6 : 0110 -6 : 1010
7 : 0111 -7 : 1001
-8 : 1000
図 : 2 の補数
2 の補数はビットを反転した値 (1 の補数) に 1 を加算することで求めることができます。たとえば 7 - 2 は 7 + (-2) = 0111 + 1110 = 1 0101 となり、桁上がりを無視すると値は 5 になります。また、15 - 14 は (-1) - (-2) = (-1) + 2 = 1111 + 0010 = 1 0001 となり、正しく計算することができます。
逆に、2 - 7 は 2 + (-7) = 0010 + 1001 = 1011 になります。この場合、2 の補数で考えると 1011 は -5 になるので、符号付き整数では正しい値になりますが、無符号整数で考えると桁借りが発生しています。したがって、減算したときの桁借りの有無は、加算したときの桁上がりの値を反転することで求めることができます。
プログラムは次のようになります。
リスト : 減算
(define (uint-sub x y)
(receive (s c)
(uint-add x (uint-inc (uint-not y)))
(values s (not c))))
(uint-not y) で 1 の補数を求め、uint-inc で +1 することで 2 の補数を求めることができます。あとは uint-add で x と加算するだけです。values で値を返すとき、not で c の値を反転することをお忘れなく。
リスト : 論理シフト
(define (butlast xs)
(if (null? (cdr xs))
'()
(cons (car xs) (butlast (cdr xs)))))
(define (uint-srl x)
(values (cons #f (butlast x)) (last x)))
(define (uint-sll x)
(values (append (cdr x) (list #f)) (car x)))
論理シフトも簡単です。uint-srl は butlast で最後尾のセルを取り除き、先頭に #f を追加します。last は srfi-1 で定義されている関数で、最後尾の要素を取り出します。uint-sll は cdr で先頭要素を取り除き、append で最後尾に (#f) を追加するだけです。
それではプログラムを作りましょう。最初にグローバル変数を定義します。次のリストを見てください。
リスト : グローバル変数の定義 ; アキュムレータ (define *acc* #f) ; プログラムカウンタ (define *pc* #f) ; オーバーフローフラグ (define *of* #f) ; 0 (define *zero* (make-list 8 #f)) ; メモリ (define *memory* (make-vector 32))
レジスタ acc, pc, of の値は、グローバル変数 *acc*, *pc*, *of* にセットします。メモリはベクタで表します。make-vector で大きさ 32 のベクタを生成して、グローバル変数 *memory* にセットします。このほかに 0 を表す uint を *zero* にセットします。
次は操作関数を定義します。
リスト : 操作関数の定義
; メモリの読み込み
(define (read-memory adr)
(vector-ref *memory* (uint->int adr)))
; メモリの書き込み
(define (write-memory adr val)
(vector-set! *memory* (uint->int adr) val))
; フェッチ
(define (fetch)
(begin0
(vector-ref *memory* (uint->int *pc*))
(set! *pc* (uint-inc *pc*))))
; デコード
(define (decode code)
(cond ((equal? '(#f #f #f) code) 'jump)
((equal? '(#f #f #t) code) 'add)
((equal? '(#f #t #f) code) 'sub)
((equal? '(#f #t #t) code) 'load)
((equal? '(#t #f #f) code) 'store)
((equal? '(#t #f #t) code) 'sll)
((equal? '(#t #t #f) code) 'srl)
((equal? '(#t #t #t) code) 'svc)
(else
(error "invalid operation"))))
; データの入力
(define (get-number n)
(if (and (integer? n) (<= 0 n 255))
n
(error "invalid number")))
read-memory は *memory* の adr 番地からデータを読み込みます。write-memory は *memory* の adr 番地に val を書き込みます。fetch は *memory* の *pc* 番地に格納されている命令を読み取り、*pc* の値を +1 します。このとき、桁上がりは無視しすることに注意してください。*pc* が 31 の場合は +1 すると 0 になります。
decode はフェッチで取り出した命令を解読します。これをデコードといいます。引数 code には命令を表す上位 3 ビットを渡します。返り値は命令を表すシンボルです。get-number はデータを入力するときに使います。0 以上 255 以下の整数値を受け取って返します。それ以外のデータはエラーを送出します。
次は命令を実行する仮想マシン本体を作ります。
リスト : 仮想マシン
(define (ssc-vm halt)
; 初期化
(set! *acc* *zero*)
(set! *pc* (drop *zero* 3))
(set! *of* #f)
; 実行
(let loop ()
(let* ((val (fetch))
(op (decode (take val 3)))
(adr (drop val 3)))
(case op
((jump)
(unless *of* (set! *pc* adr)))
((add)
(set!-values (*acc* *of*)
(uint-add *acc* (read-memory adr))))
((sub)
(set!-values (*acc* *of*)
(uint-sub *acc* (read-memory adr))))
((load)
(set! *acc* (read-memory adr)))
((store)
(write-memory adr *acc*))
((sll)
(do ((x (uint->int adr) (- x 1)))
((zero? x))
(set!-values (*acc* *of*) (uint-sll *acc*))))
((srl)
(do ((x (uint->int adr) (- x 1)))
((zero? x))
(set!-values (*acc* *of*) (uint-srl *acc*))))
((svc)
(case (uint->int adr)
((0) ; halt
(halt #t))
((1) ; read
(set! *acc* (int->uint (get-number (read)) 8)))
((2) ; write
(dislay *acc*)
(newline))))))
(loop)))
最初に *acc*, *pc*, *of* を初期化します。あとは、named-let で loop を作り、その中でフェッチ、デコード、実行を繰り返すだけです。つまり、停止命令を実行しない限り、仮想計算機はずっと動作し続けることになります。
jump は *of* の値をチェックし、偽ならば *pc* の値を adr に書き換えます。仮想計算機は *pc* 番地の命令を実行するので、これで adr 番地へジャンプすることができます。*of* が真ならば何もしません。これで次の番地の命令が実行されます。
add と sub は簡単です。*acc* と (read-memory adr) の値を演算して、その結果を *acc* と *of* にセットするだけです。load と store も簡単です。load は adr 番地の値を *acc* にセットします。store は *acc* の値を adr 番地へ書き込むだけです。sll と srl は uint-sll, uint-srl を adr 回だけ繰り返します。
svc は adr の値で処理を分けます。adr が 0 の場合は実行を停止します。関数 ssc-vm の引数 halt には脱出先の継続が渡されるので、halt を評価すると実行を停止することができます。adr が 1 の場合は read でデータを読み込んで unit に変換して *acc* にセットします。write は display で *acc* を表示するだけです。
次は簡単なアセンブラを作ります。プログラムは次のようにリストで表します。
プログラム := ((命令 アドレス) ... (命令 アドレス))
命令はシンボル、アドレスは 0 以上 32 未満の整数値です。このほかに、メモリの値を定義するための擬似命令 dc を用意します。次のリストを見てください。
リスト : アセンブラ
(define *op-table*
'((jump . #b00000000)
(add . #b00100000)
(sub . #b01000000)
(load . #b01100000)
(store . #b10000000)
(sll . #b10100000)
(srl . #b11000000)
(svc . #b11100000)))
; アドレスの取得
(define (get-address n)
(if (and (integer? n) (<= 0 n 31))
n
(error "invalid address")))
; アセンブラ
(define (ssc-asm ls)
(let loop ((ls ls) (a '()))
(cond ((null? ls)
(reverse! a))
((< (length a) 32)
(if (eq? (caar ls) 'dc)
(loop (cdr ls) (cons (get-number (cadar ls)) a))
(let ((op (assoc (caar ls) *op-table*)))
(unless op
(error "invalid operation"))
(loop (cdr ls) (cons (+ (cdr op) (get-address (cadar ls))) a)))))
(else
(error "out of memory")))))
ssc-asm は ls をアセンブルして、その結果を格納したリストを返します。命令が dc の場合は擬似命令です。この場合は get-number で整数値 (0 - 255) を求めて、その値をそのまま累積変数 a のリストに追加します。そうでなければ、assoc で命令表 *op-table* から命令を検索します。見つからない場合はエラーを送出します。見つかった場合は get-address で整数値 (0 - 31) を求め、それと命令に対応するコードを加算してリスト a に追加します。最後に reverse! でリスト a を反転して返します。
最後に、プログラムをアセンブルして実行する関数 load-run を作ります。
リスト : 実行
(define (load-run ls)
; メモリの初期化
(dotimes (x 32) (vector-set! *memory* x *zero*))
; アセンブルとロード
(let loop ((n 0) (ls (ssc-asm ls)))
(cond ((pair? ls)
(vector-set! *memory* n (int->uint (car ls) 8))
(loop (+ n 1) (cdr ls)))))
; 実行
(call/cc
(lambda (cont) (ssc-vm cont))))
最初にメモリを *zero* で初期化します。次に、ssc-asm で ls をアセンブルし、コードをメモリへロードします。このとき、整数値を uint->int で uint に変換します。あとは ssc-vm を評価するだけです。
それでは簡単な例として、1 から n までの合計値を求めるプログラムを作りましょう。次のリストを見てください。
リスト : 合計値を求める
(define *test-sum*
'((svc 1) ; 0 : n の入力
(store 12) ; 1 : n を 12 番地に格納
(load 13) ; 2 : acc に sum をセット
(add 12) ; 3 : acc += n
(store 13) ; 4 : sum = acc
(load 12) ; 5 : acc = n
(sub 14) ; 6 : acc -= 1
(store 12) ; 7 : n = acc
(jump 2) ; 8 : of が偽ならば 2 番地へジャンプ
(load 13) ; 9 : acc = sum
(svc 2) ; 10 : sum を表示する
(svc 0) ; 11 : halt
(dc 0) ; 12 : データ n
(dc 0) ; 13 : 合計値 sum
(dc 1))) ; 14 : 数値 1
(svc 1) で入力した数値を 12 番地に格納します。合計値 sum は 13 番地に格納します。13 番地は dc で 0 に初期化しておきます。まず (load 13), (add 12), (store 13) で sum に n を加算します。次に、(load 12), (sub 14), (store 12) で n の値を -1 します。
その次に (jump 2) を実行します。n が 0 の場合、n - 1 を計算すると of が #t になります。この場合はジャンプしません。それ以外の場合、of は #f になるので 2 番地へジャンプして処理を繰り返します。最後に sum の値を表示して実行を停止します。
それでは実行してみましょう。
gosh> (load-run *test-sum*) 10 (#f #f #t #t #f #t #t #t) #t
合計値は 55 (#f #f #t #t #f #t #t #t) になります。