diff options
Diffstat (limited to 'libguile/ephemerons.c')
-rw-r--r-- | libguile/ephemerons.c | 158 |
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); +} |