conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #342 from picrin-scheme/faster-bitmap-marking 

Faster bitmap marking
This commit is contained in:
Yuichi Nishiwaki 2016-06-19 18:12:42 +09:00 committed by GitHub
parent dfc72fd011 f3845b7a0c
commit d49a0cdd16
8 changed files with 1524 additions and 728 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -52,6 +52,8 @@ extlib/benz/boot.o: extlib/benz/boot.c
$(BENZ_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): extlib/benz/include/picrin.h extlib/benz/include/picrin/*.h
extlib/benz/gc.o: $(wildcard extlib/benz/gc/*.c)
doc: docs/*.rst docs/contrib.rst
$(MAKE) -C docs html
mkdir -p doc

709
extlib/benz/gc.c
View File

@ -1,708 +1,7 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/private/object.h"
#include "picrin/private/state.h"
enum {
WHITE = 0,
BLACK = 1
};
union header {
struct {
union header *ptr;
size_t size;
} s;
};
struct heap_page {
union header *basep, *endp;
struct heap_page *next;
};
struct object {
union {
struct basic basic;
struct identifier id;
struct string str;
struct blob blob;
struct pair pair;
struct vector vec;
struct dict dict;
struct weak weak;
struct data data;
struct record rec;
struct env env;
struct proc proc;
struct context cxt;
struct port port;
struct error err;
struct checkpoint cp;
} u;
};
struct heap {
union header base, *freep;
struct heap_page *pages;
struct weak *weaks; /* weak map chain */
};
struct heap *
pic_heap_open(pic_state *pic)
{
struct heap *heap;
heap = pic_malloc(pic, sizeof(struct heap));
heap->base.s.ptr = &heap->base;
heap->base.s.size = 0; /* not 1, since it must never be used for allocation */
heap->freep = &heap->base;
heap->pages = NULL;
heap->weaks = NULL;
return heap;
}
void
pic_heap_close(pic_state *pic, struct heap *heap)
{
struct heap_page *page;
while (heap->pages) {
page = heap->pages;
heap->pages = heap->pages->next;
pic_free(pic, page->basep);
pic_free(pic, page);
}
pic_free(pic, heap);
}
#if PIC_USE_LIBC
void *
pic_default_allocf(void *PIC_UNUSED(userdata), void *ptr, size_t size)
{
if (size != 0) {
return realloc(ptr, size);
}
free(ptr);
return NULL;
}
#ifdef PIC_USE_BITMAPGC
# include "./gc/bitmap.c"
#else
# include "./gc/markandsweep.c"
#endif
void *
pic_malloc(pic_state *pic, size_t size)
{
void *ptr;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_realloc(pic_state *pic, void *ptr, size_t size)
{
ptr = pic->allocf(pic->userdata, ptr, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_calloc(pic_state *pic, size_t count, size_t size)
{
void *ptr;
size *= count;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
memset(ptr, 0, size);
return ptr;
}
void
pic_free(pic_state *pic, void *ptr)
{
pic->allocf(pic->userdata, ptr, 0);
}
static void
gc_protect(pic_state *pic, struct object *obj)
{
if (pic->arena_idx >= pic->arena_size) {
pic->arena_size = pic->arena_size * 2 + 1;
pic->arena = pic_realloc(pic, pic->arena, sizeof(struct object *) * pic->arena_size);
}
pic->arena[pic->arena_idx++] = obj;
}
pic_value
pic_protect(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return v;
gc_protect(pic, pic_obj_ptr(v));
return v;
}
size_t
pic_enter(pic_state *pic)
{
return pic->arena_idx;
}
void
pic_leave(pic_state *pic, size_t state)
{
pic->arena_idx = state;
}
static void *
heap_alloc(pic_state *pic, size_t size)
{
union header *p, *prevp;
size_t nunits;
assert(size > 0);
nunits = (size + sizeof(union header) - 1) / sizeof(union header) + 1;
prevp = pic->heap->freep;
for (p = prevp->s.ptr; ; prevp = p, p = p->s.ptr) {
if (p->s.size >= nunits)
break;
if (p == pic->heap->freep) {
return NULL;
}
}
if (p->s.size == nunits) {
prevp->s.ptr = p->s.ptr;
}
else {
p->s.size -= nunits;
p += p->s.size;
p->s.size = nunits;
}
pic->heap->freep = prevp;
return (void *)(p + 1);
}
static void
heap_free(pic_state *pic, void *ap)
{
union header *bp, *p;
assert(ap != NULL);
bp = (union header *)ap - 1;
for (p = pic->heap->freep; ! (bp > p && bp < p->s.ptr); p = p->s.ptr) {
if (p >= p->s.ptr && (bp > p || bp < p->s.ptr)) {
break;
}
}
if (bp + bp->s.size == p->s.ptr && p->s.ptr->s.size > 0) { /* don't melt base header */
bp->s.size += p->s.ptr->s.size;
bp->s.ptr = p->s.ptr->s.ptr;
} else {
bp->s.ptr = p->s.ptr;
}
if (p + p->s.size == bp && bp->s.size > 0) { /* don't melt base header */
p->s.size += bp->s.size;
p->s.ptr = bp->s.ptr;
} else {
p->s.ptr = bp;
}
pic->heap->freep = p;
}
static void
heap_morecore(pic_state *pic)
{
union header *bp, *np;
struct heap_page *page;
size_t nunits;
nunits = PIC_HEAP_PAGE_SIZE / sizeof(union header);
assert(nunits >= 2);
bp = pic_malloc(pic, PIC_HEAP_PAGE_SIZE);
bp->s.size = 0; /* bp is never used for allocation */
heap_free(pic, bp + 1);
np = bp + 1;
np->s.size = nunits - 1;
heap_free(pic, np + 1);
page = pic_malloc(pic, sizeof(struct heap_page));
page->basep = bp;
page->endp = bp + nunits;
page->next = pic->heap->pages;
pic->heap->pages = page;
}
/* MARK */
static void gc_mark_object(pic_state *, struct object *);
static void
gc_mark(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return;
gc_mark_object(pic, pic_obj_ptr(v));
}
static void
gc_mark_object(pic_state *pic, struct object *obj)
{
loop:
if (obj->u.basic.gc_mark == BLACK)
return;
obj->u.basic.gc_mark = BLACK;
#define LOOP(o) obj = (struct object *)(o); goto loop
switch (obj->u.basic.tt) {
case PIC_TYPE_PAIR: {
gc_mark(pic, obj->u.pair.car);
if (pic_obj_p(pic, obj->u.pair.cdr)) {
LOOP(pic_obj_ptr(obj->u.pair.cdr));
}
break;
}
case PIC_TYPE_CXT: {
int i;
for (i = 0; i < obj->u.cxt.regc; ++i) {
gc_mark(pic, obj->u.cxt.regs[i]);
}
if (obj->u.cxt.up) {
LOOP(obj->u.cxt.up);
}
break;
}
case PIC_TYPE_FUNC: {
int i;
for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
gc_mark(pic, obj->u.proc.locals[i]);
}
break;
}
case PIC_TYPE_IREP: {
if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt);
}
break;
}
case PIC_TYPE_PORT: {
break;
}
case PIC_TYPE_ERROR: {
gc_mark_object(pic, (struct object *)obj->u.err.type);
gc_mark_object(pic, (struct object *)obj->u.err.msg);
gc_mark(pic, obj->u.err.irrs);
LOOP(obj->u.err.stack);
break;
}
case PIC_TYPE_STRING: {
break;
}
case PIC_TYPE_VECTOR: {
int i;
for (i = 0; i < obj->u.vec.len; ++i) {
gc_mark(pic, obj->u.vec.data[i]);
}
break;
}
case PIC_TYPE_BLOB: {
break;
}
case PIC_TYPE_ID: {
gc_mark_object(pic, (struct object *)obj->u.id.u.id);
LOOP(obj->u.id.env);
break;
}
case PIC_TYPE_ENV: {
khash_t(env) *h = &obj->u.env.map;
int it;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, (struct object *)kh_key(h, it));
gc_mark_object(pic, (struct object *)kh_val(h, it));
}
}
if (obj->u.env.up) {
LOOP(obj->u.env.up);
}
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->mark) {
obj->u.data.type->mark(pic, obj->u.data.data, gc_mark);
}
break;
}
case PIC_TYPE_DICT: {
pic_value key, val;
int it = 0;
while (pic_dict_next(pic, pic_obj_value(&obj->u.dict), &it, &key, &val)) {
gc_mark(pic, key);
gc_mark(pic, val);
}
break;
}
case PIC_TYPE_RECORD: {
gc_mark(pic, obj->u.rec.type);
if (pic_obj_p(pic, obj->u.rec.datum)) {
LOOP(pic_obj_ptr(obj->u.rec.datum));
}
break;
}
case PIC_TYPE_SYMBOL: {
LOOP(obj->u.id.u.str);
break;
}
case PIC_TYPE_WEAK: {
struct weak *weak = (struct weak *)obj;
weak->prev = pic->heap->weaks;
pic->heap->weaks = weak;
break;
}
case PIC_TYPE_CP: {
if (obj->u.cp.prev) {
gc_mark_object(pic, (struct object *)obj->u.cp.prev);
}
if (obj->u.cp.in) {
gc_mark_object(pic, (struct object *)obj->u.cp.in);
}
if (obj->u.cp.out) {
LOOP((struct object *)obj->u.cp.out);
}
break;
}
default:
PIC_UNREACHABLE();
}
}
static void
gc_mark_phase(pic_state *pic)
{
pic_value *stack;
struct callinfo *ci;
struct list_head *list;
int it;
size_t j;
assert(pic->heap->weaks == NULL);
/* checkpoint */
if (pic->cp) {
gc_mark_object(pic, (struct object *)pic->cp);
}
/* stack */
for (stack = pic->stbase; stack != pic->sp; ++stack) {
gc_mark(pic, *stack);
}
/* callinfo */
for (ci = pic->ci; ci != pic->cibase; --ci) {
if (ci->cxt) {
gc_mark_object(pic, (struct object *)ci->cxt);
}
}
/* arena */
for (j = 0; j < pic->arena_idx; ++j) {
gc_mark_object(pic, (struct object *)pic->arena[j]);
}
/* ireps */
for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
struct irep *irep = (struct irep *)list;
for (j = 0; j < irep->npool; ++j) {
gc_mark_object(pic, irep->pool[j]);
}
}
/* global variables */
gc_mark(pic, pic->globals);
/* macro objects */
gc_mark(pic, pic->macros);
/* error object */
gc_mark(pic, pic->err);
/* features */
gc_mark(pic, pic->features);
/* library table */
for (it = kh_begin(&pic->ltable); it != kh_end(&pic->ltable); ++it) {
if (! kh_exist(&pic->ltable, it)) {
continue;
}
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).name);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).env);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).exports);
}
/* weak maps */
do {
struct object *key;
pic_value val;
int it;
khash_t(weak) *h;
struct weak *weak;
j = 0;
weak = pic->heap->weaks;
while (weak != NULL) {
h = &weak->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
key = kh_key(h, it);
val = kh_val(h, it);
if (key->u.basic.gc_mark == BLACK) {
if (pic_obj_p(pic, val) && pic_obj_ptr(val)->u.basic.gc_mark == WHITE) {
gc_mark(pic, val);
++j;
}
}
}
weak = weak->prev;
}
} while (j > 0);
}
/* SWEEP */
static void
gc_finalize_object(pic_state *pic, struct object *obj)
{
switch (obj->u.basic.tt) {
case PIC_TYPE_VECTOR: {
pic_free(pic, obj->u.vec.data);
break;
}
case PIC_TYPE_BLOB: {
pic_free(pic, obj->u.blob.data);
break;
}
case PIC_TYPE_STRING: {
pic_rope_decref(pic, obj->u.str.rope);
break;
}
case PIC_TYPE_ENV: {
kh_destroy(env, &obj->u.env.map);
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->dtor) {
obj->u.data.type->dtor(pic, obj->u.data.data);
}
break;
}
case PIC_TYPE_DICT: {
kh_destroy(dict, &obj->u.dict.hash);
break;
}
case PIC_TYPE_SYMBOL: {
/* TODO: remove this symbol's entry from pic->syms immediately */
break;
}
case PIC_TYPE_WEAK: {
kh_destroy(weak, &obj->u.weak.hash);
break;
}
case PIC_TYPE_IREP: {
pic_irep_decref(pic, obj->u.proc.u.i.irep);
break;
}
case PIC_TYPE_PAIR:
case PIC_TYPE_CXT:
case PIC_TYPE_PORT:
case PIC_TYPE_ERROR:
case PIC_TYPE_ID:
case PIC_TYPE_RECORD:
case PIC_TYPE_CP:
case PIC_TYPE_FUNC:
break;
default:
PIC_UNREACHABLE();
}
}
static size_t
gc_sweep_page(pic_state *pic, struct heap_page *page)
{
union header *bp, *p, *head = NULL, *tail = NULL;
struct object *obj;
size_t alive = 0;
for (bp = page->basep; ; bp = bp->s.ptr) {
p = bp + (bp->s.size ? bp->s.size : 1); /* first bp's size is 0, so force advnce */
for (; p != bp->s.ptr; p += p->s.size) {
if (p < page->basep || page->endp <= p) {
goto escape;
}
obj = (struct object *)(p + 1);
if (obj->u.basic.gc_mark == BLACK) {
obj->u.basic.gc_mark = WHITE;
alive += p->s.size;
} else {
if (head == NULL) {
head = p;
}
if (tail != NULL) {
tail->s.ptr = p;
}
tail = p;
tail->s.ptr = NULL; /* We can safely reuse ptr field of dead object */
}
}
}
escape:
/* free! */
while (head != NULL) {
p = head;
head = head->s.ptr;
gc_finalize_object(pic, (struct object *)(p + 1));
heap_free(pic, p + 1);
}
return alive;
}
static void
gc_sweep_phase(pic_state *pic)
{
struct heap_page *page;
int it;
khash_t(weak) *h;
khash_t(oblist) *s = &pic->oblist;
symbol *sym;
struct object *obj;
size_t total = 0, inuse = 0;
/* weak maps */
while (pic->heap->weaks != NULL) {
h = &pic->heap->weaks->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
obj = kh_key(h, it);
if (obj->u.basic.gc_mark == WHITE) {
kh_del(weak, h, it);
}
}
pic->heap->weaks = pic->heap->weaks->prev;
}
/* symbol table */
for (it = kh_begin(s); it != kh_end(s); ++it) {
if (! kh_exist(s, it))
continue;
sym = kh_val(s, it);
if (sym && sym->gc_mark == WHITE) {
kh_del(oblist, s, it);
}
}
page = pic->heap->pages;
while (page) {
inuse += gc_sweep_page(pic, page);
total += page->endp - page->basep;
page = page->next;
}
if (PIC_PAGE_REQUEST_THRESHOLD(total) <= inuse) {
heap_morecore(pic);
}
}
void
pic_gc(pic_state *pic)
{
if (! pic->gc_enable) {
return;
}
gc_mark_phase(pic);
gc_sweep_phase(pic);
}
void *
pic_alloca(pic_state *pic, size_t n)
{
static const pic_data_type t = { "pic_alloca", pic_free, 0 };
/* TODO: optimize */
return pic_data(pic, pic_data_value(pic, pic_malloc(pic, n), &t));
}
struct object *
pic_obj_alloc_unsafe(pic_state *pic, size_t size, int type)
{
struct object *obj;
#if GC_STRESS
pic_gc(pic);
#endif
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
pic_gc(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
heap_morecore(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL)
pic_panic(pic, "GC memory exhausted");
}
}
obj->u.basic.gc_mark = WHITE;
obj->u.basic.tt = type;
return obj;
}
struct object *
pic_obj_alloc(pic_state *pic, size_t size, int type)
{
struct object *obj;
obj = pic_obj_alloc_unsafe(pic, size, type);
gc_protect(pic, obj);
return obj;
}

