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

gc bug fixes, adding optional gc debugging utils

Browse source
This commit is contained in:
foof 2010-06-21 14:42:36 +00:00
parent b0bc96fc05
commit a24de22094
7 changed files with 113 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
eval.c
View file

@ -337,18 +337,18 @@ static void sexp_add_path (sexp ctx, const char *str) {
}
void sexp_init_eval_context_globals (sexp ctx) {
sexp_gc_var2(tmp, vec);
sexp_gc_var3(tmp, vec, ctx2);
ctx = sexp_make_child_context(ctx, NULL);
sexp_gc_preserve2(ctx, tmp, vec);
sexp_gc_preserve3(ctx, tmp, vec, ctx2);
vec = sexp_intern(ctx, "*current-exception-handler*", -1);
sexp_global(ctx, SEXP_G_ERR_HANDLER)
= sexp_env_cell_create(ctx, sexp_context_env(ctx), vec, SEXP_FALSE, NULL);
#if ! SEXP_USE_NATIVE_X86
emit(ctx, SEXP_OP_RESUMECC);
sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx);
ctx = sexp_make_child_context(ctx, NULL);
emit(ctx, SEXP_OP_DONE);
tmp = finalize_bytecode(ctx);
ctx2 = sexp_make_child_context(ctx, NULL);
emit(ctx2, SEXP_OP_DONE);
tmp = finalize_bytecode(ctx2);
vec = sexp_make_vector(ctx, 0, SEXP_VOID);
sexp_global(ctx, SEXP_G_FINAL_RESUMER)
= sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, tmp, vec);
@ -362,7 +362,7 @@ void sexp_init_eval_context_globals (sexp ctx) {
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), tmp);
tmp = sexp_c_string(ctx, ".", 1);
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), tmp);
sexp_gc_release2(ctx);
sexp_gc_release3(ctx);
}
sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size) {
@ -390,10 +390,12 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) {
sexp_context_stack(ctx),
sexp_context_env(ctx),
0);
sexp_context_lambda(res) = lambda;
sexp_context_top(res) = sexp_context_top(ctx);
sexp_context_fv(res) = sexp_context_fv(ctx);
sexp_context_tracep(res) = sexp_context_tracep(ctx);
if (! sexp_exceptionp(res)) {
sexp_context_lambda(res) = lambda;
sexp_context_top(res) = sexp_context_top(ctx);
sexp_context_fv(res) = sexp_context_fv(ctx);
sexp_context_tracep(res) = sexp_context_tracep(ctx);
}
return res;
}
@ -547,7 +549,7 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
else if (sexp_truep(sexp_memq(ctx, sexp_car(ls), sexp_cdr(ls))))
sexp_return(res, sexp_compile_error(ctx, "duplicate parameter", x));
/* build lambda and analyze body */
res = sexp_make_lambda(ctx, sexp_copy_list(ctx, sexp_cadr(x)));
res = sexp_make_lambda(ctx, tmp=sexp_copy_list(ctx, sexp_cadr(x)));
ctx2 = sexp_make_child_context(ctx, res);
tmp = sexp_flatten_dot(ctx2, sexp_lambda_params(res));
sexp_context_env(ctx2) = sexp_extend_env(ctx2, sexp_context_env(ctx2), tmp, res);
@ -581,7 +583,7 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
}
sexp_lambda_body(res) = body;
cleanup:
sexp_gc_release1(ctx);
sexp_gc_release6(ctx);
return res;
}

48
gc.c
View file

