/* 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 . */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include #include #include #include "extensions.h" #include "gc-internal.h" #include "gsubr.h" #include "ports.h" #include "threads.h" #include "version.h" #include #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 ("#", 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); }