Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

cleaning up gc debug

Browse source
This commit is contained in:
Alex Shinn 2011-02-12 17:00:55 +09:00
parent 14f586453f
commit 3aeef15032
2 changed files with 77 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

110
gc.c
View file

@ -20,6 +20,12 @@ sexp_heap sexp_global_heap;
static sexp* stack_base; static sexp* stack_base;
#endif #endif
#if SEXP_USE_DEBUG_GC
#define sexp_debug_printf(fmt, ...) fprintf(stderr, SEXP_BANNER(fmt),__VA_ARGS__)
#else
#define sexp_debug_printf(fmt, ...)
#endif
static sexp_heap sexp_heap_last (sexp_heap h) { static sexp_heap sexp_heap_last (sexp_heap h) {
while (h->next) h = h->next; while (h->next) h = h->next;
return h; return h;
@ -35,15 +41,21 @@ static size_t sexp_heap_total_size (sexp_heap h) {
sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x) { sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x) {
sexp_uint_t res; sexp_uint_t res;
sexp t; sexp t;
if ((! sexp_pointerp(x)) || (sexp_pointer_tag(x) >= sexp_context_num_types(ctx))) if (!sexp_pointerp(x) || (sexp_pointer_tag(x) >= sexp_context_num_types(ctx)))
return sexp_heap_align(1); return sexp_heap_align(1);
t = sexp_object_type(ctx, x); t = sexp_object_type(ctx, x);
res = sexp_type_size_of_object(t, x); res = sexp_type_size_of_object(t, x);
#if SEXP_USE_DEBUG_GC
if (res == 0) {
fprintf(stderr, SEXP_BANNER("%p zero-size object: %p"), ctx, x);
return 1;
}
#endif
return res; return res;
} }
#if SEXP_USE_SAFE_GC_MARK #if SEXP_USE_SAFE_GC_MARK
static int sexp_in_heap_p(sexp ctx, sexp x) { int sexp_in_heap_p(sexp ctx, sexp x) {
sexp_heap h; sexp_heap h;
if ((sexp_uint_t)x & (sexp_heap_align(1)-1)) { if ((sexp_uint_t)x & (sexp_heap_align(1)-1)) {
fprintf(stderr, SEXP_BANNER("invalid heap alignment: %p"), x); fprintf(stderr, SEXP_BANNER("invalid heap alignment: %p"), x);
@ -55,8 +67,39 @@ static int sexp_in_heap_p(sexp ctx, sexp x) {
fprintf(stderr, SEXP_BANNER("invalid object outside heap: %p"), x); fprintf(stderr, SEXP_BANNER("invalid object outside heap: %p"), x);
return 0; return 0;
} }
#endif
#if SEXP_USE_DEBUG_GC > 1
int sexp_valid_object_type_p (sexp ctx, sexp x) {
if (sexp_pointer_tag(x)<=0 || sexp_pointer_tag(x)>sexp_context_num_types(ctx)){
fprintf(stderr, SEXP_BANNER("%p mark: bad object at %p: tag: %d"),
ctx, x, sexp_pointer_tag(x));
return 0;
}
return 1;
}
#endif
#if SEXP_USE_HEADER_MAGIC
int sexp_valid_header_magic_p (sexp ctx, sexp x) {
if (sexp_pointer_magic(x) != SEXP_POINTER_MAGIC
&& sexp_pointer_tag(x) != SEXP_TYPE && sexp_pointer_tag(x) != SEXP_OPCODE
&& sexp_pointer_tag(x) != SEXP_CORE && sexp_pointer_tag(x) != SEXP_STACK) {
fprintf(stderr, SEXP_BANNER("%p mark: bad magic at %p: %x"),
ctx, x, sexp_pointer_magic(x));
return 0;
}
return 1;
}
#else #else
#define sexp_in_heap_p(ctx, x) 1 #define sexp_valid_header_magic_p(ctx, x) 1
#endif
#if SEXP_DEBUG_GC > 1 || SEXP_USE_SAFE_GC_MARK || SEXP_USE_HEADER_MAGIC
int sexp_valid_object_p (sexp ctx, sexp x) {
return sexp_in_heap_p(ctx, x) && sexp_valid_object_type_p(ctx, x)
&& sexp_valid_header_magic_p(ctx, x);
}
#endif #endif
void sexp_mark (sexp ctx, sexp x) { void sexp_mark (sexp ctx, sexp x) {
@ -64,24 +107,8 @@ void sexp_mark (sexp ctx, sexp x) {
sexp t, *p; sexp t, *p;
struct sexp_gc_var_t *saves; struct sexp_gc_var_t *saves;
loop: loop:
if (!x || !sexp_pointerp(x) || !sexp_in_heap_p(ctx, x) || sexp_gc_mark(x)) if (!x || !sexp_pointerp(x) || !sexp_valid_object_p(ctx, x) || sexp_gc_mark(x))
return; return;
#if SEXP_USE_HEADER_MAGIC
if (sexp_pointer_magic(x) != SEXP_POINTER_MAGIC && sexp_pointer_tag(x) != SEXP_TYPE
&& sexp_pointer_tag(x) != SEXP_OPCODE && sexp_pointer_tag(x) != SEXP_CORE
&& sexp_pointer_tag(x) != SEXP_STACK) {
fprintf(stderr, SEXP_BANNER("%p mark: bad magic at %p: %p"),
ctx, p, sexp_pointer_magic(p));
return;
}
#endif
#if SEXP_USE_DEBUG_GC > 1
if (sexp_pointer_tag(x)<=0 || sexp_pointer_tag(x)>sexp_context_num_types(ctx)){
fprintf(stderr, SEXP_BANNER("%p mark: bad object at %p: tag: %d"),
ctx, x, sexp_pointer_tag(x));
return;
}
#endif
sexp_gc_mark(x) = 1; sexp_gc_mark(x) = 1;
if (sexp_contextp(x)) if (sexp_contextp(x))
for (saves=sexp_context_saves(x); saves; saves=saves->next) for (saves=sexp_context_saves(x); saves; saves=saves->next)
@ -93,7 +120,8 @@ void sexp_mark (sexp ctx, sexp x) {
for (i=0; i<len; i++) for (i=0; i<len; i++)
sexp_mark(ctx, p[i]); sexp_mark(ctx, p[i]);
x = p[len]; x = p[len];
goto loop; /* goto loop; */
sexp_mark(ctx, x);
} }
} }
@ -122,7 +150,7 @@ void sexp_conservative_mark (sexp ctx) {
p = (sexp) (((char*)p) + r->size); p = (sexp) (((char*)p) + r->size);
continue; continue;
} }
if (! sexp_gc_mark(p) && stack_references_pointer_p(ctx, p)) { if (!sexp_gc_mark(p) && stack_references_pointer_p(ctx, p)) {
#if SEXP_USE_DEBUG_GC > 3 #if SEXP_USE_DEBUG_GC > 3
if (p && sexp_pointerp(p)) { if (p && sexp_pointerp(p)) {
fprintf(stderr, SEXP_BANNER("MISS: %p: %s"), p,sexp_pointer_source(p)); fprintf(stderr, SEXP_BANNER("MISS: %p: %s"), p,sexp_pointer_source(p));
@ -185,6 +213,8 @@ void sexp_reset_weak_references(sexp ctx) {
} }
} }
} }
#else
#define sexp_reset_weak_references(ctx)
#endif #endif
sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) { sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
@ -202,22 +232,12 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
/* find the preceding and succeeding free list pointers */ /* find the preceding and succeeding free list pointers */
for (r=q->next; r && ((char*)r<(char*)p); q=r, r=r->next) for (r=q->next; r && ((char*)r<(char*)p); q=r, r=r->next)
; ;
#if SEXP_USE_HEADER_MAGIC
if (sexp_pointer_magic(p) != SEXP_POINTER_MAGIC)
fprintf(stderr, SEXP_BANNER("%p sweep: bad magic at %p: %p"),
ctx, p, sexp_pointer_magic(p));
#endif
if ((char*)r == (char*)p) { /* this is a free block, skip it */ if ((char*)r == (char*)p) { /* this is a free block, skip it */
p = (sexp) (((char*)p) + r->size); p = (sexp) (((char*)p) + r->size);
continue; continue;
} }
sexp_valid_object_p(ctx, p);
size = sexp_heap_align(sexp_allocated_bytes(ctx, p)); size = sexp_heap_align(sexp_allocated_bytes(ctx, p));
#if SEXP_USE_DEBUG_GC > 1
if (sexp_pointer_tag(p) <= 0
|| sexp_pointer_tag(p) > sexp_context_num_types(ctx))
fprintf(stderr, SEXP_BANNER("%p sweep: bad object at %p: tag: %d"),
ctx, p, sexp_pointer_tag(p));
#endif
#if SEXP_USE_DEBUG_GC #if SEXP_USE_DEBUG_GC
if (r && ((char*)p)+size > (char*)r) if (r && ((char*)p)+size > (char*)r)
fprintf(stderr, SEXP_BANNER("%p sweep: bad size at %p + %d > %p"), fprintf(stderr, SEXP_BANNER("%p sweep: bad size at %p + %d > %p"),
@ -268,27 +288,27 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
return sexp_make_fixnum(max_freed); return sexp_make_fixnum(max_freed);
} }
sexp sexp_gc (sexp ctx, size_t *sum_freed) {
sexp res;
#if SEXP_USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
void sexp_mark_global_symbols(ctx) {
int i; int i;
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++) for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
sexp_mark(ctx, sexp_symbol_table[i]); sexp_mark(ctx, sexp_symbol_table[i]);
}
#else
#define sexp_mark_global_symbols(ctx)
#endif #endif
#if SEXP_USE_DEBUG_GC
fprintf(stderr, SEXP_BANNER("%p (heap: %p size: %lu)"), ctx, sexp sexp_gc (sexp ctx, size_t *sum_freed) {
sexp_context_heap(ctx), sexp_heap_total_size(sexp_context_heap(ctx))); sexp res;
#endif sexp_debug_printf("%p (heap: %p size: %lu)", ctx, sexp_context_heap(ctx),
sexp_heap_total_size(sexp_context_heap(ctx)));
sexp_mark_global_symbols(ctx);
sexp_mark(ctx, ctx); sexp_mark(ctx, ctx);
sexp_conservative_mark(ctx); sexp_conservative_mark(ctx);
#if SEXP_USE_WEAK_REFERENCES
sexp_reset_weak_references(ctx); sexp_reset_weak_references(ctx);
#endif
res = sexp_sweep(ctx, sum_freed); res = sexp_sweep(ctx, sum_freed);
#if SEXP_USE_DEBUG_GC sexp_debug_printf("%p (freed: %lu max_freed: %lu)", ctx, *sum_freed,
fprintf(stderr, SEXP_BANNER("%p (freed: %lu max_freed: %lu)"), sexp_unbox_fixnum(res));
ctx, *sum_freed, sexp_unbox_fixnum(res));
#endif
return res; return res;
} }

12
include/chibi/sexp.h
View file

@ -1107,6 +1107,18 @@ SEXP_API void sexp_destroy_context (sexp ctx);
SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags); SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
#endif #endif
#if SEXP_USE_SAFE_GC_MARK
SEXP_API int sexp_in_heap_p(sexp ctx, sexp x);
#else
#define sexp_in_heap_p(ctx, x) 1
#endif
#if SEXP_DEBUG_GC > 1 || SEXP_USE_SAFE_GC_MARK || SEXP_USE_HEADER_MAGIC
SEXP_API int sexp_valid_object_p(sexp ctx, sexp x);
#else
#define sexp_valid_object_p(ctx, x) 1
#endif
#if SEXP_USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2); SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp parent, sexp slots); SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp parent, sexp slots);