@ -8,21 +8,21 @@
#include <sys/mman.h>
#endif
#define SEXP_MINIMUM_OBJECT_SIZE (sexp_sizeof(pair))
#if SEXP_64_BIT
#define sexp_heap_align(n) sexp_align(n, 5)
#else
#define sexp_heap_align(n) sexp_align(n, 4)
#endif
#define SEXP_MINIMUM_OBJECT_SIZE (sexp_heap_align(sexp_sizeof(pair)))
#define sexp_heap_pad_size(s) (sizeof(struct sexp_heap_t) + (s) + sexp_heap_align(1))
#if SEXP_USE_GLOBAL_HEAP
sexp_heap sexp_global_heap;
#endif
#if SEXP_USE_DEBUG_GC
#if SEXP_USE_CONSERVATIVE_GC
static sexp* stack_base;
#endif
@ -41,6 +41,25 @@ sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x) {
return res;
}
#if SEXP_USE_SAFE_GC_MARK
static int sexp_in_heap(sexp ctx, sexp_uint_t x) {
sexp_heap h;
if (x & (sexp_heap_align(1)-1)) {
fprintf(stderr, "invalid heap alignment: %p %d\n", (sexp)x, sexp_pointer_tag((sexp)x));
return 0;
}
for (h=sexp_context_heap(ctx); h; h=h->next)
if (((sexp_uint_t)h < x) && (x < (sexp_uint_t)(h->data + h->size)))
return 1;
fprintf(stderr, "invalid object outside heap: %p %d\n", (sexp)x, sexp_pointer_tag((sexp)x));
return 0;
}
#endif
#if SEXP_USE_DEBUG_GC
#include "opt/gc_debug.c"
#endif
void sexp_mark (sexp ctx, sexp x) {
sexp_sint_t i, len;
sexp t, *p;
@ -48,6 +67,16 @@ void sexp_mark (sexp ctx, sexp x) {
loop:
if ((! x) || (! sexp_pointerp(x)) || sexp_gc_mark(x))
return;
#if SEXP_USE_SAFE_GC_MARK
if (! sexp_in_heap(ctx, (sexp_uint_t)x))
return;
#endif
#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)
return;
#endif
sexp_gc_mark(x) = 1;
if (sexp_contextp(x))
for (saves=sexp_context_saves(x); saves; saves=saves->next)
@ -63,7 +92,7 @@ void sexp_mark (sexp ctx, sexp x) {
}
}
#if SEXP_USE_DEBUG_GC
#if SEXP_USE_CONSERVATIVE_GC
int stack_references_pointer_p (sexp ctx, sexp x) {
sexp *p;
for (p=(&x)+1; p<stack_base; p++)
@ -85,7 +114,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
for ( ; h; h=h->next) {
p = (sexp) (h->data + sexp_heap_align(sexp_sizeof(pair)));
q = h->free_list;
end = (sexp) ((char*)h->data + h->size);
end = (sexp) ((char*)h->data + h->size - sexp_heap_align(sexp_sizeof(pair)));
while (p < end) {
/* find the preceding and succeeding free list pointers */
for (r=q->next; r && ((char*)r<(char*)p); q=r, r=r->next)
@ -148,6 +177,9 @@ sexp sexp_gc (sexp ctx, size_t *sum_freed) {
sexp_mark(ctx, sexp_symbol_table[i]);
#endif
sexp_mark(ctx, ctx);
#if SEXP_USE_DEBUG_GC
sexp_sweep_stats(ctx, 2, NULL, "* \x1B[31mFREE:\x1B[0m ");
#endif
res = sexp_sweep(ctx, sum_freed);
return res;
}
@ -166,7 +198,7 @@ sexp_heap sexp_make_heap (size_t size) {
h->data = (char*) sexp_heap_align((sexp_uint_t)&(h->data));
free = h->free_list = (sexp_free_list) h->data;
h->next = NULL;
next = (sexp_free_list) ((char*)free + sexp_heap_align(sexp_sizeof(pair)));
next = (sexp_free_list) (((char*)free) + sexp_heap_align(sexp_sizeof(pair)));
free->size = 0; /* actually sexp_sizeof(pair) */
free->next = next;
next->size = size - sexp_heap_align(sexp_sizeof(pair));
@ -308,13 +340,13 @@ sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags) {
#endif
void sexp_gc_init (void) {
#if SEXP_USE_GLOBAL_HEAP || SEXP_USE_DEBUG_GC
#if SEXP_USE_GLOBAL_HEAP || SEXP_USE_CONSERVATIVE_GC
sexp_uint_t size = sexp_heap_align(SEXP_INITIAL_HEAP_SIZE);
#endif
#if SEXP_USE_GLOBAL_HEAP
sexp_global_heap = sexp_make_heap(size);
#endif
#if SEXP_USE_DEBUG_GC
#if SEXP_USE_CONSERVATIVE_GC
/* the +32 is a hack, but this is just for debugging anyway */
stack_base = ((sexp*)&size) + 32;
#endif

23
include/chibi/features.h
View file

@ -66,6 +66,15 @@
/* uncomment this to add conservative checks to the native GC */
/* Please mail the author if enabling this makes a bug */
/* go away and you're not working on your own C extension. */
/* #define SEXP_USE_CONSERVATIVE_GC 1 */
/* uncomment this to add additional native checks to only mark objects in the heap */
/* #define SEXP_USE_SAFE_GC_MARK 1 */
/* uncomment this to add additional native gc checks to verify a magic header */
/* #define SEXP_USE_HEADER_MAGIC 1 */
/* uncomment this to add very verbose debugging stats to the native GC */
/* #define SEXP_USE_DEBUG_GC 1 */
/* uncomment this to make the heap common to all contexts */
@ -175,7 +184,7 @@
#define SEXP_MAXIMUM_HEAP_SIZE 0
#endif
#ifndef SEXP_MINIMUM_HEAP_SIZE
#define SEXP_MINIMUM_HEAP_SIZE 512*1024
#define SEXP_MINIMUM_HEAP_SIZE 8*1024
#endif
/* if after GC more than this percentage of memory is still in use, */
@ -257,6 +266,18 @@
#define SEXP_USE_DEBUG_GC 0
#endif
#ifndef SEXP_USE_SAFE_GC_MARK
#define SEXP_USE_SAFE_GC_MARK 0
#endif
#ifndef SEXP_USE_CONSERVATIVE_GC
#define SEXP_USE_CONSERVATIVE_GC 0
#endif
#ifndef SEXP_USE_HEADER_MAGIC
#define SEXP_USE_HEADER_MAGIC 0
#endif
#ifndef SEXP_USE_GLOBAL_HEAP
#if SEXP_USE_BOEHM || SEXP_USE_MALLOC
#define SEXP_USE_GLOBAL_HEAP 1

28
include/chibi/sexp.h
View file

@ -64,6 +64,10 @@ typedef unsigned long size_t;
#define SEXP_CHAR_TAG 6
#define SEXP_EXTENDED_TAG 14
#ifndef SEXP_POINTER_MAGIC
#define SEXP_POINTER_MAGIC 0xFDCA9764uL /* arbitrary */
#endif
#if SEXP_USE_HASH_SYMS
#define SEXP_SYMBOL_TABLE_SIZE 389
#else
@ -105,8 +109,8 @@ enum sexp_types {
SEXP_NUM_CORE_TYPES
};
typedef unsigned long sexp_uint_t;
typedef long sexp_sint_t;
typedef unsigned int sexp_uint_t;
typedef int sexp_sint_t;
#if SEXP_64_BIT
typedef unsigned int sexp_tag_t;
#else
@ -154,12 +158,16 @@ struct sexp_heap_t {
sexp_uint_t size;
sexp_free_list free_list;
sexp_heap next;
/* note this must be aligned on a proper heap boundary, */
/* so we can't just use char data[] */
char *data;
};
struct sexp_gc_var_t {
sexp *var;
/* char *name; */
#if SEXP_USE_CONSERVATIVE_GC
char *name;
#endif
struct sexp_gc_var_t *next;
};
@ -168,6 +176,9 @@ struct sexp_struct {
char gc_mark;
unsigned int immutablep:1;
unsigned int freep:1;
#if SEXP_USE_HEADER_MAGIC
unsigned int magic;
#endif
union {
/* basic types */
double flonum;
@ -314,10 +325,16 @@ struct sexp_struct {
sexp x = SEXP_VOID; \
struct sexp_gc_var_t y = {NULL, NULL};
#if SEXP_USE_CONSERVATIVE_GC
#define sexp_gc_preserve_name(ctx, x, y) (y).name = #x
#else
#define sexp_gc_preserve_name(ctx, x, y)
#endif
#define sexp_gc_preserve(ctx, x, y) \
do { \
sexp_gc_preserve_name(ctx, x, y); \
(y).var = &(x); \
/* (y).name = #x; */ \
(y).next = sexp_context_saves(ctx); \
sexp_context_saves(ctx) = &(y); \
} while (0)
@ -403,6 +420,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_flags(x) ((x)->flags)
#define sexp_immutablep(x) ((x)->immutablep)
#define sexp_freep(x) ((x)->freep)
#define sexp_pointer_magic(x) ((x)->magic)
#define sexp_check_tag(x,t) (sexp_pointerp(x) && (sexp_pointer_tag(x) == (t)))
@ -829,7 +847,7 @@ SEXP_API sexp sexp_buffered_flush (sexp ctx, sexp p);
#define sexp_newline(ctx, p) sexp_write_char(ctx, '\n', (p))
SEXP_API sexp sexp_make_context(sexp ctx, sexp_uint_t size);
SEXP_API sexp sexp_make_context(sexp ctx, size_t size);
SEXP_API sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
SEXP_API sexp sexp_cons_op(sexp ctx sexp_api_params(self, n), sexp head, sexp tail);
SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);

2
lib/chibi/disasm.c
View file

@ -74,7 +74,7 @@ static sexp disasm (sexp ctx, sexp self, sexp bc, sexp out, int depth) {
case SEXP_OP_FCALL4:
case SEXP_OP_FCALL5:
case SEXP_OP_FCALL6:
sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
sexp_printf(ctx, out, "%d", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp);
break;
case SEXP_OP_SLOT_REF:

16
sexp.c
View file

@ -49,7 +49,12 @@ sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
sexp res = (sexp) sexp_alloc(ctx, size);
if (res && ! sexp_exceptionp(res)) sexp_pointer_tag(res) = tag;
if (res && ! sexp_exceptionp(res)) {
sexp_pointer_tag(res) = tag;
#if SEXP_USE_HEADER_MAGIC
sexp_pointer_magic(res) = SEXP_POINTER_MAGIC;
#endif
}
return res;
}
@ -266,7 +271,7 @@ sexp sexp_bootstrap_context (sexp_uint_t size) {
}
#endif
sexp sexp_make_context (sexp ctx, sexp_uint_t size) {
sexp sexp_make_context (sexp ctx, size_t size) {
sexp_gc_var1(res);
if (ctx) sexp_gc_preserve1(ctx, res);
#if ! SEXP_USE_GLOBAL_HEAP
@ -550,8 +555,8 @@ sexp sexp_nreverse_op (sexp ctx sexp_api_params(self, n), sexp ls) {
sexp sexp_copy_list_op (sexp ctx sexp_api_params(self, n), sexp ls) {
sexp tmp;
sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res);
if (! sexp_pairp(ls)) return ls;
sexp_gc_preserve1(ctx, res);
tmp = res = sexp_cons(ctx, sexp_car(ls), sexp_cdr(ls));
for (ls=sexp_cdr(ls); sexp_pairp(ls); ls=sexp_cdr(ls), tmp=sexp_cdr(tmp))
sexp_cdr(tmp) = sexp_cons(ctx, sexp_car(ls), sexp_cdr(ls));
@ -664,6 +669,9 @@ sexp sexp_make_string_op (sexp ctx sexp_api_params(self, n), sexp len, sexp ch)
s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
if (sexp_exceptionp(s)) return s;
sexp_pointer_tag(s) = SEXP_STRING;
#if SEXP_USE_HEADER_MAGIC
sexp_pointer_magic(s) = SEXP_POINTER_MAGIC;
#endif
sexp_string_length(s) = clen;
if (sexp_charp(ch))
memset(sexp_string_data(s), sexp_unbox_character(ch), clen);
@ -1205,7 +1213,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
break;
}
} else if (sexp_fixnump(obj)) {
snprintf(numbuf, NUMBUF_LEN, "%ld", sexp_unbox_fixnum(obj));
snprintf(numbuf, NUMBUF_LEN, "%d", sexp_unbox_fixnum(obj));
sexp_write_string(ctx, numbuf, out);
#if SEXP_USE_IMMEDIATE_FLONUMS
} else if (sexp_flonump(obj)) {

2
vm.c
View file

@ -421,7 +421,7 @@ static sexp_uint_t sexp_restore_stack (sexp saved, sexp *current) {
#define _PUSH(x) (stack[top++]=(x))
#if SEXP_USE_ALIGNED_BYTECODE
#define _ALIGN_IP() ip = (unsigned char *)sexp_word_align((unsigned long)ip)
#define _ALIGN_IP() ip = (unsigned char *)sexp_word_align((sexp_uint_t)ip)
#else
#define _ALIGN_IP()
#endif