774
extlib/benz/gc/bitmap.c Normal file
View File

@ -0,0 +1,774 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/private/object.h"
#include "picrin/private/khash.h"
#include "picrin/private/state.h"
#ifndef PIC_MEMALIGN
# error "bitmapgc requires PIC_MEMALIGN"
#endif
union header {
struct {
union header *ptr;
size_t size;
} s;
};
#define UNIT_SIZE (sizeof(uint32_t) * CHAR_BIT)
#define BITMAP_SIZE \
(PIC_HEAP_PAGE_SIZE / sizeof(union header) / UNIT_SIZE)
#define HEADER_SIZE ((PIC_HEAP_PAGE_SIZE - sizeof(struct heap_page)) / sizeof(union header))
struct heap_page {
struct heap_page *next;
size_t current;
uint32_t bitmap[BITMAP_SIZE];
uint32_t shadow[BITMAP_SIZE];
uint32_t index[BITMAP_SIZE / UNIT_SIZE];
};
struct object {
union {
struct basic basic;
struct identifier id;
struct string str;
struct blob blob;
struct pair pair;
struct vector vec;
struct dict dict;
struct weak weak;
struct data data;
struct record rec;
struct env env;
struct proc proc;
struct context cxt;
struct port port;
struct error err;
struct checkpoint cp;
} u;
};
struct heap {
struct heap_page *pages;
struct weak *weaks; /* weak map chain */
};
struct heap *
pic_heap_open(pic_state *pic)
{
struct heap *heap;
heap = pic_malloc(pic, sizeof(struct heap));
heap->pages = NULL;
heap->weaks = NULL;
return heap;
}
void
pic_heap_close(pic_state *pic, struct heap *heap)
{
struct heap_page *page;
while (heap->pages) {
page = heap->pages;
heap->pages = heap->pages->next;
pic_free(pic, page);
}
pic_free(pic, heap);
}
#if PIC_USE_LIBC
void *
pic_default_allocf(void *PIC_UNUSED(userdata), void *ptr, size_t size)
{
if (size != 0) {
return realloc(ptr, size);
}
free(ptr);
return NULL;
}
#endif
void *
pic_malloc(pic_state *pic, size_t size)
{
void *ptr;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_realloc(pic_state *pic, void *ptr, size_t size)
{
ptr = pic->allocf(pic->userdata, ptr, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_calloc(pic_state *pic, size_t count, size_t size)
{
void *ptr;
size *= count;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
memset(ptr, 0, size);
return ptr;
}
void
pic_free(pic_state *pic, void *ptr)
{
pic->allocf(pic->userdata, ptr, 0);
}
static void
gc_protect(pic_state *pic, struct object *obj)
{
if (pic->arena_idx >= pic->arena_size) {
pic->arena_size = pic->arena_size * 2 + 1;
pic->arena = pic_realloc(pic, pic->arena, sizeof(struct object *) * pic->arena_size);
}
pic->arena[pic->arena_idx++] = obj;
}
pic_value
pic_protect(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return v;
gc_protect(pic, pic_obj_ptr(v));
return v;
}
size_t
pic_enter(pic_state *pic)
{
return pic->arena_idx;
}
void
pic_leave(pic_state *pic, size_t state)
{
pic->arena_idx = state;
}
/* bitmap */
static union header *
index2header(struct heap_page *page, size_t index)
{
return ((union header *)(page + 1)) + index;
}
static struct heap_page *
obj2page(pic_state *PIC_UNUSED(pic), union header *h)
{
unsigned long int mask = ~(PIC_HEAP_PAGE_SIZE - 1);
return (struct heap_page *)(((unsigned long int) h) & mask);
}
static int
numofbits(unsigned long bits)
{
bits = bits - (bits >> 1 & 0x55555555);
bits = (bits & 0x33333333) + (bits >> 2 & 0x33333333);
bits = bits + ((bits >> 4) & 0x0f0f0f0f);
bits = bits * 0x01010101;
return bits >> 24;
}
static void
mark_at(struct heap_page *page, size_t index, size_t size)
{
size_t mask = ~(-1 << size);
size_t mark_size;
while (0 < size) {
if (size <= UNIT_SIZE - (index % UNIT_SIZE))
mark_size = size;
else
mark_size = UNIT_SIZE - (index % UNIT_SIZE);
page->bitmap[index / UNIT_SIZE] |= ~(-1 << mark_size) << (index % UNIT_SIZE);
size -= mark_size;
index += mark_size;
}
}
static int
is_marked_at(uint32_t *bitmap, size_t index, size_t size)
{
size_t test_size;
while (0 < size) {
if (size <= UNIT_SIZE - (index % UNIT_SIZE))
test_size = size;
else
test_size = UNIT_SIZE - (index % UNIT_SIZE);
if ((bitmap[index / UNIT_SIZE] >> (index % UNIT_SIZE)) & ~(-1 << test_size))
return 1;
size -= test_size;
index += test_size;
}
return 0;
}
static void *
heap_alloc_heap_page(struct heap_page *page, size_t nunits)
{
size_t index;
union header *p;
for (index = page->current; index < HEADER_SIZE - (nunits + 1); ++index) {
if (index % UNIT_SIZE == 0 && is_marked_at(page->index, index / UNIT_SIZE, 1)) {
index += UNIT_SIZE;
}
if (! is_marked_at(page->bitmap, index, nunits+1)) {
mark_at(page, index, nunits+1);
p = index2header(page, index);
p->s.size = nunits;
page->current = index + nunits + 1;
return (void *)(p+1);
}
}
return NULL;
}
static void *
heap_alloc(pic_state *pic, size_t size)
{
struct heap_page *p;
void *ret;
size_t nunits;
assert(size > 0);
nunits = (size + sizeof(union header) - 1) / sizeof(union header);
p = pic->heap->pages;
while (p) {
ret = heap_alloc_heap_page(p, nunits);
if (ret != NULL) {
return ret;
}
p = p->next;
}
return NULL;
}
static void
heap_morecore(pic_state *pic)
{
struct heap_page *page;
assert(2 <= HEADER_SIZE);
if(PIC_MEMALIGN(pic, (void **)&page, PIC_HEAP_PAGE_SIZE, PIC_HEAP_PAGE_SIZE) != 0)
pic_panic(pic, "memory exhausted");
memset(page->bitmap, 0, sizeof(page->bitmap));
memset(page->index, 0, sizeof(page->index));
page->current = 0;
page->next = pic->heap->pages;
pic->heap->pages = page;
}
static bool
is_marked(pic_state *pic, struct object *obj)
{
union header *h = ((union header *)obj) - 1;
struct heap_page *page;
size_t i;
page = obj2page(pic, h);
i = h - ((union header *)(page + 1));
return is_marked_at(page->bitmap, i, h->s.size + 1);
}
static void
mark(pic_state *pic, struct object *obj)
{
union header *h = ((union header *)obj) - 1;
struct heap_page *page;
size_t i;
page = obj2page(pic, h);
i = h - ((union header *)(page + 1));
mark_at(page, i, h->s.size + 1);
}
/* MARK */
static void gc_mark_object(pic_state *, struct object *);
static void
gc_mark(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return;
gc_mark_object(pic, pic_obj_ptr(v));
}
static void
gc_mark_object(pic_state *pic, struct object *obj)
{
loop:
if (is_marked(pic, obj))
return;
mark(pic, obj);
#define LOOP(o) obj = (struct object *)(o); goto loop
switch (obj->u.basic.tt) {
case PIC_TYPE_PAIR: {
gc_mark(pic, obj->u.pair.car);
if (pic_obj_p(pic, obj->u.pair.cdr)) {
LOOP(pic_obj_ptr(obj->u.pair.cdr));
}
break;
}
case PIC_TYPE_CXT: {
int i;
for (i = 0; i < obj->u.cxt.regc; ++i) {
gc_mark(pic, obj->u.cxt.regs[i]);
}
if (obj->u.cxt.up) {
LOOP(obj->u.cxt.up);
}
break;
}
case PIC_TYPE_FUNC: {
int i;
for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
gc_mark(pic, obj->u.proc.locals[i]);
}
break;
}
case PIC_TYPE_IREP: {
if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt);
}
break;
}
case PIC_TYPE_PORT: {
break;
}
case PIC_TYPE_ERROR: {
gc_mark_object(pic, (struct object *)obj->u.err.type);
gc_mark_object(pic, (struct object *)obj->u.err.msg);
gc_mark(pic, obj->u.err.irrs);
LOOP(obj->u.err.stack);
break;
}
case PIC_TYPE_STRING: {
break;
}
case PIC_TYPE_VECTOR: {
int i;
for (i = 0; i < obj->u.vec.len; ++i) {
gc_mark(pic, obj->u.vec.data[i]);
}
break;
}
case PIC_TYPE_BLOB: {
break;
}
case PIC_TYPE_ID: {
gc_mark_object(pic, (struct object *)obj->u.id.u.id);
LOOP(obj->u.id.env);
break;
}
case PIC_TYPE_ENV: {
khash_t(env) *h = &obj->u.env.map;
int it;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, (struct object *)kh_key(h, it));
gc_mark_object(pic, (struct object *)kh_val(h, it));
}
}
if (obj->u.env.up) {
LOOP(obj->u.env.up);
}
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->mark) {
obj->u.data.type->mark(pic, obj->u.data.data, gc_mark);
}
break;
}
case PIC_TYPE_DICT: {
pic_value key, val;
int it = 0;
while (pic_dict_next(pic, pic_obj_value(&obj->u.dict), &it, &key, &val)) {
gc_mark(pic, key);
gc_mark(pic, val);
}
break;
}
case PIC_TYPE_RECORD: {
gc_mark(pic, obj->u.rec.type);
if (pic_obj_p(pic, obj->u.rec.datum)) {
LOOP(pic_obj_ptr(obj->u.rec.datum));
}
break;
}
case PIC_TYPE_SYMBOL: {
LOOP(obj->u.id.u.str);
break;
}
case PIC_TYPE_WEAK: {
struct weak *weak = (struct weak *)obj;
weak->prev = pic->heap->weaks;
pic->heap->weaks = weak;
break;
}
case PIC_TYPE_CP: {
if (obj->u.cp.prev) {
gc_mark_object(pic, (struct object *)obj->u.cp.prev);
}
if (obj->u.cp.in) {
gc_mark_object(pic, (struct object *)obj->u.cp.in);
}
if (obj->u.cp.out) {
LOOP((struct object *)obj->u.cp.out);
}
break;
}
default:
PIC_UNREACHABLE();
}
}
static void
gc_mark_phase(pic_state *pic)
{
pic_value *stack;
struct callinfo *ci;
struct list_head *list;
int it;
size_t j;
assert(pic->heap->weaks == NULL);
/* checkpoint */
if (pic->cp) {
gc_mark_object(pic, (struct object *)pic->cp);
}
/* stack */
for (stack = pic->stbase; stack != pic->sp; ++stack) {
gc_mark(pic, *stack);
}
/* callinfo */
for (ci = pic->ci; ci != pic->cibase; --ci) {
if (ci->cxt) {
gc_mark_object(pic, (struct object *)ci->cxt);
}
}
/* arena */
for (j = 0; j < pic->arena_idx; ++j) {
gc_mark_object(pic, (struct object *)pic->arena[j]);
}
/* ireps */
for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
struct irep *irep = (struct irep *)list;
for (j = 0; j < irep->npool; ++j) {
gc_mark_object(pic, irep->pool[j]);
}
}
/* global variables */
gc_mark(pic, pic->globals);
/* macro objects */
gc_mark(pic, pic->macros);
/* error object */
gc_mark(pic, pic->err);
/* features */
gc_mark(pic, pic->features);
/* library table */
for (it = kh_begin(&pic->ltable); it != kh_end(&pic->ltable); ++it) {
if (! kh_exist(&pic->ltable, it)) {
continue;
}
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).name);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).env);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).exports);
}
/* weak maps */
do {
struct object *key;
pic_value val;
int it;
khash_t(weak) *h;
struct weak *weak;
j = 0;
weak = pic->heap->weaks;
while (weak != NULL) {
h = &weak->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
key = kh_key(h, it);
val = kh_val(h, it);
if (is_marked(pic, key)) {
if (pic_obj_p(pic, val) && ! is_marked(pic, pic_obj_ptr(val))) {
gc_mark(pic, val);
++j;
}
}
}
weak = weak->prev;
}
} while (j > 0);
}
/* SWEEP */
static void
gc_finalize_object(pic_state *pic, struct object *obj)
{
switch (obj->u.basic.tt) {
case PIC_TYPE_VECTOR: {
pic_free(pic, obj->u.vec.data);
break;
}
case PIC_TYPE_BLOB: {
pic_free(pic, obj->u.blob.data);
break;
}
case PIC_TYPE_STRING: {
pic_rope_decref(pic, obj->u.str.rope);
break;
}
case PIC_TYPE_ENV: {
kh_destroy(env, &obj->u.env.map);
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->dtor) {
obj->u.data.type->dtor(pic, obj->u.data.data);
}
break;
}
case PIC_TYPE_DICT: {
kh_destroy(dict, &obj->u.dict.hash);
break;
}
case PIC_TYPE_SYMBOL: {
/* TODO: remove this symbol's entry from pic->syms immediately */
break;
}
case PIC_TYPE_WEAK: {
kh_destroy(weak, &obj->u.weak.hash);
break;
}
case PIC_TYPE_IREP: {
pic_irep_decref(pic, obj->u.proc.u.i.irep);
break;
}
case PIC_TYPE_PAIR:
case PIC_TYPE_CXT:
case PIC_TYPE_PORT:
case PIC_TYPE_ERROR:
case PIC_TYPE_ID:
case PIC_TYPE_RECORD:
case PIC_TYPE_CP:
case PIC_TYPE_FUNC:
break;
default:
PIC_UNREACHABLE();
}
}
static void
gc_sweep_phase(pic_state *pic)
{
struct heap_page *page;
int it;
khash_t(weak) *h;
khash_t(oblist) *s = &pic->oblist;
symbol *sym;
struct object *obj;
size_t total = 0, inuse = 0;
/* weak maps */
while (pic->heap->weaks != NULL) {
h = &pic->heap->weaks->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
obj = kh_key(h, it);
if (! is_marked(pic, obj)) {
kh_del(weak, h, it);
}
}
pic->heap->weaks = pic->heap->weaks->prev;
}
/* symbol table */
for (it = kh_begin(s); it != kh_end(s); ++it) {
if (! kh_exist(s, it))
continue;
sym = kh_val(s, it);
if (! is_marked(pic, (struct object *)sym)) {
kh_del(oblist, s, it);
}
}
page = pic->heap->pages;
while(page) {
size_t index, i;
union header *h;
total += HEADER_SIZE;
for (i = 0; i < BITMAP_SIZE; ++i) {
page->shadow[i] &= ~page->bitmap[i];
inuse += numofbits(page->bitmap[i]);
}
for (index = 0; index < HEADER_SIZE; ++index) {
if (page->shadow[index / UNIT_SIZE] & (1 << (index % UNIT_SIZE))) {
h = index2header(page, index);
index += h->s.size;
gc_finalize_object(pic, (struct object *) (h + 1));
}
}
page = page->next;
}
if (PIC_PAGE_REQUEST_THRESHOLD(total) <= inuse) {
heap_morecore(pic);
}
}
void
gc_init(pic_state *pic)
{
struct heap_page *page;
page = pic->heap->pages;
while (page) {
/* clear mark bits */
memcpy(page->shadow, page->bitmap, sizeof(page->bitmap));
memset(page->bitmap, 0, sizeof(page->bitmap));
memset(page->index, 0, sizeof(page->index));
page->current = 0;
page = page->next;
}
}
void
pic_gc(pic_state *pic)
{
if (! pic->gc_enable) {
return;
}
gc_init(pic);
gc_mark_phase(pic);
gc_sweep_phase(pic);
}
void *
pic_alloca(pic_state *pic, size_t n)
{
static const pic_data_type t = { "pic_alloca", pic_free, 0 };
/* TODO: optimize */
return pic_data(pic, pic_data_value(pic, pic_malloc(pic, n), &t));
}
struct object *
pic_obj_alloc_unsafe(pic_state *pic, size_t size, int type)
{
struct object *obj;
#if GC_STRESS
pic_gc(pic);
#endif
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
pic_gc(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
heap_morecore(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL)
pic_panic(pic, "GC memory exhausted");
}
}
obj->u.basic.tt = type;
return obj;
}
struct object *
pic_obj_alloc(pic_state *pic, size_t size, int type)
{
struct object *obj;
obj = pic_obj_alloc_unsafe(pic, size, type);
gc_protect(pic, obj);
return obj;
}

