AM-Scheme(3)
この所、私のWindows機はご難続きである。今度は、メーラーとして使っている Thunderbirdの ごみ箱が忽然として姿を消してしまったのである。
ごみ箱が無いと、毎日押し寄せてくるSPAMを消せないのだ。ごみ箱が無いとどんな症状になるか と言うと、メニューから、迷惑メールを削除を選んでも、ごみ箱へ行かないのだ。ごみ箱って、 大切ですよ。
ごみ箱が無いなら作っちゃえとばかり、まんまの名前のフォルダーを作ってみた。 でも、これは Thunderbirdから、ごみ箱認定を受けられなかったみたいで、迷惑メール削除を選んでも、移動 してくれなかった。こりゃ困ったわい。早速、先生に聞いてみましたよ。
そしたら、やっぱり同例があり、解決方法は、一時バックアップを取り、プロファイルマネージャで 新規ユーザーを作り、、という方法が提示されていた。でもね、その通りにやるのもちょっと 負けた気分になるので、ちょいと調べてみたよ。
幸いおいらのマシンは女房と共有してるんで、女房のアカウントと比べてみた。そしたら、女房のには 、ごみ箱の変わりに、Trash.sbd と言うフォルダー、Trash.mstとTrashと言うファイルが存在 してた。おいらのには、それらが全く無かった。
だったら、この３つ組をコピーしちゃえと思ったけど、それは思い留めて、英語版のフォルダー Trash を Thunderbird上で作成してあげた。そして、Thunderbirdを再起動してあげたら、ちゃんとTrashが 消えて、ごみ箱になってた。Thunderbirdもこのごみ箱は認定してくれたよ。
何となく、Thunderbirdの仕組みが見えてきましたねぇ。Windows上のごみ箱も同じだろうな。
相も変わらず、amscmの追っかけ
次は、REPLの P を、先に見ておこうと思う。また、gdbで追いかける。gdbもコマンドが色々 あるので、リファレンス・カード を、取り寄せておくといいだろう。但し、"GDB under GNU Emacs"欄のキーバインドは、昔の ものなので、使えないです。
(gdb) b printlist
Breakpoint 1 at 0x8055e26: file print.c, line 154.
:
> "abc"
Breakpoint 1, printlist (list=0x28216fa8, file=0x805b444, f=1, pr=1)
at print.c:154
154 register pr_operator = OP_PRBEGIN;
(gdb) n
155 register long length = 0;
(gdb) n
158 switch(pr_operator) {
(gdb) n
161 g_push(&list) g_push(&file)
(gdb) n
162 p_save(OP_PREND, NIL)
(gdb) n
163 p_goto(OP_PRLST)
(gdb) n
158 switch(pr_operator) {
(gdb) n
170 if (!ispair(list)) {
(gdb) n
171 if (isvector(list)) {
(gdb) n
187 } else if (isbox(list)) {
(gdb)
194 length += printatom(list, file, f, pr);
(gdb) s
printatom (l=0x28216fa8, file=0x805b444, f=1, pr=1) at print.c:56
56 if (l == NIL) {
(gdb)
59 } else if (l == T) {
(gdb)
62 } else if (l == F) {
(gdb)
65 } else if (l == eof_object) {
(gdb)
68 } else if (isinteger(l)) {
(gdb)
70 } else if (isreal(l)) {
(gdb)
74 } else if (isstring(l)) {
(gdb)
75 if (f) { /* write */
(gdb)
76 len = strlength(l); p = strvalue(l);
どうやら、場合分けして表示してるようですねぇ。 細かに追って行っても、面白くなさそうなので、後は、ソースを見ると言う事で、お茶を 濁す事にしますか。
次はいよいよ、Evalに突入だけど、その前に、、
AM-Schemeでは、schemeのデータがHeap上にTAGを付けて格納されてます。そのデータをgdbから 確認しようとすると
> (cons 1 '(2 3))
Breakpoint 1, printlist (list=0x28217058, file=0x805b444, f=1, pr=1)
at print.c:154
154 register pr_operator = OP_PRBEGIN;
(gdb) p list
$2 = 0x28217058
(gdb) p *list
$3 = {_type = 10, _new = 0x28216fb8}
こんな風にしか表示してくれません。えーと、_type が10って、何だっけな？ amscm.hを見る はめになって、はなはだ宜しくない。そこで、gdb用のスクリプトを書く事にしました。
以下は、.gdbinitの内容です。（全部のstructは定義してませんが）
## .gdbinit for AM-Scheme struct
define rp
set $rbasic = (struct dummy_cell *)$arg0
set $flags = (*$rbasic)._type & 0xff
if ($flags == 0x01)
print "STRING"
print *(struct _str_cell*)$rbasic
end
if ($flags == 0x02)
print "INTEGER"
print *(struct _int_cell*)$rbasic
end
if ($flags == 0x06)
print "SYMBOL"
print *(struct _symbol_cell*)$rbasic
end
if ($flags == 0x07)
print "Syntax"
print *(struct _symbol_cell*)$rbasic
end
if ($flags == 0x08)
print "Prim1"
print *(struct _primitive_cell*)$rbasic
end
if ($flags == 0x09)
print "Prim2"
print *(struct _primitive_cell*)$rbasic
end
if ($flags == 0x0a)
print "PAIR"
print *(struct _cons_cell*)$rbasic
end
if ($flags == 12)
print "CLOSURE"
print *(struct _cons_cell*)$rbasic
end
if ($flags == 14)
print "MACRO"
print *(struct _cons_cell*)$rbasic
end
end
分かる人が見れば、ははー、どこからコピペしたなと直ぐに分かってしまいます。さて 何処からコピペしたでしょうか？ （ほら、あなたの身近にありますよ）
(gdb) rp list
$4 = "PAIR"
$5 = {_type = 10, _car = 0x28216fb8, _cdr = 0x28216ff8}
(gdb) rp 0x28216fb8
$6 = "INTEGER"
$7 = {_type = 2, _sign = 1 '\001', _size = 1, _array = {1}}
(gdb) rp 0x28216ff8
$8 = "PAIR"
$9 = {_type = 10, _car = 0x28216fc8, _cdr = 0x28216fe8}
(gdb) rp 0x28216fc8
$10 = "INTEGER"
$11 = {_type = 2, _sign = 1 '\001', _size = 1, _array = {2}}
(gdb) rp 0x28216fe8
$12 = "PAIR"
$13 = {_type = 10, _car = 0x28216fd8, _cdr = 0x805b460}
(gdb) rp 0x28216fd8
$14 = "INTEGER"
$15 = {_type = 2, _sign = 1 '\001', _size = 1, _array = {3}}
(gdb) c
Continuing.
(1 2 3)
こんな具合に、見やすくなりました。
いよいよ eval
Eval_CycleにBPを置いて、だらだらと動きを追ってみる。
Breakpoint 2 at 0x8049037: file eval.c, line 44. (gdb) c Continuing. > (cons "abc" '(123 456)) Breakpoint 2, Eval_Cycle (eval_operator=1) at eval.c:44
codeはPAIRだけどSYMBOLじゃないので、OP_E0ARGSを次にやるんだよと指示しつつ、condeの car(この場合は、cons)を取り出している。
続いて、OP_E0ARGSの所では、MACROじゃないので、次は、codeにcdrを取りつつ、OP_E1ARGSの評価準備。 続いて評価を進めると（この評価って、らっきょの皮を剥くように剥がしていくのが面白い） QUOTEが出てくるので、そこで取り合えず、剥くのは止め。
その後、OP_E3ARGSの中で、args[0]にconsを復帰、引数はargs[1]([2])にセットしてからOP_APPLYに突入。args[0]を解析した 結果、consは、T_PRIM2族である事が判明。該当するバイナリーの実行ルーチンを呼び出す。
実際に呼び出されるのは、PR_CONS() 。その中で、cons(args[1],args[2])を呼び出して、その 結果を返している。argsにはどんなデータが渡っているかと言うと
(gdb) rp args[1]
$21 = "STRING"
$22 = {_type = 1, _len = 3, _svalue = "a"}
(gdb) rp args[2]
$23 = "PAIR"
$24 = {_type = 10, _car = 0x28216fb8, _cdr = 0x28216fd8}
(gdb) rp 0x28216fb8
$25 = "INTEGER"
$26 = {_type = 2, _sign = 1 '\001', _size = 1, _array = {123}}
最終的な結果は
(gdb) c
Continuing.
("abc" 123 456)
と言う事で、Eval_Cycleの長い旅はやっと終わったのです。
長い旅を振り返ってみると、Eval_Cycleって、継続って言うかCPS変換されてるんですね。 OP_Eval -> OP_E0ARGS -> OP_E1ARGS -> OP_E2ARGS -> OP_E3ARGS -> APPLY -> T_PEIM2 -> OP_EVEND という具合に（PRIM2族の場合）制御が流れるように仕組まれてる。
馬鹿とgdbは使いよう
ここまで、gdb の n(ext)コマンドとb(reak)コマンドを主に使ってきた。でも、冒頭のQuick referenceを 見てたら、もっと便利に使えるコマンドが載ってたよ。
- tb 一回だけbreak させるコマンド
- watch ある変数を見張ってて、値が変化したらbreak
- finish 関数の終わりまで、継続実行
- until for(or while)の終わりまで実行
ちと遊んでいたら、、、
こうして、いろいろ遊んでいたら、gensym なんて言う手続きに遭遇した。これってMACROによく 登場するやつだ。だぶる事がないSYMBOLを作ってくれるはずなんだが。。
> (gensym) g0 > (gensym) g0
だぶってるじゃん。goshではどうなるか、調べてみると、
gosh> (gensym) G1 gosh> (gensym) G2
そうだよなあ。こうならなくっちゃ。ひょっとして、20年を経て、今蘇ったBUG？ 早速、ソースを見る。
[sakae@nil ~/v110/src]$ grep gensym *.c
init.c: mk_prim2(PR_GENSYM, "gensym", AT_LEAST_N(0));
mk.c:pointer gensym(head)
prim.c:pointer PR_GENSYM() /* gensym */
prim.c: Error("gensym -- first argument must be string");
prim.c: return (gensym(strvalue(args[1])));
prim.c: } else return(gensym(NULL));
本体は、mk.c に有り？
pointer gensym(head)
char *head;
{
long symcnt = 0, len;
register pointer x;
int hashpos;
do {
/* generate a symbol, test whether it is new or not */
if (head != NULL)
sprintf(&strbuff[0], "%s%lu", head, symcnt++);
else
sprintf(&strbuff[0], "G%lu", symcnt++);
/* check in oblist */
len = (long)strlen(&strbuff[0]);
hashpos = hash(&strbuff[0], len);
for (x = oblist[hashpos]; x != NIL ; x = cdr(x)) {
if (str_eqv(&strbuff[0], len, symname(car(x)), symlen(car(x))))
break;
}
} while (x != NIL);
x = mk_sym(&strbuff[0], len, STDCHARCASE);
return (x);
}
どう動くのかな？ 引数は有っても無くてもよくて、無い場合は、"G"で始まる文字に連番の 数字をくっつけて、仮のシンボルを作る。それが、既に登録されてない（新規）事を確認した 後、登録してるんか。あれ？ 先ほどの例では、"g1"から始まったな。"G1"を確認して"g1"を 登録してたら、おかしいよね。STDCHARCASEを確認したら小文字に変換を指定されてたよ。
どう修正してもいいけど、私は、頭文字を最初から"g"にした。
> (gensym) g0 > (gensym) g1
直った。直した。パチパチパチ。