uclisp/src/memory.c

#include "uclisp.h"
#include "internal.h"
#include "arena.h"

#include <assert.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <stdint.h>

#ifndef UCL_SCOPE_ARENA_SIZE
#define UCL_SCOPE_ARENA_SIZE 16
#endif

#ifndef UCL_OBJECT_ARENA_SIZE
#define UCL_OBJECT_ARENA_SIZE (1 << 14)
#endif

static struct ucl_object *ucl_object_alloc();

static struct ucl_arena *object_arena = NULL;

struct ucl_object *ucl_cell_create(struct ucl_object *car, struct ucl_object *cdr)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_CELL;
    obj->cell.car = car;
    obj->cell.cdr = cdr;
    return obj;
}

struct ucl_object *ucl_int_create(int integer)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_INT;
    obj->integer = integer;
    return obj;
}

struct ucl_object *ucl_symbol_create(const char *symbol)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_SYMBOL;
    obj->symbol = strdup(symbol);
    return obj;
}

struct ucl_object *ucl_string_create(const char *string)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_STRING;
    obj->string = strdup(string);
    return obj;
}

struct ucl_object *ucl_error_create(const char *error)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_ERROR;
    obj->error = strdup(error);
    return obj;
}


struct ucl_object *ucl_builtin_create(ucl_lisp builtin)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_BUILTIN;
    obj->builtin = builtin;
    return obj;
}

struct ucl_object *ucl_special_create(ucl_lisp special)
{
    struct ucl_object* obj = ucl_object_alloc();
    obj->type = UCL_TYPE_SPECIAL;
    obj->special = special;
    return obj;
}


static struct ucl_object* ucl_object_alloc() {
    if (object_arena == NULL) {
        object_arena = ucl_arena_create(sizeof(struct ucl_object), UCL_OBJECT_ARENA_SIZE);
    }
    struct ucl_object *obj =  ucl_arena_get(object_arena);
    assert(obj != NULL);
    return obj;
}

void ucl_object_delete(struct ucl_object *obj) {
    if (obj == NULL) {
        return;
    }

    switch (obj->type) {
        case UCL_TYPE_CELL:
            //ucl_object_delete(obj->cell.car);
            obj->cell.car = NULL;
            //ucl_object_delete(obj->cell.cdr);
            obj->cell.cdr = NULL;
            break;
        case UCL_TYPE_SYMBOL:
            free((void *) obj->symbol);
            obj->symbol = NULL;
            break;
        case UCL_TYPE_STRING:
            free((void *) obj->string);
            obj->string = NULL;
            break;
        case UCL_TYPE_ERROR:
            free((void *) obj->error);
            obj->error = NULL;
            break;
        case UCL_TYPE_INT:
        case UCL_TYPE_BUILTIN:
        case UCL_TYPE_SPECIAL:
        case UCL_TYPE_COUNT:
            break;
    }

    ucl_arena_put(object_arena, obj);
}

static void ucl_object_mark(struct ucl_object *obj) {
    if (obj == NULL || obj->reachable) {
        return;
    }

    obj->reachable = 1;
    if (obj->type == UCL_TYPE_CELL) {
        ucl_object_mark(obj->cell.car);
        ucl_object_mark(obj->cell.cdr);
    }
}

static void ucl_scope_mark(struct ucl_arena * arena, void *obj) {
    (void) arena;
    struct ucl_scope *scope = (struct ucl_scope *) obj;

    ucl_object_mark(scope->list);
}

static void ucl_gc_unmark(struct ucl_arena * arena, void *obj) {
    (void) arena;
    struct ucl_object *object = (struct ucl_object *) obj;
    object->reachable = 0;
}

static void ucl_gc_sweep(struct ucl_arena * arena, void *obj) {
    (void) arena;
    struct ucl_object *object = (struct ucl_object *) obj;
    if (object->reachable == 0) {
         ucl_object_delete(object);
    }
}

static void ucl_gc_deleteall(struct ucl_arena * arena, void *obj) {
    (void) arena;
    struct ucl_object *object = (struct ucl_object *) obj;
    ucl_object_delete(object);
}


void ucl_gc() {
    if (object_arena == NULL) {
        return;
    }

    if (scope_arena != NULL) {
        ucl_arena_map(object_arena, ucl_gc_unmark);
        ucl_arena_map(scope_arena, ucl_scope_mark);
        ucl_arena_map(object_arena, ucl_gc_sweep);
    } else {
        ucl_arena_map(object_arena, ucl_gc_deleteall);
    }

}