summaryrefslogtreecommitdiff
path: root/libguile/ephemerons.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/ephemerons.c')
-rw-r--r--libguile/ephemerons.c28
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)
{