708
extlib/benz/gc/markandsweep.c Normal file
View File

@ -0,0 +1,708 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "picrin/private/object.h"
#include "picrin/private/state.h"
enum {
WHITE = 0,
BLACK = 1
};
union header {
struct {
union header *ptr;
size_t size;
} s;
};
struct heap_page {
union header *basep, *endp;
struct heap_page *next;
};
struct object {
union {
struct basic basic;
struct identifier id;
struct string str;
struct blob blob;
struct pair pair;
struct vector vec;
struct dict dict;
struct weak weak;
struct data data;
struct record rec;
struct env env;
struct proc proc;
struct context cxt;
struct port port;
struct error err;
struct checkpoint cp;
} u;
};
struct heap {
union header base, *freep;
struct heap_page *pages;
struct weak *weaks; /* weak map chain */
};
struct heap *
pic_heap_open(pic_state *pic)
{
struct heap *heap;
heap = pic_malloc(pic, sizeof(struct heap));
heap->base.s.ptr = &heap->base;
heap->base.s.size = 0; /* not 1, since it must never be used for allocation */
heap->freep = &heap->base;
heap->pages = NULL;
heap->weaks = NULL;
return heap;
}
void
pic_heap_close(pic_state *pic, struct heap *heap)
{
struct heap_page *page;
while (heap->pages) {
page = heap->pages;
heap->pages = heap->pages->next;
pic_free(pic, page->basep);
pic_free(pic, page);
}
pic_free(pic, heap);
}
#if PIC_USE_LIBC
void *
pic_default_allocf(void *PIC_UNUSED(userdata), void *ptr, size_t size)
{
if (size != 0) {
return realloc(ptr, size);
}
free(ptr);
return NULL;
}
#endif
void *
pic_malloc(pic_state *pic, size_t size)
{
void *ptr;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_realloc(pic_state *pic, void *ptr, size_t size)
{
ptr = pic->allocf(pic->userdata, ptr, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
return ptr;
}
void *
pic_calloc(pic_state *pic, size_t count, size_t size)
{
void *ptr;
size *= count;
ptr = pic->allocf(pic->userdata, NULL, size);
if (ptr == NULL && size > 0) {
pic_panic(pic, "memory exhausted");
}
memset(ptr, 0, size);
return ptr;
}
void
pic_free(pic_state *pic, void *ptr)
{
pic->allocf(pic->userdata, ptr, 0);
}
static void
gc_protect(pic_state *pic, struct object *obj)
{
if (pic->arena_idx >= pic->arena_size) {
pic->arena_size = pic->arena_size * 2 + 1;
pic->arena = pic_realloc(pic, pic->arena, sizeof(struct object *) * pic->arena_size);
}
pic->arena[pic->arena_idx++] = obj;
}
pic_value
pic_protect(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return v;
gc_protect(pic, pic_obj_ptr(v));
return v;
}
size_t
pic_enter(pic_state *pic)
{
return pic->arena_idx;
}
void
pic_leave(pic_state *pic, size_t state)
{
pic->arena_idx = state;
}
static void *
heap_alloc(pic_state *pic, size_t size)
{
union header *p, *prevp;
size_t nunits;
assert(size > 0);
nunits = (size + sizeof(union header) - 1) / sizeof(union header) + 1;
prevp = pic->heap->freep;
for (p = prevp->s.ptr; ; prevp = p, p = p->s.ptr) {
if (p->s.size >= nunits)
break;
if (p == pic->heap->freep) {
return NULL;
}
}
if (p->s.size == nunits) {
prevp->s.ptr = p->s.ptr;
}
else {
p->s.size -= nunits;
p += p->s.size;
p->s.size = nunits;
}
pic->heap->freep = prevp;
return (void *)(p + 1);
}
static void
heap_free(pic_state *pic, void *ap)
{
union header *bp, *p;
assert(ap != NULL);
bp = (union header *)ap - 1;
for (p = pic->heap->freep; ! (bp > p && bp < p->s.ptr); p = p->s.ptr) {
if (p >= p->s.ptr && (bp > p || bp < p->s.ptr)) {
break;
}
}
if (bp + bp->s.size == p->s.ptr && p->s.ptr->s.size > 0) { /* don't melt base header */
bp->s.size += p->s.ptr->s.size;
bp->s.ptr = p->s.ptr->s.ptr;
} else {
bp->s.ptr = p->s.ptr;
}
if (p + p->s.size == bp && bp->s.size > 0) { /* don't melt base header */
p->s.size += bp->s.size;
p->s.ptr = bp->s.ptr;
} else {
p->s.ptr = bp;
}
pic->heap->freep = p;
}
static void
heap_morecore(pic_state *pic)
{
union header *bp, *np;
struct heap_page *page;
size_t nunits;
nunits = PIC_HEAP_PAGE_SIZE / sizeof(union header);
assert(nunits >= 2);
bp = pic_malloc(pic, PIC_HEAP_PAGE_SIZE);
bp->s.size = 0; /* bp is never used for allocation */
heap_free(pic, bp + 1);
np = bp + 1;
np->s.size = nunits - 1;
heap_free(pic, np + 1);
page = pic_malloc(pic, sizeof(struct heap_page));
page->basep = bp;
page->endp = bp + nunits;
page->next = pic->heap->pages;
pic->heap->pages = page;
}
/* MARK */
static void gc_mark_object(pic_state *, struct object *);
static void
gc_mark(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
return;
gc_mark_object(pic, pic_obj_ptr(v));
}
static void
gc_mark_object(pic_state *pic, struct object *obj)
{
loop:
if (obj->u.basic.gc_mark == BLACK)
return;
obj->u.basic.gc_mark = BLACK;
#define LOOP(o) obj = (struct object *)(o); goto loop
switch (obj->u.basic.tt) {
case PIC_TYPE_PAIR: {
gc_mark(pic, obj->u.pair.car);
if (pic_obj_p(pic, obj->u.pair.cdr)) {
LOOP(pic_obj_ptr(obj->u.pair.cdr));
}
break;
}
case PIC_TYPE_CXT: {
int i;
for (i = 0; i < obj->u.cxt.regc; ++i) {
gc_mark(pic, obj->u.cxt.regs[i]);
}
if (obj->u.cxt.up) {
LOOP(obj->u.cxt.up);
}
break;
}
case PIC_TYPE_FUNC: {
int i;
for (i = 0; i < obj->u.proc.u.f.localc; ++i) {
gc_mark(pic, obj->u.proc.locals[i]);
}
break;
}
case PIC_TYPE_IREP: {
if (obj->u.proc.u.i.cxt) {
LOOP(obj->u.proc.u.i.cxt);
}
break;
}
case PIC_TYPE_PORT: {
break;
}
case PIC_TYPE_ERROR: {
gc_mark_object(pic, (struct object *)obj->u.err.type);
gc_mark_object(pic, (struct object *)obj->u.err.msg);
gc_mark(pic, obj->u.err.irrs);
LOOP(obj->u.err.stack);
break;
}
case PIC_TYPE_STRING: {
break;
}
case PIC_TYPE_VECTOR: {
int i;
for (i = 0; i < obj->u.vec.len; ++i) {
gc_mark(pic, obj->u.vec.data[i]);
}
break;
}
case PIC_TYPE_BLOB: {
break;
}
case PIC_TYPE_ID: {
gc_mark_object(pic, (struct object *)obj->u.id.u.id);
LOOP(obj->u.id.env);
break;
}
case PIC_TYPE_ENV: {
khash_t(env) *h = &obj->u.env.map;
int it;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (kh_exist(h, it)) {
gc_mark_object(pic, (struct object *)kh_key(h, it));
gc_mark_object(pic, (struct object *)kh_val(h, it));
}
}
if (obj->u.env.up) {
LOOP(obj->u.env.up);
}
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->mark) {
obj->u.data.type->mark(pic, obj->u.data.data, gc_mark);
}
break;
}
case PIC_TYPE_DICT: {
pic_value key, val;
int it = 0;
while (pic_dict_next(pic, pic_obj_value(&obj->u.dict), &it, &key, &val)) {
gc_mark(pic, key);
gc_mark(pic, val);
}
break;
}
case PIC_TYPE_RECORD: {
gc_mark(pic, obj->u.rec.type);
if (pic_obj_p(pic, obj->u.rec.datum)) {
LOOP(pic_obj_ptr(obj->u.rec.datum));
}
break;
}
case PIC_TYPE_SYMBOL: {
LOOP(obj->u.id.u.str);
break;
}
case PIC_TYPE_WEAK: {
struct weak *weak = (struct weak *)obj;
weak->prev = pic->heap->weaks;
pic->heap->weaks = weak;
break;
}
case PIC_TYPE_CP: {
if (obj->u.cp.prev) {
gc_mark_object(pic, (struct object *)obj->u.cp.prev);
}
if (obj->u.cp.in) {
gc_mark_object(pic, (struct object *)obj->u.cp.in);
}
if (obj->u.cp.out) {
LOOP((struct object *)obj->u.cp.out);
}
break;
}
default:
PIC_UNREACHABLE();
}
}
static void
gc_mark_phase(pic_state *pic)
{
pic_value *stack;
struct callinfo *ci;
struct list_head *list;
int it;
size_t j;
assert(pic->heap->weaks == NULL);
/* checkpoint */
if (pic->cp) {
gc_mark_object(pic, (struct object *)pic->cp);
}
/* stack */
for (stack = pic->stbase; stack != pic->sp; ++stack) {
gc_mark(pic, *stack);
}
/* callinfo */
for (ci = pic->ci; ci != pic->cibase; --ci) {
if (ci->cxt) {
gc_mark_object(pic, (struct object *)ci->cxt);
}
}
/* arena */
for (j = 0; j < pic->arena_idx; ++j) {
gc_mark_object(pic, (struct object *)pic->arena[j]);
}
/* ireps */
for (list = pic->ireps.next; list != &pic->ireps; list = list->next) {
struct irep *irep = (struct irep *)list;
for (j = 0; j < irep->npool; ++j) {
gc_mark_object(pic, irep->pool[j]);
}
}
/* global variables */
gc_mark(pic, pic->globals);
/* macro objects */
gc_mark(pic, pic->macros);
/* error object */
gc_mark(pic, pic->err);
/* features */
gc_mark(pic, pic->features);
/* library table */
for (it = kh_begin(&pic->ltable); it != kh_end(&pic->ltable); ++it) {
if (! kh_exist(&pic->ltable, it)) {
continue;
}
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).name);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).env);
gc_mark_object(pic, (struct object *)kh_val(&pic->ltable, it).exports);
}
/* weak maps */
do {
struct object *key;
pic_value val;
int it;
khash_t(weak) *h;
struct weak *weak;
j = 0;
weak = pic->heap->weaks;
while (weak != NULL) {
h = &weak->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
key = kh_key(h, it);
val = kh_val(h, it);
if (key->u.basic.gc_mark == BLACK) {
if (pic_obj_p(pic, val) && pic_obj_ptr(val)->u.basic.gc_mark == WHITE) {
gc_mark(pic, val);
++j;
}
}
}
weak = weak->prev;
}
} while (j > 0);
}
/* SWEEP */
static void
gc_finalize_object(pic_state *pic, struct object *obj)
{
switch (obj->u.basic.tt) {
case PIC_TYPE_VECTOR: {
pic_free(pic, obj->u.vec.data);
break;
}
case PIC_TYPE_BLOB: {
pic_free(pic, obj->u.blob.data);
break;
}
case PIC_TYPE_STRING: {
pic_rope_decref(pic, obj->u.str.rope);
break;
}
case PIC_TYPE_ENV: {
kh_destroy(env, &obj->u.env.map);
break;
}
case PIC_TYPE_DATA: {
if (obj->u.data.type->dtor) {
obj->u.data.type->dtor(pic, obj->u.data.data);
}
break;
}
case PIC_TYPE_DICT: {
kh_destroy(dict, &obj->u.dict.hash);
break;
}
case PIC_TYPE_SYMBOL: {
/* TODO: remove this symbol's entry from pic->syms immediately */
break;
}
case PIC_TYPE_WEAK: {
kh_destroy(weak, &obj->u.weak.hash);
break;
}
case PIC_TYPE_IREP: {
pic_irep_decref(pic, obj->u.proc.u.i.irep);
break;
}
case PIC_TYPE_PAIR:
case PIC_TYPE_CXT:
case PIC_TYPE_PORT:
case PIC_TYPE_ERROR:
case PIC_TYPE_ID:
case PIC_TYPE_RECORD:
case PIC_TYPE_CP:
case PIC_TYPE_FUNC:
break;
default:
PIC_UNREACHABLE();
}
}
static size_t
gc_sweep_page(pic_state *pic, struct heap_page *page)
{
union header *bp, *p, *head = NULL, *tail = NULL;
struct object *obj;
size_t alive = 0;
for (bp = page->basep; ; bp = bp->s.ptr) {
p = bp + (bp->s.size ? bp->s.size : 1); /* first bp's size is 0, so force advnce */
for (; p != bp->s.ptr; p += p->s.size) {
if (p < page->basep || page->endp <= p) {
goto escape;
}
obj = (struct object *)(p + 1);
if (obj->u.basic.gc_mark == BLACK) {
obj->u.basic.gc_mark = WHITE;
alive += p->s.size;
} else {
if (head == NULL) {
head = p;
}
if (tail != NULL) {
tail->s.ptr = p;
}
tail = p;
tail->s.ptr = NULL; /* We can safely reuse ptr field of dead object */
}
}
}
escape:
/* free! */
while (head != NULL) {
p = head;
head = head->s.ptr;
gc_finalize_object(pic, (struct object *)(p + 1));
heap_free(pic, p + 1);
}
return alive;
}
static void
gc_sweep_phase(pic_state *pic)
{
struct heap_page *page;
int it;
khash_t(weak) *h;
khash_t(oblist) *s = &pic->oblist;
symbol *sym;
struct object *obj;
size_t total = 0, inuse = 0;
/* weak maps */
while (pic->heap->weaks != NULL) {
h = &pic->heap->weaks->hash;
for (it = kh_begin(h); it != kh_end(h); ++it) {
if (! kh_exist(h, it))
continue;
obj = kh_key(h, it);
if (obj->u.basic.gc_mark == WHITE) {
kh_del(weak, h, it);
}
}
pic->heap->weaks = pic->heap->weaks->prev;
}
/* symbol table */
for (it = kh_begin(s); it != kh_end(s); ++it) {
if (! kh_exist(s, it))
continue;
sym = kh_val(s, it);
if (sym && sym->gc_mark == WHITE) {
kh_del(oblist, s, it);
}
}
page = pic->heap->pages;
while (page) {
inuse += gc_sweep_page(pic, page);
total += page->endp - page->basep;
page = page->next;
}
if (PIC_PAGE_REQUEST_THRESHOLD(total) <= inuse) {
heap_morecore(pic);
}
}
void
pic_gc(pic_state *pic)
{
if (! pic->gc_enable) {
return;
}
gc_mark_phase(pic);
gc_sweep_phase(pic);
}
void *
pic_alloca(pic_state *pic, size_t n)
{
static const pic_data_type t = { "pic_alloca", pic_free, 0 };
/* TODO: optimize */
return pic_data(pic, pic_data_value(pic, pic_malloc(pic, n), &t));
}
struct object *
pic_obj_alloc_unsafe(pic_state *pic, size_t size, int type)
{
struct object *obj;
#if GC_STRESS
pic_gc(pic);
#endif
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
pic_gc(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL) {
heap_morecore(pic);
obj = (struct object *)heap_alloc(pic, size);
if (obj == NULL)
pic_panic(pic, "GC memory exhausted");
}
}
obj->u.basic.gc_mark = WHITE;
obj->u.basic.tt = type;
return obj;
}
struct object *
pic_obj_alloc(pic_state *pic, size_t size, int type)
{
struct object *obj;
obj = pic_obj_alloc_unsafe(pic, size, type);
gc_protect(pic, obj);
return obj;
}

