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

Moving ephemerals into the core. Using them as a weak table to store filenos,

Browse source 
and enforcing the invariant that there is only one fileno object with a given
number at a time.
This commit is contained in:
Alex Shinn 2014-05-31 14:20:00 +09:00
parent 5f02dc6f17
commit 676b39d82a
4 changed files with 100 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
include/chibi/sexp.h
View file

@ -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)

34
lib/chibi/weak.c
View file

@ -4,26 +4,15 @@
#include <chibi/eval.h>
#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

74
sexp.c
View file

@ -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;
}

15
tests/weak-tests.scm
View file

@ -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)))))