【C】ガベージコレクションのコード

下記の本が販売される前にガベージコレクションの実装を知りたいと思って学習したときのコードです。
10年以上前に作成したコードであり、今、見ても全く読み解けないのですが、当時は馬鹿正直に学習していたことを思い出しました。
今であれば、手抜きの簡単なガベコレであれば簡単に仕組みが分かるだけに絶対にこんな馬鹿正直に学習しないだけに、大変懐しいです。
これも資産なので残しておきます。

 

gc.c

/* ガベッジコレクションのサンプルコード
 * 以下のページより拝借
 * http://d.hatena.ne.jp/tanakaBox/searchdiary?word=%A5%D5%A5%E9%A5%B0 */
/*=========*/
/* include */
/*=========*/
#include <stdio.h>
#include <stdlib.h>

/*========*/
/* define */
/*========*/
#define cons(a, d) new_cons(scm, a, d)
#define number(a) new_number(scm, a)

/*=========*/
/* typedef */
/*=========*/
typedef struct object* object;
typedef struct scheme* scheme;

/*======*/
/* enum */
/*======*/
enum
{
    T_NUMBER,
    T_PAIR    /* list(配列)の場合にT_PAIRとなる */
};

/* GC用のフラグ */
enum
{
    GC_USE,    
    GC_NOT_USE
};

/*========*/
/* struct */
/*========*/
struct pair
{
    object car; /* リストの先頭要素        */
    object cdr; /* リストの2番目以降の要素 */
};

struct object
{
    int type;
    union
    {
        int          n;
        struct pair *c;
    } data;
    int    gc_flag;
    struct object *gc_next;
};

struct scheme
{
    int    object_counter;
    object gc_used;
};
/*========*/
/* extern */
/*========*/

/*=================*/
/* global variable */
/*=================*/
int malloc_counter = 0;


/*==========*/
/* function */
/*==========*/
void * xmalloc(int size);
void   xfree(void *o);
object new_object(scheme scm, int type);
void   free_object(scheme scm, object o);
object new_number(scheme scm, int n);
object new_cons (scheme scm, object car, object cdr);
object car(object o);
object cdr(object o);
object null(void);
int is_null(object o);
int is_pair(object o);
int is_list(object o);
void display(object o);
void newline(void);
void gc_clean_iter(scheme scm, object o);
void gc_clean_all(scheme scm);
void gc_check(scheme scm);
void gc_mark_object(object o);
object gc_sweep(scheme scm, object o);
scheme scheme_init(void);
void scheme_end(scheme scm);
void gc_test(scheme scm, object o);

/*===============*/
/* routine start */
/*===============*/
void *
xmalloc(int size)
{
    malloc_counter++;

    return malloc(size);
}

void 
xfree(void *o)
{
    malloc_counter--;

    free(o);
}

/* object */

object
new_object(scheme scm, int type)
{
    scm->object_counter++; /* リンクリストに繋がっているオブジェクト数 */

    object o = xmalloc(sizeof (struct object));

    o->type = type;

    o->gc_next = scm->gc_used;
    scm->gc_used = o;

    return o;
}

void
free_object(scheme scm, object o)
{
    /* リンクリストからオブジェクトを1つ外すので
     * カウントを1つ減らす */
    scm->object_counter--;

    switch(o->type)
    {
    case T_PAIR:
        xfree(o->data.c);
        break;
    }
    xfree(o);
}

/* objects */

object
new_number(scheme scm, int n)
{
    object o  = new_object(scm, T_NUMBER);

    o->data.n = n;

    return o;
}

object
new_cons
(
    scheme scm,
    object car, /* 先頭の要素 */
    object cdr  /* 2番目以降の要素 */
)
{
    object o = new_object(scm, T_PAIR);

    o->data.c = xmalloc(sizeof (struct pair));

    o->data.c->car = car;
    o->data.c->cdr = cdr;

    return o;
}

