AM-Scheme(1)

あの方からパーティの案内状が届いた。何でも、今度新宿と六本木ヒルズで大々的にやるからいっらっしゃいと言う案内である。

何度か行った事があり、その時の住所録に記録が残っていたようだ。また、行ってもいいんだけど、あれは麻薬だからなあ。中毒になっちゃうよ。

名前は、ACLとか言うらしい。FreeBSDの5だったかの時、「うまく動きませんよ」でも、４用の libmだったかを入れたら動きましたとアメリカの人に報告したら、それ以来覚えられてしまったみたい。今は、ACL8だけど、FreeBSD(7|8)では、何もしなくても動くのかな？

JREだと、compat7を入れてあげないと、FreeBSD8では動かないよと、宣伝されてたけど、どうなんだろう？ 8が出たら、ACL8も試してみるかな。

CPU実験の元

ネットをうろうろしてたら、とーだいのCPU実験の古い資料が見つかった。。

こちらが全体像になってて、レイトレの解説まで載ってた。昔の実験は、camelじゃなくて、scheme 大好き先生の持ち授業だったのね。

コンパイラの作り方も公開されてる。わずか１０こまで、解説しちゃうなんて凄いよ。CPSの話が面白い。

補足資料として何かないかと調べてみたら継続渡し形式（CPS）が見つかった。 shiroさんとこへのリンクも載ってた。東大で授業を受けてる気分になれるなぁ。

授業は授業でいいんだけど、自習も。という事で、この前から始めたAM-Schemeのソース解読を淡々と進めてみよう。まずは、全体像という事で、*.h に目を通す。

config.h

config.h を見る。

/*
 * Here is System declaration
 */
/* #define THINK_C     /* THINK C version 4.0 for Macintosh */
/* #define THINK_C_DA  /* THINK C version 4.0 for Macintosh DA */
/* #define MPW    /* Macintosh Programmer's Workshop */
/* #define BSD    /* 4.x BSD */
/* #define SYSV   /* System V */
/* #define VAXC   /* VAX/VMS -- defined by CC automagically (by Akira Kida) */
/* #define MSDOS  /* MS-DOS + MS-C6 (by Akira Kida) */

システムによる場合分けをしてますね。Macintosh を初めて使った時は、ターボパスカルだったなあ。それから、光速Cになって、最後は、THINK C を使った。だって、MPWなんて、高くて買えなかったもの。

そうそう、AM-Schemeを、FreeBSD 7.2 へ持ってきてコンパイルしたら、strlen と mallocが未定義でっせと警告された。しょうがないので、string.h と stdlib.h をincludeして黙らせた。FreeBSDと言えども、ちらちらと仕様が変わっているのね。（FreeBSD 6.4 では未警告だったよ）

amscm.h

amscmの重要な定義が凝縮されている。

