From 676b39d82abd715477648221da9923ac70bad13e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 31 May 2014 14:20:00 +0900 Subject: [PATCH] Moving ephemerals into the core. Using them as a weak table to store filenos, and enforcing the invariant that there is only one fileno object with a given number at a time. --- include/chibi/sexp.h | 13 ++++++-- lib/chibi/weak.c | 34 +++++--------------- sexp.c | 74 +++++++++++++++++++++++++++++++++++++++++++- tests/weak-tests.scm | 15 ++++----- 4 files changed, 100 insertions(+), 36 deletions(-) diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 3687f025..fb86945d 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -161,6 +161,9 @@ enum sexp_types { SEXP_CPOINTER, #if SEXP_USE_AUTO_FORCE SEXP_PROMISE, +#endif +#if SEXP_USE_WEAK_REFERENCES + SEXP_EPHEMERON, #endif SEXP_NUM_CORE_TYPES }; @@ -679,6 +682,7 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_litp(x) (sexp_check_tag(x, SEXP_LIT)) #define sexp_contextp(x) (sexp_check_tag(x, SEXP_CONTEXT)) #define sexp_promisep(x) (sexp_check_tag(x, SEXP_PROMISE)) +#define sexp_ephemeronp(x) (sexp_check_tag(x, SEXP_EPHEMERON)) #define sexp_applicablep(x) (sexp_procedurep(x) || sexp_opcodep(x)) @@ -1041,6 +1045,9 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_promise_donep(x) (sexp_field(x, promise, SEXP_PROMISE, donep)) #define sexp_promise_value(x) (sexp_field(x, promise, SEXP_PROMISE, value)) +#define sexp_ephemeron_key(x) (sexp_field(x, pair, SEXP_EPHEMERON, car)) +#define sexp_ephemeron_value(x) (sexp_field(x, pair, SEXP_EPHEMERON, cdr)) + #define sexp_context_env(x) (sexp_field(x, context, SEXP_CONTEXT, env)) #define sexp_context_stack(x) (sexp_field(x, context, SEXP_CONTEXT, stack)) #define sexp_context_parent(x) (sexp_field(x, context, SEXP_CONTEXT, parent)) @@ -1196,7 +1203,6 @@ enum sexp_context_globals { SEXP_G_ABI_ERROR, /* incompatible ABI loading library */ SEXP_G_OPTIMIZATIONS, SEXP_G_SIGNAL_HANDLERS, - SEXP_G_FILE_DESCRIPTORS, SEXP_G_META_ENV, SEXP_G_MODULE_PATH, SEXP_G_QUOTE_SYMBOL, @@ -1217,7 +1223,8 @@ enum sexp_context_globals { SEXP_G_FOLD_CASE_P, #endif #if SEXP_USE_WEAK_REFERENCES - SEXP_G_WEAK_REFERENCE_CACHE, + SEXP_G_FILE_DESCRIPTORS, + SEXP_G_NUM_FILE_DESCRIPTORS, #endif #if ! SEXP_USE_BOEHM SEXP_G_PRESERVATIVES, @@ -1341,6 +1348,7 @@ SEXP_API sexp sexp_memq_op(sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp ls); SEXP_API sexp sexp_assq_op(sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp ls); SEXP_API sexp sexp_length_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls); SEXP_API sexp sexp_c_string(sexp ctx, const char *str, sexp_sint_t slen); +SEXP_API sexp sexp_make_ephemeron_op(sexp ctx, sexp self, sexp_sint_t n, sexp key, sexp value); SEXP_API sexp sexp_make_bytes_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp i); SEXP_API sexp sexp_make_string_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp ch); SEXP_API sexp sexp_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end); @@ -1533,6 +1541,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj #define sexp_string_to_symbol(ctx, s) sexp_string_to_symbol_op(ctx, NULL, 1, s) #define sexp_string_to_number(ctx, s, b) sexp_string_to_number_op(ctx, NULL, 2, s, b) #define sexp_symbol_to_string(ctx, s) sexp_symbol_to_string_op(ctx, NULL, 1, s) +#define sexp_make_ephemeron(ctx, k, v) sexp_make_ephemeron_op(ctx, NULL, 2, k, v) #define sexp_make_bytes(ctx, l, i) sexp_make_bytes_op(ctx, NULL, 2, l, i) #define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx, NULL, 2, l, c) #define sexp_subbytes(ctx, a, b, c) sexp_subbytes_op(ctx, NULL, 3, a, b, c) diff --git a/lib/chibi/weak.c b/lib/chibi/weak.c index 71cfbd69..d95ab54b 100644 --- a/lib/chibi/weak.c +++ b/lib/chibi/weak.c @@ -4,26 +4,15 @@ #include -#define sexp_ephemeron_key(x) sexp_slot_ref(x, 0) -#define sexp_ephemeron_value(x) sexp_slot_ref(x, 1) - -#define sexp_weak_vector_p(x) sexp_check_tag(x, sexp_weak_vector_id) - -sexp sexp_make_ephemeron (sexp ctx, sexp self, sexp_sint_t n, sexp key, sexp value) { - sexp res = sexp_alloc_type(ctx, pair, sexp_unbox_fixnum(sexp_opcode_return_type(self))); - if (! sexp_exceptionp(res)) { - sexp_ephemeron_key(res) = key; - sexp_ephemeron_value(res) = value; - } - return res; -} - sexp sexp_ephemeron_brokenp_op (sexp ctx, sexp self, sexp_sint_t n, sexp eph) { if (! (sexp_pointerp(eph) && (sexp_pointer_tag(eph) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self))))) return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), eph); return sexp_make_boolean(sexp_brokenp(eph)); } +#if 0 +#define sexp_weak_vector_p(x) sexp_check_tag(x, sexp_weak_vector_id) + sexp sexp_make_weak_vector (sexp ctx, sexp self, sexp_sint_t n, sexp len) { sexp vec, *x; int i, clen = sexp_unbox_fixnum(len); @@ -58,41 +47,34 @@ sexp sexp_weak_vector_set (sexp ctx, sexp self, sexp_sint_t n, sexp v, sexp k, s sexp_vector_set(v, k, x); return SEXP_VOID; } +#endif sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, const sexp_abi_identifier_t abi) { #if 0 sexp v; int sexp_weak_vector_id; #endif - int sexp_ephemeron_id; sexp_gc_var3(name, t, op); if (!(sexp_version_compatible(ctx, version, sexp_version) && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER))) return SEXP_ABI_ERROR; sexp_gc_preserve3(ctx, name, t, op); - name = sexp_c_string(ctx, "Ephemeron", -1); - t = sexp_register_simple_type(ctx, name, SEXP_FALSE, SEXP_TWO); - sexp_ephemeron_id = sexp_type_tag(t); - sexp_type_field_len_base(t) = 0; - sexp_type_weak_base(t) = sexp_type_field_base(t); - sexp_type_weak_len_base(t) = 1; - sexp_type_weak_len_extra(t) = 1; - + t = sexp_make_fixnum(SEXP_EPHEMERON); op = sexp_make_type_predicate(ctx, name=sexp_c_string(ctx,"ephemeron?",-1), t); sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron?", -1), op); op = sexp_make_getter(ctx, name=sexp_c_string(ctx, "ephemeron-key", -1), t, SEXP_ZERO); sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron-key", -1), op); op = sexp_make_getter(ctx, name=sexp_c_string(ctx, "ephemeron-value", -1), t, SEXP_ONE); sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron-value", -1), op); - op = sexp_define_foreign(ctx, env, "make-ephemeron", 2, sexp_make_ephemeron); + op = sexp_define_foreign(ctx, env, "make-ephemeron", 2, sexp_make_ephemeron_op); if (sexp_opcodep(op)) { - sexp_opcode_return_type(op) = sexp_make_fixnum(sexp_ephemeron_id); + sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_EPHEMERON); } op = sexp_define_foreign(ctx, env, "ephemeron-broken?", 1, sexp_ephemeron_brokenp_op); if (sexp_opcodep(op)) { sexp_opcode_return_type(op) = sexp_make_fixnum(SEXP_OBJECT); - sexp_opcode_arg1_type(op) = sexp_make_fixnum(sexp_ephemeron_id); + sexp_opcode_arg1_type(op) = sexp_make_fixnum(SEXP_EPHEMERON); } #if 0 diff --git a/sexp.c b/sexp.c index 3abd52af..5d368c66 100644 --- a/sexp.c +++ b/sexp.c @@ -233,6 +233,9 @@ static struct sexp_type_struct _sexp_type_specs[] = { #if SEXP_USE_AUTO_FORCE {SEXP_PROMISE, sexp_offsetof(promise, value), 1, 1, 0, 0, sexp_sizeof(promise), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Promise", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL}, #endif +#if SEXP_USE_WEAK_REFERENCES + {SEXP_EPHEMERON, sexp_offsetof(lit, value), 0, 0, 0, 0, sizeof(sexp), 0, 0, sexp_offsetof(lit, value), 1, 0, 0, 1, 0, (sexp)"Ephemeron", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL}, +#endif }; #define SEXP_INIT_NUM_TYPES (SEXP_NUM_CORE_TYPES*2) @@ -394,6 +397,10 @@ void sexp_init_context_globals (sexp ctx) { #endif #if ! SEXP_USE_BOEHM sexp_global(ctx, SEXP_G_PRESERVATIVES) = SEXP_NULL; +#endif +#if SEXP_USE_WEAK_REFERENCES + sexp_global(ctx, SEXP_G_FILE_DESCRIPTORS) = SEXP_FALSE; + sexp_global(ctx, SEXP_G_NUM_FILE_DESCRIPTORS) = SEXP_ZERO; #endif sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL); sexp_global(ctx, SEXP_G_OOS_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of stack space", SEXP_NULL); @@ -1634,16 +1641,81 @@ sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp #endif /* ! SEXP_USE_STRING_STREAMS */ +#if SEXP_USE_WEAK_REFERENCES +sexp sexp_make_ephemeron_op(sexp ctx, sexp self, sexp_sint_t n, sexp key, sexp value) { + sexp res = sexp_alloc_type(ctx, pair, SEXP_EPHEMERON); + if (!sexp_exceptionp(res)) { + sexp_ephemeron_key(res) = key; + sexp_ephemeron_value(res) = value; + } + return res; +} + +/* TODO: use a faster lookup */ +static sexp sexp_lookup_fileno(sexp ctx, int fd) { + sexp *data, x, vec = sexp_global(ctx, SEXP_G_FILE_DESCRIPTORS); + sexp_sint_t i, n = sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_NUM_FILE_DESCRIPTORS)); + if (!sexp_vectorp(vec)) + return SEXP_FALSE; + data = sexp_vector_data(vec); + for (i = 0; i < n; i++) { + if (sexp_ephemeronp(data[i])) { + x = sexp_ephemeron_key(data[i]); + if (sexp_filenop(x) && sexp_fileno_fd(x) == fd) + return x; + } + } + return SEXP_FALSE; +} + +static void sexp_insert_fileno(sexp ctx, sexp fileno) { + sexp *data, *data2, tmp, vec = sexp_global(ctx, SEXP_G_FILE_DESCRIPTORS); + sexp_sint_t i, n2, n = sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_NUM_FILE_DESCRIPTORS)); + if (!sexp_vectorp(vec)) { + vec = sexp_global(ctx, SEXP_G_FILE_DESCRIPTORS) + = sexp_make_vector(ctx, sexp_make_fixnum(128), SEXP_VOID); + } else if (n >= sexp_vector_length(vec)) { + data = sexp_vector_data(vec); + for (i = n2 = 0; i < sexp_vector_length(vec); i++) + if (sexp_ephemeronp(data[i]) && !sexp_brokenp(data[i])) + n2++; + if (n2 * 2 >= n) + n2 = n * 2; + tmp = sexp_global(ctx, SEXP_G_FILE_DESCRIPTORS) + = sexp_make_vector(ctx, sexp_make_fixnum(n2), SEXP_VOID); + data2 = sexp_vector_data(tmp); + for (i = n = 0; i < sexp_vector_length(vec); i++) + if (sexp_ephemeronp(data[i]) && !sexp_brokenp(data[i])) + data2[n++] = data[i]; + vec = tmp; + } + sexp_vector_data(vec)[n] = sexp_make_ephemeron(ctx, fileno, SEXP_FALSE); + sexp_global(ctx, SEXP_G_NUM_FILE_DESCRIPTORS) = sexp_make_fixnum(n + 1); +} +#endif + sexp sexp_make_fileno_op (sexp ctx, sexp self, sexp_sint_t n, sexp fd, sexp no_closep) { - sexp res; + sexp_gc_var1(res); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, fd); if (sexp_unbox_fixnum(fd) < 0) return SEXP_FALSE; +#if SEXP_USE_WEAK_REFERENCES + res = sexp_lookup_fileno(ctx, sexp_unbox_fixnum(fd)); + if (sexp_filenop(res)) { + sexp_fileno_no_closep(res) = sexp_truep(no_closep); + return res; + } +#endif + sexp_gc_preserve1(ctx, res); res = sexp_alloc_type(ctx, fileno, SEXP_FILENO); if (!sexp_exceptionp(res)) { sexp_fileno_fd(res) = sexp_unbox_fixnum(fd); sexp_fileno_openp(res) = 1; sexp_fileno_no_closep(res) = sexp_truep(no_closep); +#if SEXP_USE_WEAK_REFERENCES + sexp_insert_fileno(ctx, res); +#endif } + sexp_gc_release1(ctx); return res; } diff --git a/tests/weak-tests.scm b/tests/weak-tests.scm index 3d4565d4..f34f35cf 100644 --- a/tests/weak-tests.scm +++ b/tests/weak-tests.scm @@ -3,21 +3,22 @@ (test-begin "weak pointers") -(test "preserved key and value" '("key" "value" #f) - (let ((key (string-append "key")) - (value (string-append "value"))) +(test "preserved key and value" '("key1" "value1" #f) + (let ((key (string-append "key" "1")) + (value (string-append "value" "1"))) (let ((eph (make-ephemeron key value))) (gc) (list key (ephemeron-value eph) (ephemeron-broken? eph))))) (test "unpreserved key and value" '(#f #f #t) - (let ((eph (make-ephemeron (string-append "key") (string-append "value")))) + (let ((eph (make-ephemeron (string-append "key" "2") + (string-append "value" "2")))) (gc) (list (ephemeron-key eph) (ephemeron-value eph) (ephemeron-broken? eph)))) -(test "unpreserved key and preserved value" '(#f "value" #t) - (let ((value (string-append "value"))) - (let ((eph (make-ephemeron (string-append "key") value))) +(test "unpreserved key and preserved value" '(#f "value3" #t) + (let ((value (string-append "value" "3"))) + (let ((eph (make-ephemeron (string-append "key" "3") value))) (gc) (list (ephemeron-key eph) value (ephemeron-broken? eph)))))