object
car(object o)
{
    return o->data.c->car;
}

object
cdr(object o)
{
    return o->data.c->cdr;
}

object
null(void)
{
    return NULL;
}

int
is_null(object o)
{
    return o == NULL;
}

int
is_pair(object o)
{
    /* オブジェクトがNULLではなく、かつ、T_PAIRの場合に真(1)を返す */
    return !is_null(o) && o->type == T_PAIR;
}

int
is_list(object o)
{
    return is_null(o) || o->type == T_PAIR;
}

void
display(object o)
{
    if(o == NULL)
    {
        printf("()");
        return;
    }

    switch(o->type)
    {
    case T_NUMBER:
        printf("%d", o->data.n);
        return;
    case T_PAIR:
        printf("(");
        for (;;)
        {
            display(car(o)); /* car(o) は return o->data.c->car するだけ */
            o = cdr(o);      /* cdr(o) は return o->data.c->cdr するだけ */
            if (is_null(o))  /* return o == NULL; するだけ               */
            {
                break; /* o != NULL の場合 */
            }
            else if (!is_pair(o))
            {
                printf(" . ");
                display(o);
                break;
            }
            else
            {
                printf(" ");
            }
        }
        printf(")");
        return;
    }
}

void
newline(void)
{
    printf("\n");
}

/* gc */

void
gc_clean_iter(scheme scm, object o)
{
    if (o == NULL)
    {
        return;
    }    

    gc_clean_iter(scm, o->gc_next);
    free_object(scm, o);
}

void
gc_clean_all(scheme scm)
{
    gc_clean_iter(scm, scm->gc_used);
}

void
gc_check(scheme scm)
{
    object o;

    for (o = scm->gc_used; o != NULL; o = o->gc_next)
        o->gc_flag = GC_NOT_USE;
}

void
gc_mark_object(object o)
{
    if (o == NULL)
    {
        return;
    }

    o->gc_flag = GC_USE; /* 0: GC_USE  */

    switch(o->type)
    {
    case T_PAIR: /* 1 ... consの場合、T_PAIRとなるみたい */
        gc_mark_object(car(o));
        gc_mark_object(cdr(o));
        return;
    default:
        return;
    }
}

object
gc_sweep(scheme scm, object o)
{
    if (o == NULL)
    {
        return NULL;
    }
    else if (o->gc_flag == GC_NOT_USE)
    {
        object tmp = gc_sweep(scm, o->gc_next);
        free_object(scm, o);
        return tmp;
    }
    else
    {
        o->gc_next = gc_sweep(scm, o->gc_next);
        return o;
    }
}

/* scheme */
scheme
scheme_init(void)
{
    scheme scm = xmalloc(sizeof (struct scheme)); 

    scm->object_counter = 0;
    scm->gc_used = NULL;

    return scm;
}

void
scheme_end(scheme scm)
{
    gc_clean_all(scm);

    printf("end : %d\n", scm->object_counter);

    xfree(scm);

    printf("malloc : %d\n", malloc_counter);
}

