前回は COMETA2A 用の簡単な「連結リストライブラリ」にガベージコレクション機能を追加しました。今回は連結リストライブラリを使った簡単なサンプルプログラムを作ります。
まずは簡単な例題として、順列を生成するプログラムを作りましょう。リストを受け取り、その要素の順列を求めるプログラムは、Common Lisp で書くと次のようになります。
リスト : 順列の生成
(defun perm (func ls &optional a)
(if (null ls)
(funcall func a)
(dolist (x ls)
(perm func (remove x ls) (cons x a)))))
perm は高階関数です。リスト ls から要素を取り出し、累積変数 a に含まれていなければ、その要素を ls から取り除いて a に追加します。ls が空リストの場合は func に a を適用します。
簡単な実行例を示します。
* (perm #'print '(a b c d)) (D C B A) (C D B A) (D B C A) (B D C A) (C B D A) (B C D A) (D C A B) (C D A B) (D A C B) (A D C B) (C A D B) (A C D B) (D B A C) (B D A C) (D A B C) (A D B C) (B A D C) (A B D C) (C B A D) (B C A D) (C A B D) (A C B D) (B A C D) (A B C D) NIL
これを COMET2A でプログラムすると次のようになります。
リスト : 順列の生成
; 入力 +2) : サブルーチン
; +3) : リスト
; +4) : 順列を格納するリスト
; 出力 None
perm
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr3 3 gr7)
(jze perm-lab1) ; 空リスト
perm-loop
(lad sp -3 sp)
(ld gr0 0 gr3) ; (CAR gr3) -> gr0
(st gr0 0 sp)
(ld gr0 3 gr7)
(st gr0 1 sp)
(call remove) ; (remove x ls) -> gr0
(ld gr2 gr0) ; gr0 -> gr2
(ld gr0 4 gr7) ; (CAR gr3) はセットされたまま
(st gr0 1 sp) ; 累積変数 (リスト) をセット
(call cons) ; (cons x a) -> gr0
(st gr2 1 sp)
(st gr0 2 sp) ; リストをセット
(ld gr0 2 gr7) ; 累積変数をセット
(st gr0 0 sp) ; サブルーチンをセット
(call perm) ; 再帰呼び出し
(lad sp 3 sp)
(ld gr3 1 gr3)
(jnz perm-loop)
perm-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
perm-lab1
(ld gr0 4 gr7)
(push 0 gr0) ; 累積変数をセット
(ld gr0 2 gr7)
(call 0 gr0) ; サブルーチンを呼び出す
(pop gr0)
(jump perm-exit)
Common Lisp のプログラムとほぼ同じなので、とくに難しいところはないと思います。コメントをみながら、リストをお読みくださいませ。
簡単な実行例を示します。
リスト : perm のテスト
perm-test
(call initialize-heap)
(call initialize-list)
(lad sp -3 sp)
(lad gr0 1)
(st gr0 0 sp)
(lad gr0 4)
(st gr0 1 sp)
(call iota) ; (iota 1 4) -> gr0
(st gr0 1 sp)
(xor gr0 gr0)
(st gr0 2 sp)
(lad gr0 print-list)
(st gr0 0 sp)
(call perm)
(lad sp 3 sp)
(halt)
* (asm-run "test.cas") 4 3 2 1 3 4 2 1 4 2 3 1 2 4 3 1 3 2 4 1 2 3 4 1 4 3 1 2 3 4 1 2 4 1 3 2 1 4 3 2 3 1 4 2 1 3 4 2 4 2 1 3 2 4 1 3 4 1 2 3 1 4 2 3 2 1 4 3 1 2 4 3 3 2 1 4 2 3 1 4 3 1 2 4 1 3 2 4 2 1 3 4 1 2 3 4 NIL
(iota 1 4) よりも長いリスト、たとえば (iota 1 8) でも順列を求めることができます。
次はリストをマージするプログラムを作りましょう。マージ (併合) とは、複数のソート済み列をひとつのソート済みの列にまとめる操作です。Common Lisp でプログラムを作ると次のようになります。
リスト : リストのマージ
(defun merge-list (pred xs ys)
(cond ((null xs) ys)
((null ys) xs)
((funcall pred (car xs) (car ys))
(cons (car xs) (merge-list pred (cdr xs) ys)))
(t (cons (car ys) (merge-list pred xs (cdr ys))))))
Common Lisp には関数 merge があるので、関数名は merge-list としました。最初の節は、空リストとリスト ys をマージすると ys になることを表しています。次の節は、リスト xs と空リストをマージすると xs になることを表しています。この 2 つの節が、再帰呼び出しの停止条件になります。
3 番目の節で、それぞれのリストの先頭要素を述語 pred で比較し、pred が真を返す場合は (car xs) をマージしたリストの先頭に追加し、そうでなければ最後の節で (car ys) をマージしたリストの先頭に追加します。merge-list を再帰呼び出しするときは、xs または ys の先頭要素を取り除いて呼び出すことに注意してください。
簡単な実行例を示します。
* (setq a '(1 2 5 6 9)) (1 2 5 6 9) * (setq b '(3 4 7 8 10)) (3 4 7 8 10) * (merge-list #'< a b) (1 2 3 4 5 6 7 8 9 10) * a (1 2 5 6 9) * b (3 4 7 8 10)
merge-list は新しいリストを生成して返すことに注意してください。元のリスト a, b は破壊されません。
COMET2A でプログラムすると次のようになります。
リスト : リストのマージ (非破壊版)
; 入力 +2) : 比較サブルーチン
; +3) : リスト a
; +4) : リスト b
merge
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(ld gr3 3 gr7)
(jze merge-exit-b) ; b を返す
(ld gr4 4 gr7)
(jze merge-exit-a) ; a を返す
;
(lad gr2 -2 gr7) ; gr2 は末尾セルを保持する
(xor gr6 gr6) ; header を 0 クリア
(st gr6 0 gr2)
(st gr6 1 gr2)
(ld gr5 2 gr7) ; 比較サブルーチン
merge-loop
(lad sp -2 sp)
(ld gr0 0 gr4)
(st gr0 0 sp) ; (CAR b) をセット
(ld gr0 0 gr3)
(st gr0 1 sp) ; (CAR a) をセット
(call 0 gr5) ; -> gr0 (-, 0, +)
(lad sp 2 sp)
(and gr0 gr0)
(jmi merge-lb)
; a <= b
(lad sp -2 sp)
(ld gr0 0 gr3) ; (car a) -> gr0
(st gr0 0 sp)
(st gr6 1 sp) ; null
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2) ; 末尾に接続
(ld gr2 gr0)
(ld gr3 1 gr3)
(jnz merge-loop)
; a が空リストになった
(st gr4 1 gr2) ; b を末尾に接続
(jump merge-exit)
merge-lb
; a > b
(lad sp -2 sp)
(ld gr0 0 gr4) ; (car b) -> gr0
(st gr0 0 sp)
(st gr6 1 sp) ; null
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2) ; 末尾に接続
(ld gr2 gr0)
(ld gr4 1 gr4)
(jnz merge-loop)
; b が空リストになった
(st gr3 1 gr2) ; a を末尾に接続
merge-exit
(ld gr0 -1 gr7) ; (cdr header) -> gr0
merge-exit1
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
merge-exit-b
(ld gr0 4 gr7)
(jump merge-exit1)
merge-exit-a
(ld gr0 gr3)
(jump merge-exit1)
Common Lisp は再帰呼び出しでプログラムしていますが、COMET2A は繰り返しでプログラムしています。局所変数にヘッダを用意して、末尾のセルに新しいセルをつなげていきます。あとはとくに難しいところはないでしょう。コメントをみながら、リストをお読みくださいませ。
簡単な実行例を示します。
リスト : merge のテスト
test-merge
(call initialize-heap)
(call initialize-list)
(lad sp -3 sp)
(lad gr0 data02a)
(st gr0 0 sp)
(ld gr0 len02)
(st gr0 1 sp)
(call vector->list)
(ld gr2 gr0)
(lad gr0 data02b)
(st gr0 0 sp)
(ld gr0 len02)
(st gr0 1 sp)
(call vector->list)
(st gr0 2 sp)
(st gr2 1 sp)
(lad gr0 cmp)
(st gr0 0 sp)
(call merge)
(st gr0 0 sp)
(call print-list)
(call newline)
(lad sp 3 sp)
(halt)
len02 (dc 5)
data02a (dc 2 4 6 8 10)
data02b (dc 1 3 5 7 9)
; 比較関数
cmp
(link gr7 0)
(ld gr0 2 gr7)
(suba gr0 3 gr7)
(unlk gr7)
(ret)
* (asm-run "test.cas") 1 2 3 4 5 6 7 8 9 10 NIL
マージソートは、このマージを使ってデータをソートします。次の図を見てください。
9 5 3 7 6 4 2 8 最初の状態
|5 9|3 7|4 6|2 8| 長さ２の列に併合
|3 5 7 9|2 4 6 8| 長さ４の列に併合
2 3 4 5 6 7 8 9 ソート終了
図 : マージソート
マージをソートに応用する場合、最初は各要素をソート済みのリストとして考えます。この状態で隣のリストとマージを行い、長さ 2 のリストを作ります。次に、このリストに対して再度マージを行い、長さ 4 のリストを作ります。このように順番にマージしていくと、最後にはひとつのリストにマージされソートが完了します。
マージソートはリストの長さを 1, 2, 4, 8, ... と増やしていくよりも、再帰的に考えた方が簡単です。まず、ソートするリストを 2 つに分割して、前半部分をソートします。次に、後半部分をソートして、その結果をマージすればいいわけです。
再帰呼び出しするたびにリストは 2 つに分割されるので、最後にリストの要素はひとつとなります。これはソート済みのリストなので、ここで再帰呼び出しを終了してマージ処理を行えばいいわけです。Common Lisp でプログラムを作ると次のようになります。
リスト : マージソート
(defun merge-sort (pred ls n)
(if (= n 1)
(list (car ls))
(let ((m (floor n 2)))
(merge-list pred
(merge-sort pred ls m)
(merge-sort pred (nthcdr m ls) (- n m))))))
最初の節は、空リストとリスト ys をマージすると ys になることを表しています。次の節は、リスト xs と空リストをマージすると xs になることを表しています。この 2 つの節が、再帰呼び出しの停止条件になります。
3 番目の節で、それぞれのリストの先頭要素を述語 pred で比較し、pred が真を返す場合は (car xs) をマージしたリストの先頭に追加し、そうでなければ最後の節で (car ys) をマージしたリストの先頭に追加します。merge-list を再帰呼び出しするときは、xs または ys の先頭要素を取り除いて呼び出すことに注意してください。
簡単な実行例を示します。
* (merge-sort #'< '(5 6 4 7 3 8 2 9 1) 9) (1 2 3 4 5 6 7 8 9)
merge-sort は新しいリストを生成して返すことに注意してください。
COMET2A でプログラムを作ると、次のようになります。
リスト : マージソート (非破壊版)
; 入力 +2) : 比較サブルーチン
; +3) : リスト
; +4) : 長さ N
; 出力 gr0 : ソート済みリスト
merge-sort
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(ld gr6 3 gr7) ; リスト -> gr6
(ld gr2 4 gr7) ; N -> gr2
(lad gr0 1)
(cpl gr0 gr2)
(jze merge-sort-1) ; 要素はひとつ
(jpl merge-sort-0) ; 要素はない
(ld gr5 2 gr7) ; 比較サブルーチン -> gr5
(ld gr3 gr2)
(srl gr2 1) ; N / 2 -> gr2
(subl gr3 gr2) ; N - (N / 2) -> gr3
(lad sp -3 sp)
(st gr5 0 sp) ; 前半をソート
(st gr6 1 sp)
(st gr2 2 sp)
(call merge-sort) ; -> gr0
(ld gr4 gr0) ; gr0 -> gr4
(st gr2 0 sp)
(st gr6 1 sp)
(call drop) ; -> gr0 (後半の先頭)
(st gr5 0 sp) ; 後半をソート
(st gr0 1 sp)
(st gr3 2 sp)
(call merge-sort) ; -> gr0
(st gr5 0 sp) ; 前半と後半をマージする
(st gr4 1 sp)
(st gr0 2 sp)
(call merge) ; -> gr0
(lad sp 3 sp)
merge-sort-exit
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
merge-sort-1
(lad sp -2 sp)
(ld gr0 0 gr6) ; (car gr6) -> gr0
(st gr0 0 sp)
(xor gr0 gr0)
(st gr0 1 sp)
(call cons) ; -> gr0
(lad sp 2 sp)
(jump merge-sort-exit)
merge-sort-0
(xor gr0 gr0)
(jump merge-sort-exit)
プログラムは長くなりましたが、とくに難しいところはないと思います。コメントをみながらリストをお読みくださいませ。
簡単な実行例を示します。
リスト : merge-sort のテスト
test-merge-sort
(call initialize-heap)
(call initialize-list)
(lad sp -3 sp)
(lad gr0 data03)
(st gr0 0 sp)
(ld gr0 len03)
(st gr0 1 sp)
(call vector->list) ; -> gr0
(st gr0 1 sp)
(lad gr0 cmp)
(st gr0 0 sp)
(ld gr0 len03)
(st gr0 2 sp)
(call merge-sort)
(st gr0 0 sp)
(call print-list)
(call newline)
(lad sp 3 sp)
(halt)
len03 (dc 10)
data03 (dc 5 6 4 7 3 8 2 9 1 0)
* (asm-run "test.cas") 0 1 2 3 4 5 6 7 8 9 NIL
ところで、merge-list と merge-sort はリストを破壊的に操作してもプログラムすることができます。興味のある方は挑戦してみてください。
;
; lista.cas : 連結リストライブラリ (GC 機能付き)
;
; Copyright (C) 2011 Makoto Hiroi
;
; セルのデータ構造
;
; CELL 0 [ data ] : CAR
; 1 [ adrs ] : CDR size = 2 word
;
; gr1 = CELL とすると
; ld gr0 0 gr1 => data
; ld gr0 1 gr1 => adrs
;
; 最初に initialize-list を呼び出すこと
; 新しいセルを取得
; 入力 : None
; 出力 : gr0 (New Cell)
make-cell
(ld gr0 free-cell)
(jze make-cell-error)
make-cell-lab1
(ld gr1 1 gr0)
(st gr1 free-cell)
(ret)
make-cell-error
(call gc)
(ld gr0 free-cell)
(jnz make-cell-lab1)
; GC で回収できず (エラー終了)
(push list-error2)
(call write-line)
(halt)
list-error2
(dc "make-cell : Out of memory" 0)
; CONS
; 入力 : +2) a データ
; +3) b セル or null(0)
; 出力 : gr0 新しいセル
cons
(link gr7 0)
(call make-cell) ; -> gr0
(ld gr1 2 gr7)
(st gr1 0 gr0) ; CAR
(ld gr1 3 gr7)
(st gr1 1 gr0) ; CDR
(unlk gr7)
(ret)
; ベクタ -> リスト
; 入力 +2) : バッファアドレス
; +3) : 個数
; 出力 gr0 : リスト
vector->list
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(xor gr4 gr4) ; リストを保持
(ld gr2 2 gr7) ; 先頭アドレス
(ld gr3 3 gr7) ; 個数
(addl gr3 gr2)
(lad gr3 -1 gr3) ; 末尾要素のアドレス
vector->list-loop
(cpl gr3 gr2) ; 末尾から先頭へ
(jmi vector->list-exit)
(lad sp -2 sp)
(ld gr0 0 gr3) ; 要素を取り出す
(st gr0 0 sp)
(st gr4 1 sp)
(call cons) ; -> gr0
(lad sp 2 sp)
(ld gr4 gr0)
(lad gr3 -1 gr3)
(jump vector->list-loop)
vector->list-exit
(ld gr0 gr4)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; LIST
; 入力 +2) : 個数 N
; +3) : これ以降にリストに格納する要素が N 個続く
; 出力 gr0 : リスト
list
(link gr7 0)
(lad sp -2 sp)
(ld gr0 2 gr7)
(st gr0 1 sp) ; 個数をセット
(lad gr0 3 gr7) ; スタックのアドレスをセット
(st gr0 0 sp)
(call vector->list) ; -> gr0
(lad sp 2 sp)
(unlk gr7)
(ret)
; IOTA
; 入力 +2) : n
; +3) : m
; 出力 gr0 : (n ... m)
iota
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr3 3 gr7) ; m
(xor gr2 gr2) ; 生成するリスト
iota-loop
(cpa gr3 2 gr7)
(jmi iota-exit)
; m を gr2 の先頭に追加
(lad sp -2 sp)
(st gr3 0 sp)
(st gr2 1 sp)
(call cons)
(lad sp 2 sp)
(ld gr2 gr0)
(lad gr3 -1 gr3)
(jump iota-loop)
iota-exit
(ld gr0 gr2)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; LIST-REF
; 入力 +2) : リスト
; +3) : 位置
; 出力 gr0 : 要素
list-ref
(link gr7 0)
(push 0 gr2)
(xor gr2 gr2)
(ld gr1 2 gr7)
list-ref-loop
(jze list-ref-err)
(cpl gr2 3 gr7)
(jze list-ref-exit)
(lad gr2 1 gr2)
(ld gr1 1 gr1)
(jump list-ref-loop)
list-ref-exit
(ld gr0 0 gr1)
(pop gr2)
(unlk gr7)
(ret)
list-ref-err
(push list-error3)
(call write-line)
(halt)
list-error3
(dc "list-ref : Out of range" 0)
; MEMBER
; 入力 +2) : データ
; +3) : リスト
; 出力 gr0 : リスト or null
member
(link gr7 0)
(ld gr0 3 gr7)
member-loop
(jze member-exit)
(ld gr1 0 gr0)
(cpa gr1 2 gr7)
(jze member-exit)
(ld gr0 1 gr0)
(jump member-loop)
member-exit
(unlk gr7)
(ret)
; リストの長さを求める
; 入力 +2) : セル
; 出力 gr0 : 長さ
length
(link gr7 0)
(xor gr0 gr0) ; 長さ
(ld gr1 2 gr7) ; リスト
length-loop
(jze length-exit)
(lad gr0 1 gr0) ; 長さ += 1
(ld gr1 1 gr1) ; (cdr gr1) -> gr1
(jump length-loop)
length-exit
(unlk gr7)
(ret)
; REVERSE
; 入力 +2) : セル
; 出力 gr0 : 逆順にしたリスト
reverse
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(xor gr2 gr2) ; 反転したリスト
(ld gr3 2 gr7) ; 引数のリスト
reverse-loop
(jze reverse-exit)
; gr3 の要素を gr2 の先頭に追加
(lad sp -2 sp)
(ld gr0 0 gr3) ; (car gr3) -> gr0
(st gr0 0 sp)
(st gr2 1 sp)
(call cons) ; -> gr0 (new-cell)
(lad sp 2 sp)
(ld gr2 gr0)
(ld gr3 1 gr3) ; (cdr gr3) -> gr3
(jump reverse-loop)
reverse-exit
(ld gr0 gr2)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; NREVERSE (破壊的操作)
; 入力 +2) : セル
; 出力 gr0 : 逆順にしたリスト
nreverse
(link gr7 0)
(push 0 gr2)
(xor gr0 gr0)
(ld gr1 2 gr7)
nreverse-loop
(jze nreverse-exit)
(ld gr2 1 gr1) ; 次のセル -> gr2
(st gr0 1 gr1) ; gr1 の CDR を gr0 に書き換える
(ld gr0 gr1)
(ld gr1 gr2)
(jump nreverse-loop)
nreverse-exit
(pop gr2)
(unlk gr7)
(ret)
; APPEND (非再帰版)
; 入力 +2) : リスト a
; +3) : リスト b
; 出力 gr0 : リスト (a + b)
append
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(lad gr2 -2 gr7)
(xor gr3 gr3) ; gr3 = null (0)
(st gr3 0 gr2) ; header を 0 クリア
(st gr3 1 gr2)
(ld gr4 2 gr7) ; a -> gr4
append-loop
(jze append-exit)
(lad sp -2 sp)
(ld gr0 0 gr4) ; (car gr4) -> gr0
(st gr0 0 sp)
(st gr3 1 sp) ; null
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2) ; 末尾セルに接続
(ld gr2 gr0)
(ld gr4 1 gr4) ; (cdr gr4) -> gr4
(jump append-loop)
append-exit
(ld gr0 3 gr7)
(st gr0 1 gr2) ; リスト b を接続
(ld gr0 -1 gr7) ; (cdr header) -> gr0
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; DROP
; 入力 +2) : N
; +3) : リスト
; 出力 gr0 :
drop
(link gr7 0)
(ld gr1 2 gr7)
(ld gr0 3 gr7)
drop-loop
(jze drop-exit)
(and gr1 gr1)
(jze drop-exit)
(lad gr1 -1 gr1)
(ld gr0 1 gr0)
(jump drop-loop)
drop-exit
(unlk gr7)
(ret)
; TAKE
; 入力 +2) : N
; +3) : リスト
; 出力 gr0 :
take
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(lad gr2 -2 gr7) ; gr2 は末尾セルを保持
(xor gr0 gr0) ; header を 0 クリア
(st gr0 0 gr2)
(st gr0 1 gr2)
(ld gr3 2 gr7) ; N -> gr3
(ld gr4 3 gr7) ; リスト -> gr4
take-loop
(jze take-exit)
(and gr3 gr3)
(jze take-exit)
(lad sp -2 sp)
(ld gr0 0 gr4) ; (car gr4) -> gr0
(st gr0 0 sp)
(xor gr0 gr0)
(st gr0 1 sp)
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2) ; 末尾に接続
(ld gr2 gr0)
(lad gr3 -1 gr3)
(ld gr4 1 gr4) ; (cdr gr4) -> gr4
(jump take-loop)
take-exit
(ld gr0 -1 gr7) ; (cdr header) -> gr0
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; MAP (非再帰版)
; 入力 +2) : サブルーチン (1 引数)
; +3) : リスト
; 出力 gr0 : リスト
map
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(lad gr2 -2 gr7) ; gr2 は末尾セルを表す
(xor gr4 gr4) ; gr4 = null (0)
(st gr4 0 gr2) ; header を 0 クリア
(st gr4 1 gr2)
(ld gr3 2 gr7) ; サブルーチン -> gr3
(ld gr5 3 gr7) ; リスト -> gr5
map-loop
(jze map-exit)
(lad sp -2 sp)
; 要素にサブルーチンを適用する
(ld gr0 0 gr5) ; (car gr5) -> gr0
(st gr0 0 sp)
(call 0 gr3) ; -> gr0
; 結果をリストに格納
(st gr0 0 sp)
(st gr4 1 sp)
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2) ; 末尾セルに接続
(ld gr2 gr0)
(ld gr5 1 gr5)
(jump map-loop)
map-exit
(ld gr0 -1 gr7) ; (cdr header) -> gr0
(pop gr5)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; REMOVE (非再帰版)
; 入力 +2) : 削除する要素
; +3) : リスト
; 出力 gr0 : リスト
remove
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(lad gr2 -2 gr7) ; gr2 は末尾セルを保持する
(xor gr3 gr3) ; gr3 = null (0)
(st gr3 0 gr2) ; header を 0 クリア
(st gr3 1 gr2)
(ld gr4 3 gr7) ; リスト -> gr4
remove-loop
(jze remove-exit)
(ld gr0 0 gr4) ; (car gr4) -> gr0
(cpa gr0 2 gr7)
(jze remove-true)
; 削除しないで gr2 に追加
(lad sp -2 sp)
(st gr0 0 sp)
(st gr3 1 sp)
(call cons) ; -> gr0
(lad sp 2 sp)
(st gr0 1 gr2)
(ld gr2 gr0)
remove-true
(ld gr4 1 gr4) ; (cdr gr4) -> gr4
(jump remove-loop)
remove-exit
(ld gr0 -1 gr7) ; (cdr header) -> gr0
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; REMOVE-IF (非再帰版)
; 入力 +2) : サブルーチン
; +3) : 要素と比較するデータ
; +4) : リスト
remove-if
(link gr7 -2) ; header を用意
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(lad gr4 -2 gr7) ; gr4 は末尾セルを保持する
(xor gr5 gr5) ; gr5 = null (0)
(st gr5 0 gr4) ; header を 0 クリア
(st gr5 1 gr4)
(ld gr2 2 gr7) ; サブルーチン
(ld gr3 3 gr7) ; 比較するデータ
(ld gr6 4 gr7) ; リスト
remove-if-loop
(jze remove-if-exit)
(lad sp -2 sp)
; サブルーチンを呼び出す
(ld gr0 0 gr6) ; (car gr6) -> gr0
(st gr0 0 sp)
(st gr3 1 sp)
(call 0 gr2) ; -> gr0 (0:false, 1:true)
(and gr0 gr0)
(jnz remove-if-true) ; true の場合は削除
(ld gr0 0 gr6) ; (car gr6) -> gr0
(st gr0 0 sp)
(st gr5 1 sp)
(call cons) ; -> gr0
(st gr0 1 gr4) ; 末尾セルに接続
(ld gr4 gr0)
remove-if-true
(lad sp 2 sp)
(ld gr6 1 gr6) ; (cdr gr6) -> gr6
(jump remove-if-loop)
remove-if-exit
(ld gr0 -1 gr7) ; (cdr header) -> gr0
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; 畳み込み
; 入力 +2) : サブルーチン (2 引数 (func a x))
; +3) : リスト
; +4) : 初期値
; 出力 gr0 :
fold-left
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(ld gr2 4 gr7) ; 初期値 (累積変数)
(ld gr3 2 gr7) ; サブルーチン
(ld gr4 3 gr7) ; リスト
fold-left-loop
(jze fold-left-exit)
(lad sp -2 sp)
(st gr2 0 sp) ; 累積変数
(ld gr0 0 gr4) ; (car gr4) -> gr0
(st gr0 1 sp)
(call 0 gr3) ; -> gr0
(lad sp 2 sp)
(ld gr2 gr0)
(ld gr4 1 gr4)
(jump fold-left-loop)
fold-left-exit
(ld gr0 gr2)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; 畳み込み (非再帰版)
; 入力 +2) : サブルーチン (2 引数 (func x a))
; +3) : リスト
; +4) : 初期値
; 出力 gr0 :
fold-right
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(ld gr4 3 gr7) ; リスト -> gr4
(ld gr2 2 gr7) ; サブルーチン -> gr2
(ld gr3 4 gr7) ; 初期値 -> gr3
; リストを反転する
(push 0 gr4)
(call reverse) ; -> gr4
(pop gr4)
(ld gr4 gr0) ; リスト -> gr4
fold-right-loop
(jze fold-right-exit) ; null check
(lad sp -2 sp)
(ld gr0 0 gr4) ; (car gr4) -> gr0
(st gr0 0 sp) ; 要素をセット
(st gr3 1 sp)
(call 0 gr2) ; -> gr0
(lad sp 2 sp)
(ld gr3 gr0)
(ld gr4 1 gr4)
(jump fold-right-loop)
fold-right-exit
(ld gr0 gr3)
(pop gr4)
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; リストの要素にサブルーチンを適用する
; 入力 +2) : サブルーチン
; +3) : リスト
; 出力 None
for-each
(link gr7 0)
(push 0 gr2)
(push 0 gr3)
(ld gr2 2 gr7) ; サブルーチン
(ld gr3 3 gr7) ; セル
for-each-loop
(jze for-each-exit)
(ld gr0 0 gr3) ; 要素をセット
(push 0 gr0)
(call 0 gr2) ; サブルーチンを呼び出す
(pop gr0)
(ld gr3 1 gr3) ; 次のセル
(jump for-each-loop)
for-each-exit
(pop gr3)
(pop gr2)
(unlk gr7)
(ret)
; 空白付き出力
; 入力 +2) : 数値
; 出力 None
prints
(link gr7 0)
(ld gr0 2 gr7)
(push 0 gr0)
(call print) ; 要素を出力
(lad gr0 32) ; 空白
(st gr0 0 sp)
(call write-char)
(pop gr0)
(unlk gr7)
(ret)
; リストの表示
; 入力 +2) : セル
print-list
(link gr7 0)
(lad sp -2 sp)
(lad gr0 prints) ; 表示用関数
(st gr0 0 sp)
(ld gr0 2 gr7) ; セル
(st gr0 1 sp)
(call for-each)
(lad sp 2 sp)
(unlk gr7)
(ret)
;;;
;;; GC (Mark-sweep 法)
;;;
; MARK
; 入力 +2) : 開始アドレス
; +3) : 終了アドレス
; 出力 None
gc-mark
(link gr7 0)
(ld gr1 2 gr7) ; 開始アドレス
gc-mark-loop0
(cpl gr1 3 gr7)
(jze gc-mark-exit)
(ld gr2 0 gr1)
(cpl gr2 cell-top)
(jmi gc-mark-lab1) ; cell-top 未満
(cpl gr2 cell-end)
(jpl gc-mark-lab1) ; cell-end 以上
(ld gr0 gr2)
(and gr0 gc-flag)
(jnz gc-mark-lab1) ; 奇数は関係なし
;
gc-mark-loop1
(ld gr0 1 gr2) ; CDR -> gr0
(and gr0 gc-flag)
(jnz gc-mark-lab1) ; mark 済み
(ld gr0 1 gr2)
(ld gr3 gr0) ; CDR -> gr0, gr3
(or gr0 gc-flag)
(st gr0 1 gr2) ; flag-on
(ld gr2 gr3) ; 次のセルへ
(jnz gc-mark-loop1)
gc-mark-lab1
(lad gr1 1 gr1)
(jump gc-mark-loop0)
;
gc-mark-exit
(unlk gr7)
(ret)
; SWEEP
gc-sweep
(xor gr0 gr0)
(st gr0 free-cell) ; null clear
(ld gr1 cell-top)
gc-sweep-loop
(cpl gr1 cell-end)
(jze gc-sweep-exit)
(ld gr0 1 gr1) ; CDR
(and gr0 gc-flag)
(jnz gc-sweep-lab1) ; 使用中
; フリーセル
(ld gr0 free-cell)
(st gr0 1 gr1)
(st gr1 free-cell)
(lad gr1 2 gr1)
(jump gc-sweep-loop)
gc-sweep-lab1
; 使用中 (flag clear)
(ld gr0 1 gr1)
(and gr0 gc-mask)
(st gr0 1 gr1)
(lad gr1 2 gr1)
(jump gc-sweep-loop)
gc-sweep-exit
(ret)
;;;
;;; GC 本体
;;;
gc
(push 0 gr0) ; レジスタをスタックに退避
(push 0 gr1)
(push 0 gr2)
(push 0 gr3)
(push 0 gr4)
(push 0 gr5)
(push 0 gr6)
(push 0 gr7)
; スタック上のセルをマークする
(ld gr0 sp)
(lad sp -2 sp)
(st gr0 0 sp)
(lad gr0 #xffff)
(st gr0 1 sp)
(call gc-mark)
(lad sp 2 sp)
; 回収
(call gc-sweep)
;
(pop gr7)
(pop gr6)
(pop gr5)
(pop gr4)
(pop gr3)
(pop gr2)
(pop gr1)
(pop gr0)
(ret)
gc-mask (dc #xfffe)
gc-flag (dc #x0001)
; リストの初期化
; 入力 : None
; 出力 : None
initialize-list
(push #x4000) ; 引数セット
(call malloc) ; メモリ取得 (cell は 8k 個)
(pop gr1) ; 引数破棄
(and gr0 gr0)
(jze initialize-list-err)
(st gr0 cell-top) ; セル領域開始アドレス
(lad gr1 #x4000 gr0)
(st gr1 cell-end) ; セル領域終了アドレス
;
(st gr0 free-cell) ; フリーリストの先頭
initialize-loop
(lad gr1 2 gr0) ; 次のセルのアドレス
(cpl gr1 cell-end)
(jze initialize-exit)
(st gr1 1 gr0) ; CDR にセット
(ld gr0 gr1)
(jump initialize-loop)
initialize-exit
(xor gr1 gr1)
(st gr1 1 gr0) ; null で終端
(ret)
initialize-list-err
; エラー終了
(push list-error1)
(call write-line)
(halt)
list-error1
(dc "initialize-list : Out of memory" 0)
; 終了
; 入力 None
; 出力 None
destroy-list
(ld gr0 cell-top)
(push 0 gr0)
(call free)
(pop gr0)
(ret)
;;;
;;; セル領域
;;;
cell-top
(ds 1)
cell-end
(ds 1)
free-cell
(ds 1)