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

preserving necessary objects when destroying contexts with safe accessors

Browse source 
(also removing some gcc warnings)
This commit is contained in:
Alex Shinn 2010-09-20 20:12:07 +09:00
parent c91d982473
commit 9d8788414f
2 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
include/chibi/sexp.h
View file

@ -609,9 +609,9 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
/*************************** field accessors **************************/ /*************************** field accessors **************************/
#if SEXP_USE_SAFE_ACCESSORS #if SEXP_USE_SAFE_ACCESSORS
#define sexp_field(x, type, id, field) (*(((x) && sexp_check_tag(x, id)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.type.field)))) #define sexp_field(x, type, id, field) (*(((x) && sexp_check_tag(x, id)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.type.field))))
#define sexp_pred_field(x, type, pred, field) (*(((x) && pred(x)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.type.field)))) #define sexp_pred_field(x, type, pred, field) (*(((x) && pred(x)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.type.field))))
#define sexp_cpointer_field(x, field) (*(((x) && sexp_pointerp(x) && sexp_pointer_tag(x) >= SEXP_CPOINTER) ? &((x)->value.cpointer.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a cpointer\n", __FILE__, __LINE__, x, sexp_pointerp(x) ? sexp_pointer_tag(x) : -1), &(((sexp)NULL)->value.cpointer.field)))) #define sexp_cpointer_field(x, field) (*(((x) && sexp_pointerp(x) && sexp_pointer_tag(x) >= SEXP_CPOINTER) ? &((x)->value.cpointer.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a cpointer\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.cpointer.field))))
#else #else
#define sexp_field(x, type, id, field) ((x)->value.type.field) #define sexp_field(x, type, id, field) ((x)->value.type.field)
#define sexp_pred_field(x, type, pred, field) ((x)->value.type.field) #define sexp_pred_field(x, type, pred, field) ((x)->value.type.field)
@ -622,8 +622,8 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_vector_data(x) (sexp_field(x, vector, SEXP_VECTOR, data)) #define sexp_vector_data(x) (sexp_field(x, vector, SEXP_VECTOR, data))
#if SEXP_USE_SAFE_ACCESSORS #if SEXP_USE_SAFE_ACCESSORS
#define sexp_vector_ref(x,i) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)] : (fprintf(stderr, "vector-ref length out of range %s on line %d: vector %p (length %u): %d\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID)) #define sexp_vector_ref(x,i) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)] : (fprintf(stderr, "vector-ref length out of range %s on line %d: vector %p (length %lu): %ld\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
#define sexp_vector_set(x,i,v) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v) : (fprintf(stderr, "vector-set! length out of range in %s on line %d: vector %p (length %u): %d\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID)) #define sexp_vector_set(x,i,v) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v) : (fprintf(stderr, "vector-set! length out of range in %s on line %d: vector %p (length %lu): %ld\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
#else #else
#define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]) #define sexp_vector_ref(x,i) (sexp_vector_data(x)[sexp_unbox_fixnum(i)])
#define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v)) #define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v))

4
sexp.c
View file

@ -339,6 +339,10 @@ void sexp_destroy_context (sexp ctx) {
if (sexp_context_heap(ctx)) { if (sexp_context_heap(ctx)) {
heap = sexp_context_heap(ctx); heap = sexp_context_heap(ctx);
sexp_gc_mark(ctx) = 1; sexp_gc_mark(ctx) = 1;
#if ! SEXP_USE_GLOBAL_TYPES
sexp_gc_mark(sexp_context_globals(ctx)) = 1;
sexp_gc_mark(sexp_global(ctx, SEXP_G_TYPES)) = 1;
#endif
sexp_sweep(ctx, &sum_freed); /* sweep w/o mark to run finalizers */ sexp_sweep(ctx, &sum_freed); /* sweep w/o mark to run finalizers */
sexp_context_heap(ctx) = NULL; sexp_context_heap(ctx) = NULL;
for ( ; heap; heap=tmp) { for ( ; heap; heap=tmp) {