summaryrefslogtreecommitdiff
path: root/libguile/ephemerons.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/ephemerons.c')
-rw-r--r--libguile/ephemerons.c158
1 files changed, 158 insertions, 0 deletions
diff --git a/libguile/ephemerons.c b/libguile/ephemerons.c
new file mode 100644
index 000000000..1eb179bc7
--- /dev/null
+++ b/libguile/ephemerons.c
@@ -0,0 +1,158 @@
+/* Copyright 2025 Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile is free software: you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published
+ by the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Guile is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+ License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <full-write.h>
+#include <stdio.h>
+#include <unistd.h>
+
+#include "extensions.h"
+#include "gc-internal.h"
+#include "gsubr.h"
+#include "ports.h"
+#include "threads.h"
+#include "version.h"
+
+#include <gc-ephemeron.h>
+
+#include "ephemerons.h"
+
+
+
+
+#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron))
+
+#define SCM_VALIDATE_EPHEMERON(pos, x) \
+ SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_P, "ephemeron")
+
+static inline SCM ref_to_scm (struct gc_ref ref)
+{
+ return SCM_PACK (gc_ref_value (ref));
+}
+static inline struct gc_ref scm_to_ref (SCM scm)
+{
+ return gc_ref (SCM_UNPACK (scm));
+}
+
+SCM_DEFINE_STATIC (scm_ephemeron_p, "ephemeron?", 1, 0, 0,
+ (SCM x),
+ "Return @code{#t} if @var{x} is an ephemeron, or "
+ "@code{#f} otherwise.")
+#define FUNC_NAME s_scm_ephemeron_p
+{
+ return scm_from_bool (SCM_EPHEMERON_P (x));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_make_ephemeron, "make-ephemeron", 2, 0, 0,
+ (SCM key, SCM val),
+ "Make an ephemeron that will reference @var{val} as long "
+ "as @var{key} and the ephemeron itself are alive.")
+#define FUNC_NAME s_scm_make_ephemeron
+{
+ SCM_MAKE_VALIDATE (1, key, HEAP_OBJECT_P);
+
+ struct scm_thread *thread = SCM_I_CURRENT_THREAD;
+ struct gc_ephemeron *ephemeron = gc_allocate_ephemeron (thread->mutator);
+ SCM ret = SCM_PACK_POINTER (ephemeron);
+ SCM_SET_CELL_WORD_0 (ret, scm_tc7_ephemeron);
+ gc_ephemeron_init (thread->mutator, ephemeron, scm_to_ref (key),
+ scm_to_ref (val));
+ return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_ephemeron_key, "ephemeron-key", 1, 0, 0,
+ (SCM ephemeron),
+ "Return the key for an ephemeron, or @code{#f} if the "
+ "ephemeron is dead.")
+#define FUNC_NAME s_scm_ephemeron_key
+{
+ SCM_VALIDATE_EPHEMERON (1, ephemeron);
+
+ struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron);
+ struct gc_ref ret = gc_ephemeron_key (e);
+ return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_ephemeron_value, "ephemeron-value", 1, 0, 0,
+ (SCM ephemeron),
+ "Return the value for an ephemeron, or @code{#f} if the "
+ "ephemeron is dead.")
+#define FUNC_NAME s_scm_ephemeron_value
+{
+ SCM_VALIDATE_EPHEMERON (1, ephemeron);
+
+ struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron);
+ struct gc_ref ret = gc_ephemeron_value (e);
+ return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (scm_ephemeron_mark_dead_x, "ephemeron-mark-dead!", 1, 0, 0,
+ (SCM ephemeron),
+ "Remove the key-value association for this ephemeron.")
+#define FUNC_NAME s_scm_ephemeron_mark_dead_x
+{
+ SCM_VALIDATE_EPHEMERON (1, ephemeron);
+
+ struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron);
+ gc_ephemeron_mark_dead (e);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+int
+scm_i_print_ephemeron (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
+{
+ scm_puts ("#<ephemeron ", port);
+ scm_uintprint (SCM_UNPACK (exp), 16, port);
+ scm_puts (")>", port);
+ return 1;
+}
+
+
+
+
+static void
+scm_init_ephemerons (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "ephemerons.x"
+#endif
+}
+
+void
+scm_register_ephemerons (void)
+{
+ scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+ "scm_init_ephemerons",
+ (scm_t_extension_init_func)scm_init_ephemerons,
+ NULL);
+}