diff options
Diffstat (limited to 'gc.c')
| -rw-r--r-- | gc.c | 368 |
1 files changed, 368 insertions, 0 deletions
@@ -0,0 +1,368 @@ +/* Copyright 2009 + * Kaz Kylheku <kkylheku@gmail.com> + * Vancouver, Canada + * All rights reserved. + * + * BSD License: + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in + * the documentation and/or other materials provided with the + * distribution. + * 3. The name of the author may not be used to endorse or promote + * products derived from this software without specific prior + * written permission. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <assert.h> +#include <setjmp.h> +#include <dirent.h> +#include "lib.h" +#include "gc.h" + +#define PROT_STACK_SIZE 1024 +#define HEAP_SIZE 16384 +#define REACHABLE 0x100 +#define FREE 0x200 + +typedef struct heap { + struct heap *next; + obj_t block[HEAP_SIZE]; +} heap_t; + +int opt_gc_debug; +obj_t **gc_stack_top; + +static obj_t **prot_stack[PROT_STACK_SIZE]; +static obj_t ***prot_stack_limit = prot_stack + PROT_STACK_SIZE; +static obj_t ***top = prot_stack; + +static obj_t *free_list, **free_tail = &free_list; +static heap_t *heap_list; + +int gc_enabled = 1; + +obj_t *prot1(obj_t **loc) +{ + assert (top < prot_stack_limit); + *top++ = loc; + return nil; /* for use in macros */ +} + +void rel1(obj_t **loc) +{ + /* protect and release calls must nest. */ + if (*--top != loc) + abort(); +} + +void protect(obj_t **first, ...) +{ + obj_t **next = first; + va_list vl; + va_start (vl, first); + + while (next) { + prot1(next); + next = va_arg(vl, obj_t **); + } + + va_end (vl); +} + +void release(obj_t **last, ...) +{ + obj_t **next = last; + va_list vl; + va_start (vl, last); + + while (next) { + rel1(next); + next = va_arg(vl, obj_t **); + } + + va_end (vl); +} + +static void more() +{ + heap_t *heap = (heap_t *) chk_malloc(sizeof *heap); + obj_t *block = heap->block, *end = heap->block + HEAP_SIZE; + + while (block < end) { + block->t.next = free_list; + block->t.type = FREE; + free_list = block++; + } + + free_tail = &block[-1].t.next; + + heap->next = heap_list; + heap_list = heap; +} + +obj_t *make_obj(void) +{ + int try; + + if (opt_gc_debug) + gc(); + + for (try = 0; try < 3; try++) { + if (free_list) { + obj_t *ret = free_list; + free_list = free_list->t.next; + return ret; + } + + free_tail = &free_list; + + switch (try) { + case 0: gc(); break; + case 1: more(); break; + } + } + + return 0; +} + +static void finalize(obj_t *obj) +{ + switch (obj->t.type) { + case CONS: + break; + case STR: + if (!opt_gc_debug) { + free(obj->st.str); + obj->st.str = 0; + } + break; + case CHR: + case NUM: + case SYM: + case FUN: + break; + case VEC: + if (!opt_gc_debug) { + free(obj->v.vec-2); + obj->v.vec = 0; + } + break; + case STREAM: + stream_close(obj); + break; + case LCONS: + break; + case COBJ: + obj->co.ops->destroy(obj); + break; + default: + assert (0 && "corrupt type field"); + } +} + +static void mark_obj(obj_t *obj) +{ + type_t t; + + if (obj == nil) + return; + + t = obj->t.type; + + if ((t & REACHABLE) != 0) + return; + + if ((t & FREE) != 0) + abort(); + + obj->t.type |= REACHABLE; + + switch (t) { + case CONS: + mark_obj(obj->c.car); + mark_obj(obj->c.cdr); + break; + case STR: + mark_obj(obj->st.len); + break; + case CHR: + case NUM: + break; + case SYM: + mark_obj(obj->s.name); + mark_obj(obj->s.val); + break; + case FUN: + mark_obj(obj->f.env); + if (obj->f.functype == FINTERP) + mark_obj(obj->f.f.interp_fun); + break; + case VEC: + { + obj_t *alloc_size = obj->v.vec[-2]; + obj_t *fill_ptr = obj->v.vec[-1]; + long i, fp = c_num(fill_ptr); + + mark_obj(alloc_size); + mark_obj(fill_ptr); + + for (i = 0; i < fp; i++) + mark_obj(obj->v.vec[i]); + } + break; + case STREAM: + mark_obj(obj->sm.label_pushback); + break; + case LCONS: + mark_obj(obj->lc.car); + mark_obj(obj->lc.cdr); + mark_obj(obj->lc.func); + break; + case COBJ: + mark_obj(obj->co.cls); + break; + default: + assert (0 && "corrupt type field"); + } +} + +static int in_heap(obj_t *ptr) +{ + heap_t *heap; + + for (heap = heap_list; heap != 0; heap = heap->next) { + if (ptr >= heap->block && ptr < heap->block + HEAP_SIZE) + if (((char *) ptr - (char *) heap->block) % sizeof (obj_t) == 0) + return 1; + } + + return 0; +} + +static void mark_mem_region(obj_t **bottom, obj_t **top) +{ + if (bottom > top) { + obj_t **tmp = top; + top = bottom; + bottom = tmp; + } + + while (bottom < top) { + obj_t *maybe_obj = *bottom; + if (in_heap(maybe_obj)) { + type_t t = maybe_obj->t.type; + if ((t & FREE) == 0) + mark_obj(maybe_obj); + } + bottom++; + } +} + +static void mark(void) +{ + obj_t *gc_stack_bottom; + obj_t ***rootloc; + + /* + * First, scan the officially registered locations. + */ + + for (rootloc = prot_stack; rootloc != top; rootloc++) { + if (*rootloc) /* stack may have nulls */ + mark_obj(**rootloc); + } + + mark_mem_region(&gc_stack_bottom, gc_stack_top); +} + +static void sweep(void) +{ + heap_t *heap; + int dbg = opt_gc_debug; + long freed = 0; + + for (heap = heap_list; heap != 0; heap = heap->next) { + obj_t *block, *end; + for (block = heap->block, end = heap->block + HEAP_SIZE; + block < end; + block++) + { + if (block->t.type & REACHABLE) { + block->t.type &= ~REACHABLE; + continue; + } + + if (block->t.type & FREE) + continue; + + if (0 && dbg) { + fprintf(stderr, "%s: finalizing: ", progname); + obj_print(block, stderr); + putc('\n', stderr); + } + finalize(block); + block->t.type |= FREE; + if (dbg) { + *free_tail = block; + block->t.next = nil; + free_tail = &block->t.next; + } else { + block->t.next = free_list; + free_list = block; + } + freed++; + } + } + + if (dbg) + fprintf(stderr, "%s: gc freed %ld blocks\n", progname, freed); +} + +void gc(void) +{ + if (gc_enabled) { + jmp_buf jmp; + setjmp(jmp); + mark(); + sweep(); + } +} + +int gc_state(int enabled) +{ + int old = gc_enabled; + gc_enabled = enabled; + return old; +} + +/* + * Useful functions for gdb'ing. + */ +void unmark(void) +{ + heap_t *heap; + + for (heap = heap_list; heap != 0; heap = heap->next) { + obj_t *block, *end; + for (block = heap->block, end = heap->block + HEAP_SIZE; + block < end; + block++) + { + block->t.type &= ~(FREE | REACHABLE); + } + } +} |