diff options
Diffstat (limited to 'libguile/ephemerons.c')
-rw-r--r-- | libguile/ephemerons.c | 28 |
1 files changed, 27 insertions, 1 deletions
diff --git a/libguile/ephemerons.c b/libguile/ephemerons.c index 7a2f75076..9995d8e79 100644 --- a/libguile/ephemerons.c +++ b/libguile/ephemerons.c @@ -30,6 +30,7 @@ #include <stdio.h> #include <unistd.h> +#include "atomics-internal.h" #include "extensions.h" #include "gc-internal.h" #include "gsubr.h" @@ -147,7 +148,6 @@ SCM_DEFINE_STATIC (scm_make_ephemeron, "make-ephemeron", 2, 0, 0, "as @var{key} and the ephemeron itself are alive.") #define FUNC_NAME s_scm_make_ephemeron { - SCM_MAKE_VALIDATE (1, key, HEAP_OBJECT_P); return PTR2SCM (scm_c_make_ephemeron (key, val)); } #undef FUNC_NAME @@ -299,6 +299,15 @@ scm_c_ephemeron_table_try_push_x (struct scm_ephemeron_table *et, size_t idx, return prev; } +static struct gc_ephemeron* +scm_c_ephemeron_table_clear_x (struct scm_ephemeron_table *et, size_t idx) +{ + if (idx >= et->size) + abort(); + + return scm_atomic_swap_pointer ((void**) &et->contents[idx], NULL); +} + struct scm_ephemeron_table* scm_c_ephemeron_table_copy (struct scm_ephemeron_table *et) { @@ -408,6 +417,23 @@ SCM_DEFINE_STATIC (scm_ephemeron_table_try_push_x, "ephemeron-table-try-push!", } #undef FUNC_NAME +SCM_DEFINE_STATIC (scm_ephemeron_table_clear_x, "ephemeron-table-clear!", + 2, 0, 0, (SCM et, SCM idx), + "Clear the slot @var{idx} of the ephemeron table @var{et} " + "and return its previous value.") +#define FUNC_NAME s_scm_ephemeron_table_clear_x +{ + SCM_VALIDATE_EPHEMERON_TABLE (1, et); + SCM_ASSERT_RANGE (2, idx, + scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size); + + struct gc_ephemeron *prev = + scm_c_ephemeron_table_clear_x (scm_as_ephemeron_table (et), + scm_to_size_t (idx)); + return prev ? PTR2SCM (prev) : SCM_BOOL_F; +} +#undef FUNC_NAME + int scm_i_print_ephemeron_table (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { |