●仮想計算機 COMETⅡの簡易シミュレータ (5)
Common Lisp 入門 の番外編です。今回は前回追加した機能を使って COMET2A 用の簡単なサンプルプログラムを作ってみましょう。
●COMET2A 用の簡単なライブラリ
前回までに作成したサブルーチンのいくつかを COMET2A 用に書き直してライブラリ lib.cas にまとめておくことにします。また、サブルーチン内でレジスタの値を書き換える場合、GR0 以外のレジスタ (GR1 - GR7) は元の値に戻すためスタックに退避していましたが、今回から GR0 と GR1 は保護しなくてもよいことにします。それ以外のレジスタ (GR2 - GR7) は今までどおり保護するものとします。
それから、プログラムをロードして実行するとき、lib.cas をリンクするように関数 asm-run を修正します。
リスト : プログラムの実行 (defun asm-run (name &optional (dump-num 32)) (load-code (assemble (append (read-casl2-file name) (read-casl2-file "lib.cas")))) ; 0 から開始 (vm 0 dump-num))
ライブラリの詳細は プログラムリスト をお読みください。
●フィボナッチ関数
最初は簡単な再帰呼び出しの例を示しましょう。フィボナッチ (fibonacci) 関数は再帰的に定義される関数です。
フィボナッチ関数の定義 fibo(0) = 1 fibo(1) = 1 fibo(n) = fibo(n - 1) + fibo(n - 2), n > 1 1, 1, 2, 3, 5, 8, 13 .... という直前の 2 項を足していく数列
階乗と同様に、フィボナッチ関数も再帰定義を使えば簡単にプログラムできます。Common Lisp でプログラムすると次のようになります。
リスト : フィボナッチ関数
(defun fibo (n)
(if (< n 2)
1
(+ (fibo (1- n)) (fibo (- n 2)))))
* (dotimes (x 20) (print (fibo x))) 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 NIL
関数 fibo は階乗のプログラムとは違い、自分自身を 2 回呼び出しています。これを「二重再帰」といいます。fibo の関数呼び出しをトレースすると下図のようになります。
図 : 関数 fibo のトレース
同じ値を何回も求めているため、効率はとても悪くなります。これを COMET2A でプログラムすると次のようになります。
リスト : フィボナッチ関数
; 入力 +2) : N
; 出力 gr0
fibo
(link gr7 0)
(push 0 gr2)
(lad gr1 2)
(ld gr0 2 gr7)
(cpl gr0 gr1)
(jmi fibo-lab1) ; N は 2 未満
(ld gr1 gr0)
(lad gr1 -1 gr1) ; N - 1 -> gr1
(push 0 gr1)
(call fibo) ; -> gr0
(pop gr1)
(ld gr2 gr0) ; fibo(N-1) -> gr2
(lad gr1 -1 gr1) ; N - 2 -> gr1
(push 0 gr1)
(call fibo) ; fibo(N-2) -> gr0
(pop gr1)
(addl gr0 gr2) ; fibo(N-1) + fibo(N-2)
fibo-exit
(pop gr2)
(unlk gr7)
(ret)
fibo-lab1
(lad gr0 1)
(jump fibo-exit)
最初に引数 N を取り出して gr0 にセットします。gr0 が 2 未満の場合は fibo-lab1 へジャンプし、gr0 に返り値 1 をセットします。そうでなければ、fibo を 2 回再帰呼び出しします。とくに難しいところはないので、コメントをみながらリストをお読みください。
テストプログラムと実行結果を示します。
リスト : フィボナッチ関数のテスト
test-fibo
(lad gr3 0)
(lad gr4 20)
test-fibo-loop
(cpl gr3 gr4)
(jze test-fibo-exit)
(lad sp -1 sp)
(st gr3 0 sp)
(call fibo)
(st gr0 0 sp)
(call print)
(call newline)
(lad sp 1 sp)
(lad gr3 1 gr3)
(jump test-fibo-loop)
test-fibo-exit
(halt)
* (asm-run "fibo.cas") 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 NIL
●フィボナッチ関数 (2)
フィボナッチ関数は累算変数を使って二重再帰を末尾再帰へ変換することができます。Common Lisp でプログラムすると次のようになります。
リスト : フィボナッチ関数 (末尾再帰)
(defun fibo (n)
(labels ((fiboi (n a1 a2)
(if (zerop n)
a1
(fiboi (- n 1) (+ a1 a2) a1))))
(fiboi n 1 0)))
累算変数 a1 と a2 の使い方がポイントです。現在のフィボナッチ数を変数 a1 に、ひとつ前の値を変数 a2 に格納しておきます。あとは a1 と a2 を足し算して、新しいフィボナッチ数を計算すればいいわけです。fiboi の呼び出しを図に示すと、次のようになります。
(fiboi 5 1 0)
(fiboi 4 1 1)
(fiboi 3 2 1)
(fiboi 2 3 2)
(fiboi 1 5 3)
(fiboi 0 8 5)
=> a1 の値 8 を返す
=> 8
=> 8
=> 8
=> 8
=> 8
図 : fiboi の呼び出し
二重再帰では、同じ値を何回も求めていたため効率がとても悪かったのですが、このプログラムでは無駄な計算を行っていないので、値を高速に求めることができます。末尾再帰になっているので、Lisp / Scheme のように末尾再帰最適化を行う処理系では、プログラムを高速に実行できるでしょう。
これをそのまま COMET2A でプログラムすると次のようになります。
リスト : フィボナッチ関数 (末尾再帰版)
; 入力 : +2) N
; : +3) a1
; : +4) a2
; 出力 : gr0
fiboi-sub
(link gr7 0)
(ld gr0 2 gr7)
(jze fiboi-zero)
(lad sp -3 sp)
(lad gr0 -1 gr0) ; N - 1
(st gr0 0 sp)
(ld gr0 3 gr7) ; a1
(st gr0 2 sp) ; a1 をセット
(addl gr0 4 gr7) ; a1 + a2
(st gr0 1 sp) ; a1 + a2 をセット
(call fiboi-sub) ; 再帰呼び出し
(lad sp 3 sp)
fiboi-exit
(unlk gr7)
(ret)
fiboi-zero
(ld gr0 3 gr7) ; a1 を返す
(jump fiboi-exit)
; 入力 : +2) N
; 出力 : gr0
fiboi
(link gr7 0)
(lad sp -3 sp)
(ld gr0 2 gr7)
(st gr0 0 sp) ; N をセット
(lad gr0 1)
(st gr0 1 sp) ; a1 (1) をセット
(xor gr0 gr0)
(st gr0 2 sp) ; a2 (0) をセット
(call fiboi-sub)
(lad sp 3 sp)
(unlk gr7)
(ret)
サブルーチン fiboi から fiboi-sub を呼び出します。fiboi-sub は自分自身を 1 回だけ再帰呼び出します。その返り値 gr0 がそのまま fiboi-sub の返り値になっていて、末尾再帰になっていることがよくわかると思います。
アセンブリ言語の場合、Lisp / Scheme など関数型言語のように末尾再帰最適化が行われることはありません。プログラマが手作業で繰り返しに変換する必要があります。ご参考までに、末尾再帰を繰り返しに変換したプログラムを示します。
リスト : フィボナッチ関数 (繰り返し版)
; 入力 : +2) N
; 出力 ; gr0
fibol
(link gr7 0)
(push 0 gr2)
(push 0 gr3) ; a3 (WORK)
(ld gr3 2 gr7) ; N
(lad gr0 1) ; a1 = 1
(xor gr1 gr1) ; a2 = 0
fibol-loop
(ld gr3 gr3)
(jze fibol-exit)
(ld gr2 gr0)
(addl gr2 gr1) ; a1 + a2 -> a3
(ld gr1 gr0) ; a1 -> a2
(ld gr0 gr2) ; a3 -> a1
(lad gr3 -1 gr3)
(jump fibol-loop)
fibol-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
●ユークリッドの互除法
もうひとつ簡単な数値計算の例を示しましょう。負でない整数 a と b の最大公約数を求めるプログラムを「ユークリッド(Euclid) の互除法」で作ります。
[ユークリッドの互除法] 負でない整数 a と b (a > b) で、a を b で割った余りを r とする。 このとき、a と b の最大公約数は b と r の最大公約数に等しい。
これを Common Lisp でプログラムすると次のようになります。
リスト : 最大公約数を求める
(defun my-gcd (a b)
(if (zerop b)
a
(my-gcd b (mod a b))))
* (my-gcd 42 30) 6 * (my-gcd 15 70) 5
Common Lisp には関数 gcd が用意されているので、ここでは関数名を my-gcd としました。とても簡単ですね。
COMET2A のプログラムも簡単です。次のリストを見てください。
リスト : 最大公約数を求める (ユークリッドの互除法)
; 入力 +2) : a
; +3) : b
; 出力 gr0
gcd
(link gr7 0)
(ld gr0 2 gr7) ; a
(ld gr1 3 gr7) ; b
(jze gcd-exit)
(divl gr0 gr1) ; -> gr0 (商), gr1 (余り)
(lad sp -2 sp)
(ld gr0 3 gr7)
(st gr0 0 sp) ; b をセット
(st gr1 1 sp) ; a % b をセット
(call gcd)
(lad sp -2 sp)
gcd-exit
(unlk gr7)
(ret)
引数 a, b を取り出して、gr0, gr1 にセットします。gr1 が 0 ならば gr0 をそのまま返します。これが再帰呼び出しの停止条件になります。そうでなければ、divl で gr0 / gr1 を計算して、gcd を再帰呼び出しするだけです。
テストプログラムと実行結果を示します。
リスト : gcd の簡単なテスト
test-gcd
(lad sp -2 sp)
(lad gr0 42)
(st gr0 0 sp)
(lad gr0 30)
(st gr0 1 sp)
(call gcd)
(st gr0 0 sp)
(call print)
(call newline)
(lad gr0 15)
(st gr0 0 sp)
(lad gr0 70)
(st gr0 1 sp)
(call gcd)
(st gr0 0 sp)
(call print)
(call newline)
(lad sp 2 sp)
(halt)
* (asm-run "test0.cas") 6 5
サブルーチン gcd は末尾再帰になっているので、繰り返しに変換することも簡単にできます。興味のある方は繰り返しバージョンのプログラムを作ってみてください。
●バブルソート
次は簡単なソートプログラムを作ってみましょう。「バブルソート (buble sort) 」は泡がぶくぶくと浮いてくるように、いちばん小さいデータが後ろから前に浮かび上がってくるアルゴリズムです。
隣接する 2 つのデータを比較して、順序が逆であれば入れ換えます。これを順番に後ろから前に行っていけば、いちばん小さなデータは頂上に浮かび上がっているというわけです。先頭が決まったならば、残りのデータに対して同じことを行えば、2 番目には残りのデータの中でいちばん小さいものが浮かび上がってきます。これをデータ数だけ繰り返せばソートが完了します。
9 5 3 7 6 4 8 交換しない
~~~
9 5 3 7 6 4 8 交換する
~~~
9 5 3 7 4 6 8 交換する
~~~
9 5 3 4 7 6 8 交換しない
~~~
9 5 3 4 7 6 8 交換する
~~~
9 3 5 4 7 6 8 交換する
~~~
3 9 5 4 7 6 8 いちばん小さいデータが決定する
+ 残りのデータに対して同様な操作を行う
図 : バブルソート
これをそのまま Common Lisp でプログラムすると次のようになります。
リスト : バブルソート (Common Lisp 版)
(defun buble-sort (buff)
(do ((k (1- (length buff)))
(i 0 (1+ i)))
((= i k) buff)
(do ((j k (1- j)))
((= i j))
(when (> (aref buff (1- j)) (aref buff j))
(rotatef (aref buff (1- j)) (aref buff j))))))
* (buble-sort #(5 6 4 7 3 8 2 9 1 0)) #(0 1 2 3 4 5 6 7 8 9)
rotatef は値を交換するマクロです。
rotatef place-1 place-2 ... place-n
rotatef は setf と同様に汎変数を引数として受け付けます。そして、2 番目から n 番目の引数の値を 1 番目から n - 1 番目の引数にセットし、1 番目の引数の値を n 番目の引数にセットします。つまり、先頭と末尾の変数が連結されていて、引数の値をひとつずつ左へシフトする、という「回転シフト (rotate shift) 」の動作になります。
簡単な例を示しましょう。
* (let ((a 10) (b 20) (c 30)) (rotatef a b c) (list a b c)) (20 30 10)
b の値が a に、c の値が b に、そして a の値が c にセットされるので、(20 30 10) というリストが返されます。引数が 2 つの場合、rotatef を使って値を交換することができます。
COMET2A でバブルソートをプログラムすると次のようになります。
リスト : バブルソート
; 入力 : +2) バッファ
; +3) 個数
; 出力 : None
buble-sort
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(ld gr1 2 gr7) ; 先頭アドレス
(ld gr2 gr1)
(addl gr2 3 gr7)
(lad gr2 -1 gr2) ; 末尾要素へのアドレス
buble-sort-loop1
(cpl gr1 gr2) ; 先頭アドレスを +1 していき
(jze buble-sort-exit) ; 最後まで調べたら終了
;
(ld gr3 gr2)
buble-sort-loop2 ; 末尾から gr1 までループする
(cpl gr3 gr1)
(jze buble-sort-exit2)
(ld gr0 0 gr3)
(cpa gr0 -1 gr3)
(jpl buble-sort-lab1)
; 値の交換
(ld gr4 gr0)
(ld gr0 -1 gr3)
(st gr0 0 gr3)
(st gr4 -1 gr3)
buble-sort-lab1
(lad gr3 -1 gr3)
(jump buble-sort-loop2)
;
buble-sort-exit2
(lad gr1 1 gr1)
(jump buble-sort-loop1)
buble-sort-exit
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
gr1 がバッファの先頭アドレス、gr2 が末尾要素へのアドレスです。最初のループ (buble-sort-loop1) で gr1 を一つずつ減らしていき、2 番目のループ (buble-sort-loop2) で末尾から gr1 まで順番に要素を調べていきます。このとき、要素を示すポインタに gr3 を使っています。要素 (gr3 + 0) と要素 (gr3 - 1) を比較し、(gr3 + 0) の方が小さい場合は値を交換します。
テストプログラムと実行結果を示します。
リスト : バブルソートの簡単なテスト
test-buble-sort
(lad sp -2 sp)
(lad gr0 data00)
(st gr0 0 sp)
(ld gr0 len00)
(st gr0 1 sp)
(call buble-sort)
(call print-vector)
(lad sp 2 sp)
(halt)
len00 (dc 10)
data00 (dc 5 6 4 7 3 8 2 9 1 0)
* (asm-run "buble.cas") 0 1 2 3 4 5 6 7 8 9 NIL
●選択ソート
選択ソート (selection sort) は、ソートしていないデータの中から最小値（または最大値）を見つけ、それを先頭のデータと交換する、という手順を繰り返すことでソートを行います。最初は、すべてのデータの中から最小値を探し、それを配列の先頭 buff[0] と交換します。次は、buff[1] 以降のデータの中から最小値を探し、それを buff[1] と交換します。これを繰り返すことでソートすることができます。
[9 5 3 7 6 4 8] 3 と 9 を交換する
+ +
3 [5 9 7 6 4 8] 5 と 4 を交換する
+ +
3 4 [9 7 6 5 8] 9 と 5 を交換する
+ +
3 4 5 [7 6 9 8] 7 と 6 を交換する
+ +
3 4 5 6 [7 9 8] 7 と 7 を交換する
+
3 4 5 6 7 [9 8] 9 と 8 を交換してソート終了
+ +
図 : 選択ソート
このように、選択ソートは単純でわかりやすいアルゴリズムです。
選択ソートの場合、ベクタの中から要素を選択する関数を引数として渡すことができると便利です。Common Lisp でのプログラムは次のようになります。
リスト : 選択ソート (Common Lisp 版)
; ベクタの中から最大値を求める
(defun max-vector (buff &optional (start 0))
(do ((pos start)
(val (aref buff start))
(i start (1+ i)))
((= i (length buff)) (values val pos))
(when (< val (aref buff i))
(setf pos i
val (aref buff i)))))
; ベクタの中から最小値を求める
(defun min-vector (buff &optional (start 0))
(do ((pos start)
(val (aref buff start))
(i start (1+ i)))
((= i (length buff)) (values val pos))
(when (> val (aref buff i))
(setf pos i
val (aref buff i)))))
; 選択ソート
(defun select-sort (buff selector)
(do ((i 0 (1+ i)))
((= i (1- (length buff))) buff)
(multiple-value-bind (val pos)
(funcall selector buff i)
(shiftf (aref buff pos) (aref buff i) val))))
関数 max-vector はベクタの中から最大値を探して、その値と位置を返します。逆に、関数 min-vector は最小値とその位置を返します。要素を選択する関数を用意すると、選択ソートのプログラムは簡単です。ベクタの i 番目から末尾までの中から selector で要素を選び、それと i 番目の要素を交換するだけです。値の交換にはマクロ shiftf を使っています。
shiftf place-1 place-2 ... place-n new-value
shiftf は setf と同様に汎変数を引数として受け付けます。2 番目から n 番目の引数の値を 1 番目から n - 1 番目の引数にセットし、new-value を n 番目の引数にセットします。つまり、引数の値をひとつずつ左へシフトする動作になります。
簡単な例を示しましょう。
* (let ((a 10) (b 20) (c 30) (d 40)) (shiftf a b c d) (list a b c)) (20 30 40)
b の値が a に、c の値が b に、そして d の値が c にセットされるので、(20 30 40) というリストが返されます。
COMET2A でも引数にサブルーチンを渡すことができます。次のリストを見てください。
リスト : 選択ソート
; 最大値を求める
; 入力 +2) バッファ
; +3) 個数
; 出力 gr0 最大値、gr1 アドレス
max
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr1 2 gr7) ; 先頭アドレス
(ld gr2 3 gr7)
(addl gr2 gr1) ; 末尾アドレス
(ld gr3 gr1)
(ld gr0 0 gr3) ; 先頭要素を仮の最大値とする
(lad gr3 1 gr3) ; 次の要素から調べる
max-loop
(cpl gr3 gr2)
(jze max-exit)
(cpa gr0 0 gr3)
(jpl max-lab1)
; 最大値を書き換える
(ld gr0 0 gr3)
(ld gr1 gr3)
max-lab1
(lad gr3 1 gr3)
(jump max-loop)
max-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; 最小値を求める
; 入力 +2) バッファ
; +3) 個数
; 出力 gr0 最小値、gr1 アドレス
min
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr1 2 gr7) ; 先頭アドレス
(ld gr2 3 gr7)
(addl gr2 gr1) ; 末尾アドレス
(ld gr3 gr1)
(ld gr0 0 gr3) ; 先頭要素を仮の最小値とする
(lad gr3 1 gr3) ; 次の要素から調べる
min-loop
(cpl gr3 gr2)
(jze min-exit)
(cpa gr0 0 gr3)
(jmi min-lab1)
(jze min-lab1)
; 最小値を書き換える
(ld gr0 0 gr3)
(ld gr1 gr3)
min-lab1
(lad gr3 1 gr3)
(jump min-loop)
min-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; 選択ソート
; 入力 : +2) バッファ
; +3) 個数
; +4) 要素を選択するサブルーチン
; 出力 : None
select-sort
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(ld gr2 2 gr7) ; 先頭アドレス
(ld gr3 3 gr7) ; 個数
select-sort-loop
(lad gr0 1)
(cpl gr0 gr3)
(jze select-sort-exit) ; 末尾要素まで調べたら終了
(lad sp -2 sp)
(st gr2 0 sp)
(st gr3 1 sp)
(ld gr0 4 gr7) ; 選択用サブルーチンを取り出す
(call 0 gr0) ; -> gr0 (要素), gr1 (アドレス)
(lad sp 2 sp)
(ld gr4 0 gr2) ; 先頭の要素
(st gr4 0 gr1) ; 交換する
(st gr0 0 gr2)
(lad gr2 1 gr2)
(lad gr3 -1 gr3)
(jump select-sort-loop)
select-sort-exit
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
最大値を求めるサブルーチンが max で、最小値を求めるサブルーチンが min です。どちらのサブルーチンも難しいところはないと思います。選択ソートを行う select-sort のポイントは、引数に渡された選択用のサブルーチンを呼び出すところです。(ld gr0 4 gr7) で引数からサブルーチンのアドレスを取り出して gr0 にセットします。CALL 命令は間接アドレッシングができるので、あとは (call 0 gr0) を実行すれば選択用のサブルーチンを呼び出すことができます。
選択ソードの簡単なテストと実行結果を示します。
リスト : 選択ソートの簡単なテスト
test-select-sort
(lad sp -3 sp)
(lad gr0 data01)
(st gr0 0 sp)
(ld gr0 len01)
(st gr0 1 sp)
(lad gr0 min) ; 最小値を選択
(st gr0 2 sp)
(call select-sort)
(call print-vector)
(lad sp 3 sp)
(halt)
len01 (dc 10)
data01 (dc 5 6 4 7 3 8 2 9 1 0)
* (asm-run "select.cas") 0 1 2 3 4 5 6 7 8 9 NIL
●単純挿入ソート
単純挿入ソートはソート済みのベクタに新しいデータを挿入していくことでソートします。最初は先頭のデータひとつがソート済みのベクタと考え、2 番目のデータをそこに挿入することからスタートします。データを挿入するので、そこにあるデータをどかさないといけません。そこで、挿入位置を決めるため後ろから順番にデータを比較するとき、いっしょにデータの移動も行うことにします。
[9] 5 3 7 6 4 8 5 を取り出す
[9] * 3 7 6 4 8 5 を[9]の中に挿入する
[5 9] 3 7 6 4 8 9 をひとつずらして先頭に 5 を挿入
[5 9] * 7 6 4 8 3 を取り出して[5 9]の中に挿入する
[3 5 9] 7 6 4 8 先頭に 3 を挿入
[3 5 9] * 6 4 8 7 を取り出して[3 5 9] に挿入
[3 5 7 9] 6 4 8 9 を動かして 7 を挿入
残りの要素も同様に行う
図 : 単純挿入ソート
ソートする場合、要素を比較する関数を渡すことができると便利です。比較関数を comp とすると、(comp a b) は a が b よりも小さい場合は負の値を、等しい場合は 0 を、a が b よりも大きい場合は正の値を返すものとします。Common Lisp でプログラムすると次のようになります。
リスト : 単純挿入ソート (Common Lisp 版)
(defun insert-sort (buff comp)
(do ((i 1 (1+ i)))
((= i (length buff)) buff)
(do ((tmp (aref buff i))
(j i (1- j)))
((zerop j) (setf (aref buff j) tmp))
(cond ((<= 0 (funcall comp tmp (aref buff (1- j))))
(setf (aref buff j) tmp)
(return))
(t
(setf (aref buff j) (aref buff (1- j))))))))
; 比較関数
(defun comp (a b) (- a b))
* (insert-sort #(5 6 4 7 3 8 2 9 1 0) #'comp) #(0 1 2 3 4 5 6 7 8 9)
アルゴリズムをそのままプログラムしただけなので、とくに難しいところはないと思います。COMET2A でのプログラムは次のようになります。
リスト : 単純挿入ソート
; 入力 +2) : バッファ
; +3) : 個数
; +4) : 比較用サブルーチン
; 出力 None
insert-sort
(link gr7 0)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(ld gr3 2 gr7)
(ld gr4 gr3)
(lad gr4 1 gr4) ; gr4 の示すデータを挿入する
(addl gr3 3 gr7) ; 末尾アドレス
insert-sort-loop
(cpl gr4 gr3) ; 最後まで調べたか
(jze insert-sort-exit)
;
(ld gr5 gr4)
(ld gr6 0 gr5) ; 挿入するデータ -> gr6
insert-sort-loop1
(cpl gr5 2 gr7) ; 先頭に到達したか
(jze insert-sort-exit1)
; データを比較する
(lad sp -2 sp)
(st gr6 0 sp)
(ld gr0 -1 gr5)
(st gr0 1 sp)
(ld gr0 4 gr7)
(call 0 gr0) ; -> gr0 (-,0,+)
(lad sp 2 sp)
(and gr0 gr0)
(jpl insert-sort-exit1)
; gr6 が小さい
(ld gr0 -1 gr5)
(st gr0 0 gr5)
(lad gr5 -1 gr5)
(jump insert-sort-loop1)
insert-sort-exit1
; (gr5 + 0) の位置に gr6 を挿入
(st gr6 0 gr5)
;
(lad gr4 1 gr4)
(jump insert-sort-loop)
insert-sort-exit
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(unlk gr7)
(ret)
insert-sort は二重ループになっているのでちょっと複雑に見えますが、アルゴリズムをそのままプログラムしているだけです。コメントをみながら、リストを読んでみてください。
簡単なテストプログラムと実行結果を示します。
リスト : 挿入ソートの簡単なテスト
test-insert-sort
(lad sp -3 sp)
(lad gr0 data02)
(st gr0 0 sp)
(ld gr0 len02)
(st gr0 1 sp)
(lad gr0 cmp)
(st gr0 2 sp)
(call insert-sort)
(call print-vector)
(lad sp 3 sp)
(halt)
len02 (dc 10)
data02 (dc 5 6 4 7 3 8 2 9 1 0)
; 比較用サブルーチン
cmp
(link gr7 0)
(ld gr0 2 gr7)
(suba gr0 3 gr7)
(unlk gr7)
(ret)
* (asm-run "insert.cas") 0 1 2 3 4 5 6 7 8 9 NIL
●クイックソート
次は高速なソートアルゴリズムとして有名な「クイックソート (quick sort) 」を取り上げます。クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。2 つに分けた各々の区間を同様に分割して 2 つの区間に分けます。最後は区間の要素がひとつになってソートが完了します。
9 5 3 7 6 4 2 8 最初の状態
9 5 3 7 6 4 2 8 7 を枢軸にして左側から 7 以上の値を探し、
L R 右側から 7 以下の値を探す。
2 5 3 7 6 4 9 8 交換する
L R
2 5 3 7 6 4 9 8 検索する
L R
2 5 3 4 6 7 9 8 交換する
L R
2 5 3 4 6 7 9 8 検索する。R と L が交差したら分割終了。
R L
[2 5 3 4 6] [7 9 8] この 2 つの区間について再び同様な分割を行う
図 : クイックソート
基準になる値のことを「枢軸 (pivot) 」といいます。枢軸は要素の中から適当な値を選びます。今回は中央にある要素を選ぶことにしましょう。上図を見てください。左側から枢軸 7 以上の要素を探し、左側から 7 以下の要素を探します。探索のときは枢軸が番兵の役割を果たすので、ソート範囲外の要素を探索することはありません。見つけたらお互いの要素を交換します。探索位置が交差したら分割は終了です。
あとは同じ手順を分割した 2 つの区間に適用します。これは再帰定義を使えば簡単に実現できます。分割した区間の要素数が 1 になったときが再帰の停止条件になります。
Common Lisp でプログラムすると次のようになります。
リスト : クイックソート (Common Lisp 版)
(defun qsort (buff low high comp)
(do ((pivot (aref buff (floor (+ low high) 2)))
(i low (1+ i))
(j high (1- j)))
()
(do ()
((<= 0 (funcall comp (aref buff i) pivot)))
(incf i))
(do ()
((<= 0 (funcall comp pivot (aref buff j))))
(decf j))
(when (>= i j)
(when (< low (1- i))
(qsort buff low (1- i) comp))
(when (< (1+ j) high)
(qsort buff (1+ j) high comp))
(return))
(rotatef (aref buff i) (aref buff j))))
(defun quick-sort-vector (pred buff)
(qsort buff 0 (1- (length buff)) pred)
buff)
関数 qsort の引数 buff がソートするベクタ、low が区間の下限値、high が区間の上限値、comp が要素を比較する関数です。qsort は buff の low から high までの区間をソートします。最初の do ループで区間の中央にあるデータを枢軸 pivot として選び、pivot を基準にして区間を 2 つに分けます。
次の do ループで、左側から枢軸以上の要素を探しています。ここでは枢軸以上という条件を、枢軸より小さい間は探索位置を進める、というように置き換えています。同様に次の do ループで右側から枢軸以下の要素を探します。お互いの探索位置 i, j が交差したら分割は終了です。そうでなければお互いの要素を交換します。
そして、分割した区間に対して qsort を再帰呼び出しします。このとき要素数をチェックして、2 個以上ある場合に再帰呼び出しを行います。この停止条件を忘れると正常に動作しません。ご注意ください。
これをそのまま COMET2A でプログラムすると、次のようになります。
リスト : クイックソート
; 入力 : +2) バッファ
; +3) 個数
; +4) 比較関数
; 出力 : None
quick-sort
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr1 2 gr7) ; 先頭アドレス
(ld gr2 3 gr7)
(addl gr2 gr1)
(lad gr2 -1 gr2) ; 末尾要素へのアドレス
(ld gr3 4 gr7) ; 比較関数
(lad sp -3 sp)
(st gr1 0 sp)
(st gr2 1 sp)
(st gr3 2 sp)
(call qsort-sub)
(lad sp 3 sp)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; qsort-sub
; 入力 +2) 先頭アドレス
; +3) 末尾要素へのアドレス
; +4) 比較関数
; 出力 None
qsort-sub
(link gr7 0)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(ld gr5 2 gr7) ; 先頭アドレス (i)
(ld gr6 3 gr7) ; 末尾アドレス (j)
(ld gr3 gr5)
(addl gr3 gr6)
(jov qsort-sub-ov) ; 桁あふれ
(srl gr3 1) ; 枢軸の位置
(ld gr3 0 gr3) ; 枢軸
(jump qsort-sub-loop)
qsort-sub-ov
(srl gr3 1)
(lad gr0 #x8000)
(or gr3 gr0) ; 枢軸の位置
(ld gr3 0 gr3) ; 枢軸
qsort-sub-loop
(lad sp -2 sp)
(ld gr0 0 gr5)
(st gr0 0 sp) ; buff[i] => data
(st gr3 1 sp) ; pivot
(ld gr0 4 gr7)
(call 0 gr0) ; -> gr0
(lad sp 2 sp)
(ld gr0 gr0)
(jpl qsort-sub-lab1) ; data >= pivot でジャンプ
(lad gr5 1 gr5) ; i++
(jump qsort-sub-loop)
qsort-sub-lab1
(lad sp -2 sp)
(st gr3 0 sp) ; pivot
(ld gr0 0 gr6)
(st gr0 1 sp) ; buff[j] => data
(ld gr0 4 gr7)
(call 0 gr0) ; -> gr0
(lad sp 2 sp)
(ld gr0 gr0)
(jpl qsort-sub-lab2) ; pivot >= data でジャンプ
(lad gr6 -1 gr6) ; j--
(jump qsort-sub-lab1)
qsort-sub-lab2
(cpl gr5 gr6)
(jpl qsort-sub-lab3) ; i >= j でジャンプ
; 交換する
(ld gr0 0 gr5)
(ld gr4 0 gr6)
(st gr4 0 gr5)
(st gr0 0 gr6)
(lad gr5 1 gr5) ; i++
(lad gr6 -1 gr6) ; j--
(jump qsort-sub-loop)
qsort-sub-lab3
(lad gr5 -1 gr5) ; i - 1
(ld gr0 2 gr7) ; low -> gr0
(cpl gr0 gr5)
(jpl qsort-sub-lab4) ; low >= i - 1 でジャンプ
(lad sp -3 sp)
(st gr0 0 sp)
(st gr5 1 sp)
(ld gr0 4 gr7)
(st gr0 2 sp)
(call qsort-sub) ; 再帰
(lad sp 3 sp)
qsort-sub-lab4
(lad gr6 1 gr6) ; j + 1
(ld gr0 3 gr7) ; high
(cpl gr6 gr0)
(jpl qsort-sub-exit) ; j + 1 >= high ならばジャンプ
(lad sp -3 sp)
(st gr6 0 sp)
(st gr0 1 sp)
(ld gr0 4 gr7)
(st gr0 2 sp)
(call qsort-sub) ; 再帰
(lad sp 3 sp)
qsort-sub-exit
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(unlk gr7)
(ret)
実際の処理はサブルーチン qsort-sub で行います。プログラムが長くなったので、処理を追いかけるのは大変だと思いますが、コメントをみながらリストを読んでみてください。処理を適切なサブルーチンに分割したほうが良かったのかもしれませんね。
簡単なテストプログラムと実行例を示します。
リスト : クイックソートの簡単なテスト
test-quick-sort
(lad sp -3 sp)
(lad gr0 data03)
(st gr0 0 sp)
(ld gr0 len03)
(st gr0 1 sp)
(lad gr0 cmp)
(st gr0 2 sp)
(call quick-sort)
(call print-vector)
(lad sp 3 sp)
(lad gr0 data03)
(svc 1)
(halt)
len03 (dc 10)
data03 (dc 5 6 4 7 3 8 2 9 1 0)
* (asm-run "quick.cas") 0 1 2 3 4 5 6 7 8 9 NIL
●８クイーン
最後にパズル「８クイーン」を解いてみましょう。アルゴリズムは拙作のページ N Queens Problem で取り上げた「ビット演算による高速化」による解法と同じです。Common Lisp の場合、マクロを使わないでプログラムすると次のようになります。
リスト : ８クイーンの解法 (Common Lisp 版)
(defun queens (nums left right a)
(if (zerop nums)
(print-answer (reverse a))
(do ((n nums))
((zerop n))
(let ((q (logand (- n) n)))
(when (zerop (logand (logior left right) q))
(queens (logxor nums q)
(ash (logior left q) 1)
(ash (logior right q) -1)
(cons q a)))
(setf n (logxor n q))))))
(defun print-answer (ls)
(print (mapcar #'(lambda (x) (logcount (1- x))) ls)))
* (queens #xff 0 0 nil) (0 4 7 5 2 6 1 3) (0 5 7 2 6 3 1 4) ・・・省略・・・ (7 2 0 5 1 4 6 3) (7 3 0 2 5 1 6 4)
解は 92 通りあります。これをそのまま COMET2A でプログラムすると次のようになります。
リスト : ８クイーンの解法
;
; queens.cas : 8 Queens Problems
;
; Copyright (C) 2011 Makoto Hiroi
;
test-queens
(lad sp -4 sp)
(xor gr0 gr0)
(st gr0 0 sp)
(st gr0 2 sp)
(st gr0 3 sp)
(lad gr0 #xff)
(st gr0 1 sp)
(call queens)
(lad sp 4 sp)
(halt)
; 入力 +2) : N (手数)
; +3) : Nums (配置するクイーン)
; +4) : Left (左の利き筋)
; +5) : Right (右の利き筋)
; 出力 : None
queens
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr3 3 gr7) ; 配置するクイーン -> gr3
(jze queens-found) ; クイーンをすべて配置した
queens-loop
(lad gr2 #xffff)
(xor gr2 gr3)
(lad gr2 1 gr2) ; 符号を反転 (2 の補数)
(and gr2 gr3) ; クイーンをひとつ取り出す -> gr2
(ld gr0 4 gr7)
(or gr0 5 gr7)
(and gr0 gr2) ; (left or right) and gr2
(jnz queens-lab1)
(ld gr0 2 gr7) ; N -> gr0
(st gr2 qbuff gr0) ; クイーンを書き込む
(lad gr0 1 gr0) ; N+=1
(lad sp -4 sp)
(st gr0 0 sp) ; 手数
(ld gr0 3 gr7)
(xor gr0 gr2) ; 配置したクイーンを取り除く
(st gr0 1 sp)
(ld gr0 4 gr7) ; 左の利き筋
(or gr0 gr2)
(sll gr0 1)
(st gr0 2 sp)
(ld gr0 5 gr7) ; 右の利き筋
(or gr0 gr2)
(srl gr0 1)
(st gr0 3 sp)
(call queens)
(lad sp 4 sp)
queens-lab1
(xor gr3 gr2) ; ビットオフ
(jnz queens-loop)
queens-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
queens-found
(lad sp -1 sp)
(ld gr0 2 gr7)
(st gr0 0 sp)
(call print-answer)
(call newline)
(lad sp 1 sp)
(jump queens-exit)
qbuff (ds 10)
; 解の表示
; 入力 +2) 個数
print-answer
(link gr7 0)
(push 0 gr2)
(xor gr2 gr2)
print-answer-loop
(cpl gr2 2 gr7)
(jze print-answer-exit)
(ld gr0 qbuff gr2)
(lad gr0 -1 gr0)
(lad sp -1 sp)
(st gr0 0 sp)
(call logcount) ; ビット数 -> gr0
(st gr0 0 sp)
(call print) ; 数値の表示
(lad gr0 32) ; space
(st gr0 0 sp)
(call write-char)
(lad sp 1 sp)
(lad gr2 1 gr2)
(jump print-answer-loop)
print-answer-exit
(pop gr2)
(unlk gr7)
(ret)
選んだクイーンをバッファ gbuff に格納していること以外は Common Lisp のプログラムとほぼ同じです。コメントをみながら、リストを読んでみてください。実行結果は当然ですが Common Lisp のプログラムと同じです。
今回はここまでです。次回は COMET2A 用の簡単なメモリ管理プログラムを作ってみましょう。
●履歴
- 初版 2011 年 1 月 9 日
- 改訂 2011 年 1 月 22 日
サブルーチン内におけるレジスタ保護の規約を変更 (GR0, GR1 は保護しない、GR2 - GR7 は保護する)
●プログラムリスト
;
; lib.cas : COMET2A 簡易シミュレータ用ライブラリ
;
; Copyright (C) 2011 Makoto Hiroi
;
; 2011/01/22
; 規約の変更 : gr0 と gr1 は保存しなくてもよい
;
; 文字の入力
; 入力 : 無し
; 出力 : gr0 文字
read-char
(svc 2)
(ret)
; 文字の出力
; 入力 : sp + 0) リターンアドレス
; + 1) 文字
; 出力 : 無し
write-char
(ld gr0 1 sp)
(svc 3)
(ret)
; 改行を出力
newline
(lad gr0 10)
(svc 3)
(ret)
; 無符号整数の N 進表示
; 入力 a + 0) : gr7
; a + 1) : ret adr
; a + 2) : 整数
; a + 3) : 基数 N
; 出力 : None
printu
(link gr7 0)
(ld gr0 2 gr7) ; 整数
(ld gr1 3 gr7) ; 基数
(divl gr0 gr1) ; gr0 / gr1 -> gr0 商, gr1 余り
(jze printu-l1)
(push 0 gr1) ; 余りを保存
(lad sp -2 sp) ; 引数領域を確保
(st gr0 0 sp) ; 商をセット
(ld gr0 3 gr7)
(st gr0 1 sp) ; 基数をセット
(call printu)
(lad sp 2 sp) ; 引数領域を解放
(pop gr1)
printu-l1
(ld gr1 code-table gr1)
(push 0 gr1) ; 引数セット
(call write-char)
(pop gr1) ; 引数を取り除く
(unlk gr7)
(ret)
code-table
(dc "0123456789ABCDEF")
; 符号付き整数の 10 進表示
; 入力 a + 0) : gr7
; + 1) : ret adr
; + 2) : 整数
; 出力 : None
print
(link gr7 0)
(push 0 gr2)
(ld gr2 2 gr7)
(jpl print-l1) ; flag check
; 符号を反転する
(lad gr0 #xffff)
(xor gr2 gr0) ; bit を反転
(lad gr2 1 gr2) ; 1 を足す
(push 45)
(call write-char) ; '-' を出力
(pop gr0)
print-l1
(lad sp -2 sp) ; 引数領域確保
(st gr2 0 sp) ; 整数をセット
(lad gr0 10)
(st gr0 1 sp) ; 基数 10 をセット
(call printu)
(lad sp 2 sp) ; 引数領域解放
(pop gr2)
(unlk gr7)
(ret)
; データの探索
; 入力 +2) : データ
; +3) ; バッファ
; +4) : 個数
; 出力 : gr0 位置 (0 以上の数値), -1 失敗
position
(link gr7 0)
(push 0 gr2)
(ld gr0 2 gr7) ; データ
(ld gr1 3 gr7) ; 先頭アドレス
(ld gr2 4 gr7) ; 個数
(addl gr2 gr1) ; 末尾アドレス
position-loop
(cpl gr1 gr2)
(jze position-false) ; 探索失敗
(cpa gr0 0 gr1)
(jze position-true) ; 探索成功
(lad gr1 1 gr1)
(jump position-loop)
position-true
(ld gr0 gr1) ; 位置を求める
(subl gr0 3 gr7)
position-exit
(pop gr2)
(unlk gr7)
(ret)
position-false
(lad gr0 -1)
(jump position-exit)
; バッファの初期化
; 入力 : +2) 初期値
; : +3) バッファ
; : +4) 個数
fill
(link gr7 0)
(push 0 gr2)
(ld gr0 2 gr7)
(ld gr1 3 gr7)
(ld gr2 4 gr7)
(addl gr2 gr1) ; 末尾アドレス
fill-loop
(cpl gr1 gr2)
(jze fill-exit)
(st gr0 0 gr1)
(lad gr1 1 gr1)
(jump fill-loop)
fill-exit
(pop gr2)
(unlk gr7)
(ret)
; ベクタの表示
; 入力 +2) バッファアドレス
; +3) 個数
; 出力 : None
print-vector
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr2 2 gr7) ; 先頭アドレス
(ld gr3 3 gr7) ; 個数
(addl gr3 gr2) ; 末尾アドレス
print-vector-loop
(cpl gr2 gr3)
(jze print-vector-exit)
(lad sp -1 sp)
(ld gr0 0 gr2)
(st gr0 0 sp)
(call print)
(lad gr0 32) ; 空白を出力
(st gr0 0 sp)
(call write-char)
(lad sp 1 sp)
(lad gr2 1 gr2)
(jump print-vector-loop)
print-vector-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; ビット 1 を数える (4 bit ずつ処理する)
; 入力 (gr7 + 2) : データ
; 出力 gr0 : ビット 1 の個数
logcount
(link gr7 0)
(push 0 gr2)
(xor gr0 gr0)
(ld gr1 2 gr7)
logcount-loop
(ld gr2 gr1)
(and gr2 logcount-mask)
(addl gr0 logcount-table gr2)
(srl gr1 4)
(jnz logcount-loop)
(pop gr2)
(unlk gr7)
(ret)
logcount-mask
(dc 15)
logcount-table
; 0 1 2 3 4 5 6 7 8 9 a b c d e f
(dc 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)