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

Bit better error reporting

Browse source
This commit is contained in:
Chris Walsh 2016-02-16 12:10:28 -05:00
parent 2005c19ea0
commit 9f10e3656c
3 changed files with 48 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -72,10 +72,10 @@ endif
ifeq ($(SEXP_USE_DL),0) ifeq ($(SEXP_USE_DL),0)
XLDFLAGS := $(LDFLAGS) $(RLDFLAGS) $(GCLDFLAGS) -lm XLDFLAGS := $(LDFLAGS) $(RLDFLAGS) $(GCLDFLAGS) -lm
XCFLAGS := -Wall -DSEXP_USE_DL=0 -g -g3 -O3 $(CFLAGS) XCFLAGS := -Wall -DSEXP_USE_DL=0 -g -g3 -O0 $(CFLAGS)
else else
XLDFLAGS := $(LDFLAGS) $(RLDFLAGS) $(GCLDFLAGS) $(LIBDL) -lm XLDFLAGS := $(LDFLAGS) $(RLDFLAGS) $(GCLDFLAGS) $(LIBDL) -lm
XCFLAGS := -Wall -g -g3 -O3 $(CFLAGS) XCFLAGS := -Wall -g -g3 -O0 $(CFLAGS)
endif endif
######################################################################## ########################################################################

0
chibi-osx → chibi-run
View file

83
gc_heap.c
View file