9
extlib/benz/include/picrin/private/object.h
View File

@ -17,9 +17,14 @@ KHASH_DECLARE(env, struct identifier *, symbol *)
KHASH_DECLARE(dict, symbol *, pic_value)
KHASH_DECLARE(weak, struct object *, pic_value)
#define OBJECT_HEADER \
unsigned char tt; \
#ifdef PIC_USE_BITMAPGC
# define OBJECT_HEADER \
unsigned char tt;
#else
# define OBJECT_HEADER \
unsigned char tt; \
char gc_mark;
#endif
struct object; /* defined in gc.c */

8
extlib/benz/include/picrin/setup.h
View File

@ -167,6 +167,14 @@ typedef unsigned long uint32_t;
#include <assert.h>
#include <stdlib.h>
# ifndef PIC_MEMALIGN
# include <unistd.h>
# define PIC_MEMALIGN(pic, buf, alignment, size) posix_memalign(buf, alignment, size)
# endif
# ifndef PIC_USE_BITMAPGC
# define PIC_USE_BITMAPGC
# endif
#else
# define assert(v) (void)0

28
extlib/benz/read.c
View File

@ -25,7 +25,7 @@ typedef pic_value (*pic_reader_t)(pic_state *, xFILE *file, int c, struct reader
static pic_reader_t reader_table[256];
static pic_reader_t reader_dispatch[256];
static pic_value read(pic_state *pic, xFILE *file, int c, struct reader_control *p);
static pic_value read_safe(pic_state *pic, xFILE *file, int c, struct reader_control *p);
static pic_value read_nullable(pic_state *pic, xFILE *file, int c, struct reader_control *p);
PIC_NORETURN static void
@ -123,7 +123,7 @@ read_block_comment(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader
static pic_value
read_datum_comment(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_control *p)
{
read(pic, file, next(pic, file), p);
read_safe(pic, file, next(pic, file), p);
return pic_invalid_value(pic);
}
@ -152,13 +152,13 @@ read_directive(pic_state *pic, xFILE *file, int c, struct reader_control *p)
static pic_value
read_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_control *p)
{
return pic_list(pic, 2, pic_intern_lit(pic, "quote"), read(pic, file, next(pic, file), p));
return pic_list(pic, 2, pic_intern_lit(pic, "quote"), read_safe(pic, file, next(pic, file), p));
}
static pic_value
read_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_control *p)
{
return pic_list(pic, 2, pic_intern_lit(pic, "quasiquote"), read(pic, file, next(pic, file), p));
return pic_list(pic, 2, pic_intern_lit(pic, "quasiquote"), read_safe(pic, file, next(pic, file), p));
}
static pic_value
@ -172,19 +172,19 @@ read_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_contr
} else {
tag = pic_intern_lit(pic, "unquote");
}
return pic_list(pic, 2, tag, read(pic, file, next(pic, file), p));
return pic_list(pic, 2, tag, read_safe(pic, file, next(pic, file), p));
}
static pic_value
read_syntax_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_control *p)
{
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quote"), read(pic, file, next(pic, file), p));
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quote"), read_safe(pic, file, next(pic, file), p));
}
static pic_value
read_syntax_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reader_control *p)
{
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quasiquote"), read(pic, file, next(pic, file), p));
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quasiquote"), read_safe(pic, file, next(pic, file), p));
}
static pic_value
@ -198,7 +198,7 @@ read_syntax_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c), struct reade
} else {
tag = pic_intern_lit(pic, "syntax-unquote");
}
return pic_list(pic, 2, tag, read(pic, file, next(pic, file), p));
return pic_list(pic, 2, tag, read_safe(pic, file, next(pic, file), p));
}
static pic_value
@ -474,7 +474,7 @@ read_pair(pic_state *pic, xFILE *file, int c, struct reader_control *p)
return pic_nil_value(pic);
}
if (c == '.' && isdelim(peek(pic, file))) {
cdr = read(pic, file, next(pic, file), p);
cdr = read_safe(pic, file, next(pic, file), p);
closing:
if ((c = skip(pic, file, ' ')) != tCLOSE) {
@ -503,7 +503,7 @@ read_vector(pic_state *pic, xFILE *file, int c, struct reader_control *p)
pic_value list, it, elem, vec;
int i = 0;
list = read(pic, file, c, p);
list = read_safe(pic, file, c, p);
vec = pic_make_vec(pic, pic_length(pic, list), NULL);
@ -530,7 +530,7 @@ read_label_set(pic_state *pic, xFILE *file, int i, struct reader_control *p)
kh_val(h, it) = val = pic_cons(pic, pic_undef_value(pic), pic_undef_value(pic));
tmp = read(pic, file, c, p);
tmp = read_safe(pic, file, c, p);
pic_pair_ptr(pic, val)->car = pic_car(pic, tmp);
pic_pair_ptr(pic, val)->cdr = pic_cdr(pic, tmp);
@ -551,7 +551,7 @@ read_label_set(pic_state *pic, xFILE *file, int i, struct reader_control *p)
kh_val(h, it) = val = pic_make_vec(pic, 0, NULL);
tmp = read(pic, file, c, p);
tmp = read_safe(pic, file, c, p);
PIC_SWAP(pic_value *, pic_vec_ptr(pic, tmp)->data, pic_vec_ptr(pic, val)->data);
PIC_SWAP(int, pic_vec_ptr(pic, tmp)->len, pic_vec_ptr(pic, val)->len);
@ -562,7 +562,7 @@ read_label_set(pic_state *pic, xFILE *file, int i, struct reader_control *p)
}
default:
{
kh_val(h, it) = val = read(pic, file, c, p);
kh_val(h, it) = val = read_safe(pic, file, c, p);
return val;
}
@ -640,7 +640,7 @@ read_nullable(pic_state *pic, xFILE *file, int c, struct reader_control *p)
}
static pic_value
read(pic_state *pic, xFILE *file, int c, struct reader_control *p)
read_safe(pic_state *pic, xFILE *file, int c, struct reader_control *p)
{
pic_value val;

14
extlib/benz/write.c
View File

@ -357,7 +357,7 @@ write_core(pic_state *pic, pic_value obj, xFILE *file, struct writer_control *p)
}
static void
write(pic_state *pic, pic_value obj, xFILE *file, int mode, int op)
write_value(pic_state *pic, pic_value obj, xFILE *file, int mode, int op)
{
struct writer_control p;
@ -422,10 +422,10 @@ pic_vfprintf(pic_state *pic, pic_value port, const char *fmt, va_list ap)
xfputc(pic, '\n', file);
break;
case 'a':
write(pic, va_arg(ap, pic_value), file, DISPLAY_MODE, OP_WRITE);
write_value(pic, va_arg(ap, pic_value), file, DISPLAY_MODE, OP_WRITE);
break;
case 's':
write(pic, va_arg(ap, pic_value), file, WRITE_MODE, OP_WRITE);
write_value(pic, va_arg(ap, pic_value), file, WRITE_MODE, OP_WRITE);
break;
}
break;
@ -461,7 +461,7 @@ pic_write_write(pic_state *pic)
pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port);
write(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE);
write_value(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE);
return pic_undef_value(pic);
}
@ -471,7 +471,7 @@ pic_write_write_simple(pic_state *pic)
pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port);
write(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE_SIMPLE);
write_value(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE_SIMPLE);
return pic_undef_value(pic);
}
@ -481,7 +481,7 @@ pic_write_write_shared(pic_state *pic)
pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port);
write(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE_SHARED);
write_value(pic, v, pic_fileno(pic, port), WRITE_MODE, OP_WRITE_SHARED);
return pic_undef_value(pic);
}
@ -491,7 +491,7 @@ pic_write_display(pic_state *pic)
pic_value v, port = pic_stdout(pic);
pic_get_args(pic, "o|p", &v, &port);
write(pic, v, pic_fileno(pic, port), DISPLAY_MODE, OP_WRITE);
write_value(pic, v, pic_fileno(pic, port), DISPLAY_MODE, OP_WRITE);
return pic_undef_value(pic);
}