S式を格納する時に付けるマーカーと言うかTAGの定義 T_XXX (T_BOXって、どんなやつ？想像出来ないや）

続いて、実際の格納形式とそれらに簡便にアクセスするためのマクロ類。たとえば、下記のような具合。（左側の数字は、行番号）

  50 /* cons cell structure */
  51 struct _cons_cell {
  52     cell_type _type;
  53     pointer _car; 
  54     pointer _cdr;    
  55 };
  56 typedef struct _cons_cell *cons_cell;
  57 #define CONSSIZE        (long)(sizeof(struct _cons_cell))
  58 #define ispair(p)       (type(p) == T_PAIR)
  59 #define car(p)          (((cons_cell)(p))->_car)
  60 #define cdr(p)          (((cons_cell)(p))->_cdr)
  61 #define isclosure(p)    (type(p) == T_CLOSURE)
  62 #define ismacro(p)      (type(p) == T_MACRO)
  63 #define closure_code(p) car(p)
  64 #define closure_env(p)  cdr(p)

closureは、cons_cellに格納してるんだと、読める。同じような具合で、continuationは vector_cellに格納してると分かる。

後半部分は、よく使うマクロ類（stackへのpush/popとか）が定義されている。

prim.h

組み込み手続きの extern 宣言をまとめて書き出してある。これらの実体は prim.cにほとんどまとめられている。

op.h

Eval_Cycleという評価器が使うdispatch用のTAG OP_XXX や、数学関係のTAG、後は、readerが使う token のTAG類が定義されている。

と、まあ、大急ぎで概観してきた。後は、debuggerでも使って、追いかけてみるかな。まずは、起動してプロンプトが出てくるまでの動きをみてみよう。

動き出すまで

[sakae@nil ~/v110/src]$ gdb amscm
GNU gdb 6.1.1 [FreeBSD]
 :
(gdb) b main
Breakpoint 1 at 0x804b860: file generic_os.c, line 168.
(gdb) run
Starting program: /usr/home/sakae/v110/src/amscm

Breakpoint 1, main (argc=Error accessing memory address 0x2: Bad address.) at generic_os.c:168
168     {
(gdb) n
main (argc=1, argv=0xbfbfec44) at generic_os.c:172
172         while (--argc) {
(gdb)
186         printf(Banner);
(gdb)
Hello, This is AM-Scheme Interpreter Version 1.10
187         if (init_scheme())

main関数は、generic_os.c にて定義されてるんだな。n で、少し進めると、Banner が出てきて、初期化の部分に差し掛かった。ここで、ソースが概観してみると、この後、初期化ファイルを読み込んでから、（若し起動時に指定した）引数があればそれをscmファイルと見なして、読み込み。REPLとおぼしきRep_From_Inputを呼び出している。すると、初期化は、init_scheme()という事になる。

(gdb) s
init_scheme () at init.c:314
314         NIL = (pointer)&_NIL;

init.cにて、初期化してるんだ。ソースを概観する。

 314     NIL = (pointer)&_NIL;
 315     for (i = 0 ; i < HASHTABLESIZE ; i++) oblist[i] = (pointer)&_NIL;
 316     T = (pointer)&_T; F = (pointer)&_F; eof_object = (pointer)&_eof_object;

NILとかT,F,eof_objectと言う、基本データを決定。また、schemeのシンボル名の登録先を初期化してるんだな。続いて、こまごました変数類を初期化が続き

 343     if ((Heap1 = (char *)malloc(MALLOCCAST(Heap_Size))) == NULL)
 344         goto INIT_FAILED;
 345     if ((long)Heap1 <= (long)OP_MAXNUM) {
 346         char *new = (char *)malloc(MALLOCCAST(Heap_Size));
 347         free(Heap1);
 348         if (new == NULL) goto INIT_FAILED;
 349         Heap1 = new;
 350     }

Schemeのデータを格納する領域をOSから貰ってきてるな。データの格納領域だから、さしずめ、倉庫と言った所か。この後、同一サイズの倉庫をもう一つ確保してる。(Heap1とHeap2)

 359     Current_Heap = Heap1;
 360     sprintf(&strbuff[0], 
 361            "allocated 2*%ld bytes main memory areas\n", Heap_Size);
 362     PrintString(std_output, &strbuff[0]);
 363     
 364     size = sizeof(pointer)*Stack_Size;    
 365     stackbottom = (pointer *)malloc(MALLOCCAST(size));

Heap1を現在の倉庫として登録後、誇らしげにメッセージを出してから、今度は、演算の時に使うスタックエリアを確保、それ類に関する変数を初期化。 S式の読み込み時に使うスタックも確保。そして、終盤へ。

 378     /* initialize Scheme's globals */
 379     init_globals();
 380 
 381     envir = global_env;
 382     code = NIL;
 383     Is_read_complete = 0;
 384     
 385     Init_read_stack()
 386 
 387 #ifdef USE_SIGNAL
 388     signal(SIGINT, get_signal);
 389 #endif
 390     car(global_env) = cons(cons(RESET_PATCH,
 391                                 mk_closure(cons(NIL, NIL), global_env)),
 392                            car(global_env));
 393     
 394     scheme_alive = 1;
 395     return (0);

init_globals()は、後回しにして、envir,codeと言う評価器用のレジスターを初期化。後は、割り込みを登録してから、環境を整えて終了。

それでは、後回しにした init_globals()を見る。

  98     /* initialize NIL */
  99     type(NIL) = 0;
 100     car(NIL) = cdr(NIL) = NIL;
 101     /* init T */
 102     type(T) = 0;;
 103     car(T) = cdr(T) = T;
 104     /* init F */
 105     type(F) = 0;
 106     car(F) = cdr(F) = F;
 107     /* init eof_object */
 108     type(eof_object) = 0;
 109     car(eof_object) = cdr(eof_object) = eof_object;    
 110     /* init global_env */
 111     global_env = cons(NIL, NIL);
 112 
 113     /* initialize character table */
 114     for (i = 0 ; i < CHARMAX ; i++) {
 115         x = (pointer)&char_table[i];
 116         type(x) = T_CHAR;
 117         cvalue(x) = (uShort)i;
 118     }
 119 
 120     /* initialize  syntax */
 121     mk_syntax(OP_LAMBDA, "lambda");
 122     mk_syntax(OP_QUOTE, "quote");
  :
 136     mk_syntax(OP_CASE0, "case");

Schemeレベルの構造を作っていく。最初に基本定数（？）、次は環境だけど、今は何もないので、NILで埋めている。続いて(256)文字分。次は、syntaxと呼ばれる、評価上特別扱いしなければならないシンボル。OP_LAMBDAと言うのは、評価器内の実行開始位置（ラベル）で、文字列"lambda"は、ユーザーが書く記述名。

 138     /* initialize primitive procedure */
 139     mk_prim1(OP_PRIMEVAL, "eval", MUST_BE_N(1));
 140     mk_prim1(OP_PRIMAPPLY, "apply", AT_LEAST_N(2));
 141     mk_prim1(OP_CONTINUATION, "call-with-current-continuation", MUST_BE_N(1));
 142     mk_prim1(OP_LOAD, "load", MUST_BE_N(1));
 143     mk_prim1(OP_READ, "read", AT_LEAST_N(0));
 144     mk_prim1(OP_RCHR, "read-char", AT_LEAST_N(0));
 145     mk_prim1(OP_PKCH, "peek-char", AT_LEAST_N(0));
 146 
 147     mk_prim2(PR_LIST, "list", AT_LEAST_N(0));
 148     mk_prim2(PR_CAR, "car", MUST_BE_N(1));
  :
 287     mk_prim2(PR_SETBOX, "set-box!", MUST_BE_N(2));
 288     mk_prim2(PR_EXIT, "exit", MUST_BE_N(0));

続いてたくさんある組み込み手続きの登録、OP_XXXで始まるものは、評価器内で直接評価される関数。PR_YYYで始まるものは、個別に登録されてる関数だ。個別の方の実体は、関数へのポインターになっている。

mk_prim1(2)の第二引数は、ユーザーが書く名前。第三引数は、関数が必要とする引数の数（アリティー）だ。MUST_BE_N(n)は、正確にｎ個の引数が必要という意味。AT_LEAST_N(n) は、n個以上の引数が必要と言う意味だ。

そんじゃ、ちと、登録関数mk_prim2 を見てみる

  80     x = mk_sym_from_cstr(name, STDCHARCASE);
  81     y = (pointer)Get_Heap(PRIMITIVESIZE(strlen(name)));
  82     strcpy(primname(y), name);
  83     type(y) = T_PRIM2;
  84     primargs(y) = n;
  85     primproc(y) = proc;
  86     car(global_env) = cons(cons(x, y), car(global_env));

Get_Heapで、必要なサイズをSchemeが管理する領域（倉庫）から切り出してきて、構造体を埋めている。最後に、グローバルな環境に登録してる。おっと、mk_sym_from_cstrを見ておく。この関数の実体は、mk_symになるので、これを見る。

 196     /* fisrt check oblist */
 197     hashpos = hash(name, len);
 198     for (x = oblist[hashpos]; x != NIL ; x = cdr(x)) {
 199         if (str_eqv(name, len, symname(car(x)), symlen(car(x))))
 200             break;
 201     }
 202 
 203     if (x != NIL) return (car(x));
 204     else {
 205         char *new;
 206         x = (pointer)Get_Heap(SYMBOLSIZE(len));
 207         for (i = 0, new = symname(x) ; i < len ; i++) new[i] = name[i];
 208         new[len] = '\0';
 209         symlen(x) = len;
 210         type(x) = T_SYMBOL;
 211         symprop(x) = NIL;
 212         g_push(&x)
 213         oblist[hashpos] = cons(x, oblist[hashpos]);
 214         g_pop(1)

関数名(namae)とその長さ(len)から、hash値を求め、そこから、調べるべき名前の登録簿の位置を割り出し、既に登録ずみか確認する。登録ずみなら、その位置を返す。まだ未登録なら名前を登録するエリアを切り出し、シンボルとして構造体を作る。後は、登録簿に、追加する。 Cで書くと、リンクの付け替えとかになるんだろうけど、consを１発発行するだけで済んじゃうのは、楽でいいなあ。

ついでだから、Get_Heapはどうなってるか、見ておくか。

  31     len = ((size + ALIGNMENT - 1)/ALIGNMENT)*ALIGNMENT;
  32     if (Free_Heap + len > Heap_Size) {
  33         gc();
  34         if (Free_Heap + len > Heap_Size)
  35             Error("run out of heap area --- rerurn to top level");
  36     }
  37     new = &Current_Heap[Free_Heap];
  38     Free_Heap += len;
  39     return (new);

要求されたサイズをアライメント単位で切り上げてから、そのサイズが提供出来るか確認。だめなら、ごみ掃除(gc)をやって場所の確保に努める。大丈夫なら、空きエリアの場所を返す。（その分だけ、空きエリアが減っていく）

gc

最後に、gc を見ておく。実際の動きはこんな具合だ。gc-verboseで、ごみ掃除の状況を報告せよ、と指定。dustと言うのは、ごみ製造手続きだ。これを動かすだけで、見えないごみが、わんさかと生まれてくれる。（注：特に意識しなくても、手続きの実行に伴い、ごみは生まれます。今回は、顕著にごみが生まれるようにしました。）

> (gc-verbose #t)
#t
> (define (dust d)
    (dust (cons #t d)))
dust
> (dust '())
gc...done. 167424 bytes are free.
gc...done. 125568 bytes are free.
gc...done. 94176 bytes are free.
gc...done. 70656 bytes are free.
Error: Unbound variable d
[return to toplevel]

ごみ製造機を動かしてみた。計算の進行により、データが蓄積されて行く為、ごみ掃除をやっても、だんだんと使える領域が少なくなって行き、最後は、自分自身の居場所も無くなって、プログラムが停止されました。（この挙動、ちと怪しいな）

どういう仕組みなってるかだな。予想は付くけど、STOP_COPY法だ。 SICPに解説がある。

  67     if (gc_verbose) PrintString(std_output, "gc...");
  68     
  69     Old_Heap = Current_Heap;
  70     Current_Heap = (Old_Heap == Heap1) ? Heap2 : Heap1;
  71     Free_Heap = 0;
  72 
  73     /* realloc system globals */
  74     for (i = 0 ; i < HASHTABLESIZE ; i++)
  75        oblist[i] = re_allocation(oblist[i]);
  76     global_env = re_allocation(global_env);
   :
 101     for (i = 0 ; i < output_ports ; i++)
 102         o_port_list[i] = re_allocation(o_port_list[i]);
 103 
 104     if (gc_verbose) {
 105        sprintf(&strbuff[0], "done. %ld bytes are free.\n", 
 106                             Heap_Size - Free_Heap);
 107        PrintString(std_output, &strbuff[0]);
 108     }

データを格納する倉庫を２つ用意し、一つは常用でどんどんデータを詰めていく。やがて一杯になると、もう一方を常用に切り替える。切り替えて古くなった倉庫から、使われているものだけを、（切り替えられた）常用倉庫に移してあげるって言う戦略。

問題は、どれが使われているかをどうやって見つけるかだ。Scheme-systemが知っている管理情報を元に、移動して行く事になる。この情報の事をrootと呼んでいる。

どんな物がrootになっているかと言うと、まずは、登録簿に登録されてる物、システムが使っている環境、、、いろいろあって最後は、出力port。実際の移動作業は、re_allocation 関数が受け持っている。（アート引越しセンターみたいなもんだな）この関数の一部を参考に見てみる。

 161     case T_SYNTAX:
 162        x = syntaxprop(old);
 163        v = syntaxlen(old);
 164        new = (pointer)Get_Heap(SYMBOLSIZE(v));
 165        memcpy(new, old, SYMBOLSIZE(v));
 166        type(old) = T_NULL;
 167        new_alloc(old) = new;
 168        syntaxprop(new) = re_allocation(x);
 169        return (new);

移したい荷物はoldというエリアの物。荷物の種類によって大きさ等が違うので、場合分けしてる。必要なデータを新しい方に写し、移したよマーク（SICPよれば、失恋マークと言うそうだ）として、 T_NULLを書き込んでおく。また、転居先も、古い方に書いておく。ここでは示さなかったけど、このルーチンの頭の所で、転居したか調べていて、転居してる事が判明したら、即転居先を返すようになっている。

荷物がチェーン状に繋がっている可能性があるので、自分自身を再帰的に呼び出して、移動を完了させる。終了したら、新しい移動先を返す。

こういう仕組みで、倉庫を切り替えながら使っている。これを称して和田先生は、「式年遍宮によるGC」と言っておられた。

大分長くなったので、この辺で。