@ -43,12 +43,12 @@ sexp sexp_gc_heap_walk(sexp ctx,
/* find the preceding and succeeding free list pointers */ /* find the preceding and succeeding free list pointers */
sexp_free_list r = q->next; sexp_free_list r = q->next;
while (r && ((char*)r < (char*)p)) { while (r && ((unsigned char*)r < (unsigned char*)p)) {
q = r; q = r;
r = r->next; r = r->next;
} }
if ( (char*)r == (char*)p ) { if ( (unsigned char*)r == (unsigned char*)p ) {
if (free_callback && (res = free_callback(ctx, r, user)) != SEXP_TRUE) { if (free_callback && (res = free_callback(ctx, r, user)) != SEXP_TRUE) {
return res; } return res; }
size = r ? r->size : 0; size = r ? r->size : 0;
@ -61,14 +61,14 @@ sexp sexp_gc_heap_walk(sexp ctx,
goto done; goto done;
} }
} }
p = (sexp)(((char*)p) + size); p = (sexp)(((unsigned char*)p) + size);
} }
h = h->next; h = h->next;
} }
res = SEXP_TRUE; res = SEXP_TRUE;
done: done:
if (!res) res = sexp_user_exception(ctx, NULL, gc_heap_err_str, NULL); if (res != SEXP_TRUE) res = sexp_user_exception(ctx, NULL, gc_heap_err_str, NULL);
return res; return res;
} }
@ -107,7 +107,7 @@ static sexp sexp_callback_remap(sexp ctx, sexp s, void *user) {
state->remap[state->index].dstp = state->p; state->remap[state->index].dstp = state->p;
if (ctx == s) state->ctx_dst = state->p; if (ctx == s) state->ctx_dst = state->p;
state->p = (sexp)(((char*)state->p) + size); state->p = (sexp)(((unsigned char*)state->p) + size);
state->index += 1; state->index += 1;
return SEXP_TRUE; return SEXP_TRUE;
@ -119,11 +119,11 @@ static sexp sexp_callback_remap(sexp ctx, sexp s, void *user) {
static sexp sexp_gc_heap_pack_src_to_dst(void* adata, sexp srcp) { static sexp sexp_gc_heap_pack_src_to_dst(void* adata, sexp srcp) {
struct sexp_remap_state* state = adata; struct sexp_remap_state* state = adata;
int imin = 0; sexp_sint_t imin = 0;
int imax = state->sexps_count - 1; sexp_sint_t imax = state->sexps_count - 1;
while (imin <= imax) { while (imin <= imax) {
int imid = ((imax - imin) / 2) + imin; sexp_sint_t imid = ((imax - imin) / 2) + imin;
sexp midp = state->remap[imid].srcp; sexp midp = state->remap[imid].srcp;
if (midp == srcp) { if (midp == srcp) {
return state->remap[imid].dstp; return state->remap[imid].dstp;
@ -142,7 +142,7 @@ static sexp sexp_adjust_fields(sexp dstp, sexp* types, sexp (* adjust_fn)(void *
sexp_tag_t tag = sexp_pointer_tag(dstp); sexp_tag_t tag = sexp_pointer_tag(dstp);
sexp type_spec = types[tag]; sexp type_spec = types[tag];
size_t type_sexp_cnt = sexp_type_num_slots_of_object(type_spec, dstp); size_t type_sexp_cnt = sexp_type_num_slots_of_object(type_spec, dstp);
sexp* vec = (sexp*)((char*)dstp + sexp_type_field_base(type_spec)); sexp* vec = (sexp*)((unsigned char*)dstp + sexp_type_field_base(type_spec));
int i; int i;
for (i = 0; i < type_sexp_cnt; i++) { for (i = 0; i < type_sexp_cnt; i++) {
@ -150,7 +150,10 @@ static sexp sexp_adjust_fields(sexp dstp, sexp* types, sexp (* adjust_fn)(void *
sexp dst = src; sexp dst = src;
if (src && sexp_pointerp(src)) { if (src && sexp_pointerp(src)) {
dst = adjust_fn(adata, src); dst = adjust_fn(adata, src);
if (!sexp_pointerp(dst)) { return dstp; } if (!sexp_pointerp(dst)) {
size_t sz = strlen(gc_heap_err_str);
snprintf(gc_heap_err_str + sz, ERR_STR_SIZE - sz, " from adjust fields, tag=%lu i=%d", tag, i);
return SEXP_FALSE; }
} }
vec[i] = dst; vec[i] = dst;
} }
@ -159,7 +162,7 @@ static sexp sexp_adjust_fields(sexp dstp, sexp* types, sexp (* adjust_fn)(void *
static sexp sexp_adjust_bytecode(sexp dstp, sexp (*adjust_fn)(void *, sexp), void *adata) { static sexp sexp_adjust_bytecode(sexp dstp, sexp (*adjust_fn)(void *, sexp), void *adata) {
sexp res = NULL; sexp res = SEXP_FALSE;
sexp src, dst; sexp src, dst;
sexp* vec; sexp* vec;
int i; int i;
@ -181,7 +184,10 @@ static sexp sexp_adjust_bytecode(sexp dstp, sexp (*adjust_fn)(void *, sexp), voi
src = vec[0]; src = vec[0];
if (src && sexp_pointerp(src)) { if (src && sexp_pointerp(src)) {
dst = adjust_fn(adata, src); dst = adjust_fn(adata, src);
if (!sexp_pointerp(dst)) { res = dst; goto done; } if (!sexp_pointerp(dst)) {
size_t sz = strlen(gc_heap_err_str);
snprintf(gc_heap_err_str + sz, ERR_STR_SIZE - sz, " from adjust bytecode, FCALLN");
goto done; }
vec[0] = dst; vec[0] = dst;
} }
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
@ -200,7 +206,10 @@ static sexp sexp_adjust_bytecode(sexp dstp, sexp (*adjust_fn)(void *, sexp), voi
src = vec[2]; src = vec[2];
if (src && sexp_pointerp(src)) { if (src && sexp_pointerp(src)) {
dst = adjust_fn(adata, src); dst = adjust_fn(adata, src);
if (!sexp_pointerp(dst)) { res = dst; goto done; } if (!sexp_pointerp(dst)) {
size_t sz = strlen(gc_heap_err_str);
snprintf(gc_heap_err_str + sz, ERR_STR_SIZE - sz, " from adjust bytecode, PROCEDURE");
goto done; }
vec[2] = dst; vec[2] = dst;
} }
i += 3*sizeof(sexp); break; i += 3*sizeof(sexp); break;
@ -236,19 +245,20 @@ static sexp_heap sexp_gc_packed_heap_make(size_t packed_size, size_t free_size)
free_size = 2*sexp_free_chunk_size; free_size = 2*sexp_free_chunk_size;
} }
free_size = sexp_heap_align(free_size); free_size = sexp_heap_align(free_size);
sexp_heap heap = sexp_make_heap(sexp_heap_align(packed_size + free_size + sexp_free_chunk_size + 128), 0, 0); size_t req_size = packed_size + free_size + sexp_free_chunk_size + 128;
sexp_heap heap = sexp_make_heap(sexp_heap_align(req_size), 0, 0);
if (!heap) { if (!heap) {
strcpy(gc_heap_err_str, "Could not allocate memory for heap"); strcpy(gc_heap_err_str, "Could not allocate memory for heap");
return NULL; return NULL;
} }
sexp base = sexp_heap_first_block(heap); sexp base = sexp_heap_first_block(heap);
size_t pad = (char *)base - (char *)heap->data; size_t pad = (unsigned char *)base - (unsigned char *)heap->data;
heap->size = packed_size + free_size + pad; heap->size = packed_size + free_size + pad;
heap->free_list->size = 0; heap->free_list->size = 0;
if (free_size == 0) { if (free_size == 0) {
heap->free_list->next = NULL; heap->free_list->next = NULL;
} else { } else {
heap->free_list->next = (sexp_free_list)((char *)base + packed_size); heap->free_list->next = (sexp_free_list)((unsigned char *)base + packed_size);
heap->free_list->next->next = NULL; heap->free_list->next->next = NULL;
heap->free_list->next->size = free_size; heap->free_list->next->size = free_size;
} }
@ -282,22 +292,22 @@ sexp sexp_gc_heap_pack(sexp ctx, sexp_uint_t heap_free_size) {
res = sexp_global(ctx, SEXP_G_OOM_ERROR); res = sexp_global(ctx, SEXP_G_OOM_ERROR);
goto done; } goto done; }
if ((res = sexp_gc_heap_walk(ctx, sexp_context_types(ctx), sexp_context_num_types(ctx), res = sexp_gc_heap_walk(ctx, sexp_context_types(ctx), sexp_context_num_types(ctx),
&state, NULL, NULL, sexp_callback_remap)) != SEXP_TRUE) { &state, NULL, NULL, sexp_callback_remap);
goto done; } if (res != SEXP_TRUE) { goto done; }
sexp* types = sexp_context_types(state.ctx_src); sexp* types = sexp_context_types(state.ctx_src);
int idx; int idx;
for (idx = 0; idx < state.sexps_count; idx++) { for (idx = 0; idx < state.sexps_count; idx++) {
sexp dstp = state.remap[idx].dstp; sexp dstp = state.remap[idx].dstp;
if ((res = sexp_gc_heap_pack_adjust(dstp, types, &state)) != SEXP_TRUE) { res = sexp_gc_heap_pack_adjust(dstp, types, &state);
goto done; } if (res != SEXP_TRUE) { goto done; }
} }
res = SEXP_TRUE;
res = state.ctx_dst;
done: done:
if (state.remap) free(state.remap); if (state.heap && res != SEXP_TRUE) { sexp_free_heap(state.heap); }
return res; if (state.remap) { free(state.remap); }
return (res == SEXP_TRUE) ? state.ctx_dst : res;
} }
@ -325,13 +335,13 @@ sexp sexp_save_image (sexp ctx_in, const char* filename) {
} }
/* Save ONLY packed, active SEXPs. No free list structures or padding. */ /* Save ONLY packed, active SEXPs. No free list structures or padding. */
sexp ctx = sexp_gc_heap_pack(ctx_in, 0); sexp ctx_out = sexp_gc_heap_pack(ctx_in, 0);
if (!ctx || !sexp_contextp(ctx)) { if (!ctx_out || !sexp_contextp(ctx_out)) {
goto done; goto done;
} }
heap = sexp_context_heap(ctx); heap = sexp_context_heap(ctx_out);
sexp base = sexp_heap_first_block(heap); sexp base = sexp_heap_first_block(heap);
size_t pad = (size_t)((char *)base - (char *)heap->data); size_t pad = (size_t)((unsigned char *)base - (unsigned char *)heap->data);
size_t size = heap->size - pad; size_t size = heap->size - pad;
struct sexp_image_header_t header; struct sexp_image_header_t header;
@ -341,9 +351,8 @@ sexp sexp_save_image (sexp ctx_in, const char* filename) {
header.minor = SEXP_IMAGE_MINOR_VERSION; header.minor = SEXP_IMAGE_MINOR_VERSION;
header.size = size; header.size = size;
header.base = base; header.base = base;
header.context = ctx; header.context = ctx_out;
sexp_gc(ctx, NULL);
if (! (fwrite(&header, sizeof(header), 1, fp) == 1 && if (! (fwrite(&header, sizeof(header), 1, fp) == 1 &&
fwrite(base, size, 1, fp) == 1)) { fwrite(base, size, 1, fp) == 1)) {
snprintf(gc_heap_err_str, ERR_STR_SIZE, "Error writing image file: %s", filename); snprintf(gc_heap_err_str, ERR_STR_SIZE, "Error writing image file: %s", filename);
@ -378,7 +387,7 @@ struct load_image_state {
/* Return a destination (remapped) pointer for a given source pointer */ /* Return a destination (remapped) pointer for a given source pointer */
static sexp load_image_src_to_dst(void* adata, sexp srcp) { static sexp load_image_src_to_dst(void* adata, sexp srcp) {
struct load_image_state* state = adata; struct load_image_state* state = adata;
return (sexp)((char *)srcp + state->offset); return (sexp)((unsigned char *)srcp + state->offset);
} }
@ -534,7 +543,7 @@ sexp sexp_load_image (const char* filename, sexp_uint_t heap_free_size, sexp_uin
} }
sexp base = sexp_heap_first_block(state.heap); sexp base = sexp_heap_first_block(state.heap);
if (fread(base, header.size, 1, fp) != 1) { if (fread(base, 1, header.size, fp) != header.size) {
snprintf(gc_heap_err_str, ERR_STR_SIZE, "error reading image\n"); snprintf(gc_heap_err_str, ERR_STR_SIZE, "error reading image\n");
goto done; goto done;
} }
@ -542,7 +551,7 @@ sexp sexp_load_image (const char* filename, sexp_uint_t heap_free_size, sexp_uin
/* Adjust pointers in loaded packed heap. */ /* Adjust pointers in loaded packed heap. */
state.offset = (sexp_sint_t)((sexp_sint_t)base - (sexp_sint_t)header.base); state.offset = (sexp_sint_t)((sexp_sint_t)base - (sexp_sint_t)header.base);
ctx = (sexp)((char *)header.context + state.offset); ctx = (sexp)((unsigned char *)header.context + state.offset);
sexp_context_heap(ctx) = state.heap; sexp_context_heap(ctx) = state.heap;
/* Type information (specifically, how big types are) is stored as sexps in the /* Type information (specifically, how big types are) is stored as sexps in the
@ -550,14 +559,14 @@ sexp sexp_load_image (const char* filename, sexp_uint_t heap_free_size, sexp_uin
copy of the type array pointers with correct offsets is applied is created outside copy of the type array pointers with correct offsets is applied is created outside
of the new heap to be used with the pointer adjustment process. of the new heap to be used with the pointer adjustment process.
*/ */
sexp* ctx_globals = sexp_vector_data((sexp)((char*)sexp_context_globals(ctx) + state.offset)); sexp* ctx_globals = sexp_vector_data((sexp)((unsigned char*)sexp_context_globals(ctx) + state.offset));
sexp* ctx_types = sexp_vector_data((sexp)((char*)(ctx_globals[SEXP_G_TYPES]) + state.offset)); sexp* ctx_types = sexp_vector_data((sexp)((unsigned char*)(ctx_globals[SEXP_G_TYPES]) + state.offset));
state.types_cnt = sexp_unbox_fixnum(ctx_globals[SEXP_G_NUM_TYPES]); state.types_cnt = sexp_unbox_fixnum(ctx_globals[SEXP_G_NUM_TYPES]);
state.types = malloc(sizeof(sexp) * state.types_cnt); state.types = malloc(sizeof(sexp) * state.types_cnt);
if (!state.types) goto done; if (!state.types) goto done;
int i; int i;
for (i = 0; i < state.types_cnt; i++) { for (i = 0; i < state.types_cnt; i++) {
state.types[i] = (sexp)((char *)ctx_types[i] + state.offset); state.types[i] = (sexp)((unsigned char *)ctx_types[i] + state.offset);
} }
if (sexp_gc_heap_walk(ctx, state.types, state.types_cnt, if (sexp_gc_heap_walk(ctx, state.types, state.types_cnt,