void
gc_test(scheme scm, object o)
{
    object copy = cons
                  (
                    car(o), /* return o->data.c->car; */
                    cdr(o)  /* return o->data.c->cdr; */
                  );
/*
 * [構造体の関係]
 * object構造体の gc_next は一つ前に作成された object構造体変数を
 * ポイントしている. (次の object構造体をポイントする)
 *
 *   object構造体(copy変数) ... gc_next 以外、data.cの構成等 o変数と同じになる
 *   +---------+
 *   | type    |
 *   | gc_flag |  cons(car(o), cdr(o))により、下記の car, cdr ポインタをコピーする
 *   | data.c------------------------> +-----+
 *   | gc_next------+                  | car ---------+
     +---------+    |                  | cdr ----+    |
 *                  |                  +-----+   |    |
 *                  | object構造体               |    |
 *                  V                            |    V
 *                  +---------+  +---------------| ---+
 *                  | type    |  |               |    |
 *                  | gc_flag |  |    pair構造体 |    |
 *                  | data.c ----|----> +-----+  |    V object構造体
 *                  | gc_next----+      | car -- | -> +---------+
 *                  +---------+         | cdr ---+    | type    |
 *                     ★               +-----+  |    | gc_flag |
 *                                        ★     |    |   2     |
 *                                               |    | gc_next-------+
 *                                               |    +---------+     |
 *                                               |                    |
 *                                               |    object構造体    |
 *                                               +--> +---------+ <---+
 *                                                    | type    |   +------------------+
 *                                                    | gc_flag |   |      pair構造体  |
 *                                                    | data.c -----|----->+-----+     V object構造体
 *                                                    | gc_next-----+      | car ----> +---------+
 *                                                    +---------+          | cdr |     | type    |
 *                                                                         +-----+     | gc_flag |
 *                                                                                     |   1     |
 *                                                                                     | gc_next ---> NULL
 *                                                                                     +---------+
 * [ Garbage Collection の手順 ]
 * 1. gc_check() で全オブジェクトに対して、GC_NOT_USE をマークする.
 * 2. gc_mark_object(copy) で、object構造体変数 copy から、car/cdr と辿れる
 *    オブジェクト全てに GC_USE をマークする
 * 3. gc_nextで全オブジェクトを辿って、GC_NOT_USE のオブジェクトを free する
 *
 * 上記の場合、★ が付いたオブジェクトは GC_NOT_USE となり、free対象となる
 */
    printf("check : %d\n", scm->object_counter);
    gc_check(scm); /* gc_nextを辿って、全オブジェクト(object)に
                    * GC_NOT_USE をマークする */

    printf("copyを残す : ");
    display(copy);
    newline();

    gc_mark_object(copy);

    scm->gc_used = gc_sweep(scm, scm->gc_used);

    printf("clean : %d\n", scm->object_counter);
}

int
main(void)
{
    scheme scm = scheme_init(); /* scheme構造体の領域を取得 */

    object o = cons /* cons('a, 'b) を評価すると (a b) となる */
               (
                   number(2),  /* new_number(scm, 2) */
                   cons        /* new_cons(scm, a, b) */
                   (
                       number(1), /* new_number(scm, 1) */
                       null()     /* return NULL */
                   )
               );

    display(o);
    newline(); /* 単に改行するだけの関数.. */

/*
 * [このときの構造体の関係]
 * object構造体の gc_next は一つ前に作成された object構造体変数を
 * ポイントしている. (次の object構造体をポイントする)
 * 
 * scheme構造体
 * +----------------+
 * | object_counter |    object構造体
 * | gc_used ---------->+---------+  +--------------------+
 * +----------------+   | type    |  |                    |
 *                      | gc_flag |  |      pair構造体    |
 *                      | data.c ----|----> +-----+       V object構造体
 *                      | gc_next----+      | car ------> +---------+
 *                      +---------+         | cdr ---+    | type    |
 *                                          +-----+  |    | gc_flag |
 *                                                   |    |   2     |
 *                                                   |    | gc_next-------+
 *                                                   |    +---------+     |
 *                                                   |                    |
 *                                                   |    object構造体    |
 *                                                   +--> +---------+ <---+
 *                                                        | type    |   +------------------+
 *                                                        | gc_flag |   |      pair構造体  |
 *                                                        | data.c -----|----->+-----+     V object構造体
 *                                                        | gc_next-----+      | car ----> +---------+
 *                                                        +---------+          | cdr |     | type    |
 *                                                                             +-----+     | gc_flag |
 *                                                                                         |   1     |
 *                                                                                         | gc_next ---> NULL
 *                                                                                         +---------+
 */
    gc_test(scm, o);

    scheme_end(scm);

    return EXIT_SUCCESS;
}