3 色マークでリスト出力の write と write-shared の区別化

R7RS Scheme では write は循環参照だけをラベル付けで出力し、write-shared は循環参照であろうがなかろうがすべての共用されているセルをラベル付けで出力するものとして、区別しています。一方、「遅延スイープでストップ&コピーの待機領域をマークに使用してリスト出力を改良」は、2 色マークなので write-shared 専用です。これを 3 色マークに変更して write も扱えるようにします。

循環参照だけにラベル付けするには、白と黒の 2 色マークから、白・灰・黒の 3 色マークへ変更します。 write-shared では黒をラベル未割り当て、ラベル割り当ての 2 つの状態に分割したのと同様に、write でも灰を 2 つの状態に分割します。状態遷移を足し算を使って記述するために、次のようにマークの値を割り当てます。

0  白  未訪問
1  灰  走査中、ラベルなし
3  黒  走査完了、ラベルなし
5  灰  走査中、ラベル付け済み
7  黒  走査完了、ラベル付け済み、ラベル未出力 ("#%d=" 出力)
9  黒  ラベル出力済み、("#%d#" 出力)

マーク・ルーチンに引数を追加して、ラベルなしとする状態番号の最大値を指定できるようにします。これを 1 にすると、灰のときだけラベルを付け、循環参照だけにラベル出力するようにできます。これを 3 にすると、灰と黒の両方にラベルを付け、循環参照に限らず共用セルすべてにラベル出力をおこないます。

void
svmwrite (svm_t* svm, svmvalue_t x)
{
    long labeling = 0;

    if (svmptrok (x.u)
            && x.p >= svm->heap.live && x.p < svm->heap.free
            && (svmpairok (x.p[0].u) || svmtype (x.p[0].u) == SVMCVEC)) {
        svmgclazysweep (svm);
        svmwrmark (svm, x, &labeling, 1U);  /* 変更。循環参照に限る */
    }
    svmwrlist (svm, x);
    svmwrclearmark (svm, x);
}

void
svmwriteshare (svm_t* svm, svmvalue_t x)
{
    long labeling = 0;

    if (svmptrok (x.u)
            && x.p >= svm->heap.live && x.p < svm->heap.free
            && (svmpairok (x.p[0].u) || svmtype (x.p[0].u) == SVMCVEC)) {
        svmgclazysweep (svm);
        svmwrmark (svm, x, &labeling, 3U);  /* 変更。すべての共用セルを対象にする */
    }
    svmwrlist (svm, x);
    svmwrclearmark (svm, x);
}

両方の場合を扱えるように、マーク・ルーチンを修正します。

void
svmwrmark (svm_t* svm, svmvalue_t x, long* plabeling, uintptr_t unlabeled)
{
    if (svmptrok (x.u)
            && x.p >= svm->heap.live && x.p < svm->heap.free
            && (svmpairok (x.p[0].u) || svmtype (x.p[0].u) == SVMCVEC)) {
        svmvalue_t* mark = svm->heap.room + (x.p - svm->heap.live);
        if (mark[0].u > 0 && mark[0].u <= unlabeled) { /* 灰・黒でラベルなし */
            mark[1].i = svmi (*plabeling);
            (*plabeling)++;
            mark[0].u += 4U;
        }
        if (mark[0].u > 0) /* 白ではない */
            return;
        mark[0].u = 1U; /* 白から灰へ */
        if (svmpairok (x.p[0].u)) {
            svmwrmark (svm, x.p[0], plabeling, unlabeled);
            svmwrmark (svm, x.p[1], plabeling, unlabeled);
        }
        else {
            size_t n = svmsize (x.p[0].u);
            svmvalue_t* slot = x.p + 1;
            for (long i = 0; i < n; i++)
                svmwrmark (svm, *slot++, plabeling, unlabeled);
        }
        mark[0].u += 2U; /* 灰から黒へ */
    }
}

出力ルーチンの状態番号を合わせます。

void
svmwrlist (svm_t* svm, svmvalue_t x)
{
    if (svmintok (x.u)) {
        printf ("%d", svmi (x.i));
    }
    /* 途中略 */
    else if (svmpairok (x.p[0].u) || svmtype (x.p[0].u) == SVMCVEC) {
        svmvalue_t* mark = svm->heap.room + (x.p - svm->heap.live);
        if (mark[0].u == 7U) {      /* 修正 */
            printf ("#%d=", svmi (mark[1].i));
            mark[0].u = 9U;         /* 修正 */
        }
        else if (mark[0].u == 9U) { /* 修正 */
            printf ("#%d#", svmi (mark[1].i));
            return;
        }
        /* 途中略 */
    }
    /* 途中略 */
}

void
svmwrpair (svm_t* svm, svmvalue_t x)
{
    printf ("(");
    svmwrlist (svm, x.p[0]);
    for (svmvalue_t e = x.p[1]; ; e = e.p[1]) {
        /* 途中略 */
        svmvalue_t* mark = svm->heap.room + (e.p - svm->heap.live);
        if (mark[0].u == 7U) {      /* 修正 */
            /* the case of (1 . #0=(2 3 #0#)) */
            printf (" . ");
            svmwrlist (svm, e);
            printf (")");
            return;
        }
        printf (" ");
        svmwrlist (svm, e.p[0]);
    }
}