diff --git a/configure.ac b/configure.ac index 9d7572a29..d33aad352 100644 --- a/configure.ac +++ b/configure.ac @@ -34,7 +34,7 @@ AC_CONFIG_SRCDIR(GUILE-VERSION) AC_CANONICAL_TARGET AM_INIT_AUTOMAKE([1.12 gnu no-define -Wall -Wno-override \ - color-tests dist-lzip dist-xz]) + color-tests dist-lzip dist-xz subdir-objects]) m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])], [AC_SUBST([AM_DEFAULT_VERBOSITY],1)]) AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT) diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 089a8f5dd..36695d0bc 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998-2004, 2006-2014, 2016-2024 +## Copyright (C) 1998-2004, 2006-2014, 2016-2025 ## Free Software Foundation, Inc. ## ## This file is part of GUILE. @@ -20,8 +20,13 @@ ## write to the Free Software Foundation, Inc., 51 Franklin Street, ## Fifth Floor, Boston, MA 02110-1301 USA +noinst_LTLIBRARIES = + include $(top_srcdir)/am/snarf -include $(srcdir)/lightening/lightening.am +include lightening/lightening.am +include whippet/embed.am + +WHIPPET_EMBEDDER_CPPFLAGS = -include $(srcdir)/whippet-embedder.h AUTOMAKE_OPTIONS = gnu @@ -39,6 +44,7 @@ DEFAULT_INCLUDES = AM_CPPFLAGS = -DBUILDING_LIBGUILE=1 -I$(top_srcdir) -I$(top_builddir) \ -I$(top_srcdir)/lib -I$(top_builddir)/lib -iquote$(builddir) \ $(LIBFFI_CFLAGS) +#AM_CPPFLAGS += $(WHIPPET_CPPFLAGS) $(WHIPPET_CFLAGS) $(WHIPPET_TO_EMBEDDER_CPPFLAGS) if ENABLE_JIT AM_CPPFLAGS += -I$(top_srcdir)/libguile/lightening @@ -537,7 +543,8 @@ noinst_HEADERS = custom-ports.h \ private-options.h \ ports-internal.h \ syntax.h \ - weak-list.h + weak-list.h \ + whippet-embedder.h # vm instructions noinst_HEADERS += vm-engine.c diff --git a/libguile/whippet-embedder.h b/libguile/whippet-embedder.h new file mode 100644 index 000000000..2b5b15a36 --- /dev/null +++ b/libguile/whippet-embedder.h @@ -0,0 +1,218 @@ +#ifndef SCM_WHIPPET_EMBEDDER_H +#define SCM_WHIPPET_EMBEDDER_H + +/* 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 + . */ + +/* This file is added to the Whippet GC library's build via -include, + and allows the GC library to be specialized to Guile's object + representation. */ + + + +#include + + + +#include "scm.h" +#include "gc-config.h" +#include "gc-embedder-api.h" + + + + +#define GC_EMBEDDER_EPHEMERON_HEADER uintptr_t tag; +#define GC_EMBEDDER_FINALIZER_HEADER uintptr_t tag; + +static inline size_t gc_finalizer_priority_count (void) { return 2; } + +static inline int +gc_is_valid_conservative_ref_displacement (uintptr_t displacement) { +#if GC_CONSERVATIVE_ROOTS || GC_CONSERVATIVE_TRACE + if (displacement == 0) return 1; + if (displacement == scm_tc3_cons) return 1; + if (displacement == scm_tc3_struct) return 1; + return 0; +#else + // Shouldn't get here. + GC_CRASH (); +#endif +} + +// FIXME: Here add tracing for SCM literals in .go files or .data +// sections, perhaps. For now while we are using BDW-GC we can punt. +static inline int gc_extern_space_visit (struct gc_extern_space *space, + struct gc_edge edge, + struct gc_ref ref) { + GC_CRASH (); +} +static inline void gc_extern_space_start_gc (struct gc_extern_space *space, + int is_minor_gc) { +} +static inline void gc_extern_space_finish_gc (struct gc_extern_space *space, + int is_minor_gc) { +} + +static inline void gc_trace_object (struct gc_ref ref, + void (*trace_edge) (struct gc_edge edge, + struct gc_heap *heap, + void *trace_data), + struct gc_heap *heap, + void *trace_data, + size_t *size) { +#if GC_CONSERVATIVE_TRACE + // Shouldn't get here. + GC_CRASH (); +#else + // To be implemented. + GC_CRASH (); +#endif +} + +static inline void gc_trace_mutator_roots (struct gc_mutator_roots *roots, + void (*trace_edge)(struct gc_edge edge, + struct gc_heap *heap, + void *trace_data), + struct gc_heap *heap, + void *trace_data) { +} + +static inline void gc_trace_heap_roots (struct gc_heap_roots *roots, + void (*trace_edge)(struct gc_edge edge, + struct gc_heap *heap, + void *trace_data), + struct gc_heap *heap, + void *trace_data) { +} + +static inline SCM scm_from_gc_ref (struct gc_ref ref) { + return SCM_PACK (gc_ref_value (ref)); +} + +static inline struct gc_ref scm_to_gc_ref (SCM scm) { + return gc_ref (SCM_UNPACK (scm)); +} + +static inline scm_t_bits* scm_cell_type_loc (SCM scm) { + return (scm_t_bits *) SCM_UNPACK (scm); +} + +static const scm_t_bits scm_cell_type_busy = -1; +static const scm_t_bits scm_tc3_mask = 7; + +static inline uintptr_t gc_object_forwarded_nonatomic(struct gc_ref ref) { + scm_t_bits *loc = scm_cell_type_loc (scm_from_gc_ref (ref)); + scm_t_bits first_word = *loc; + if ((first_word & scm_tc3_mask) == scm_tc3_forwarded) + return first_word - scm_tc3_forwarded; + return 0; +} + +static inline void gc_object_forward_nonatomic(struct gc_ref ref, + struct gc_ref new_ref) { + scm_t_bits *loc = scm_cell_type_loc (scm_from_gc_ref (ref)); + *loc = gc_ref_value(new_ref) + scm_tc3_forwarded; +} + +static inline _Atomic scm_t_bits* scm_atomic_cell_type_loc (SCM scm) { + return (_Atomic scm_t_bits *) scm_cell_type_loc (scm); +} + +static inline struct gc_atomic_forward +gc_atomic_forward_begin (struct gc_ref ref) { + _Atomic scm_t_bits *loc = scm_atomic_cell_type_loc (scm_from_gc_ref (ref)); + scm_t_bits tag = atomic_load_explicit (loc, memory_order_acquire); + enum gc_forwarding_state state; + if (tag == scm_cell_type_busy) + state = GC_FORWARDING_STATE_BUSY; + else if ((tag & scm_tc3_mask) == scm_tc3_forwarded) + state = GC_FORWARDING_STATE_FORWARDED; + else + state = GC_FORWARDING_STATE_NOT_FORWARDED; + return (struct gc_atomic_forward) { ref, tag, state }; +} + +static inline _Atomic scm_t_bits* +scm_atomic_cell_type_loc_from_forward (struct gc_atomic_forward *fwd) { + return scm_atomic_cell_type_loc (scm_from_gc_ref (fwd->ref)); +} + +static inline int +gc_atomic_forward_retry_busy (struct gc_atomic_forward *fwd) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_BUSY); + _Atomic scm_t_bits *loc = scm_atomic_cell_type_loc_from_forward (fwd); + scm_t_bits tag = atomic_load_explicit (loc, memory_order_acquire); + if (tag == scm_cell_type_busy) + return 0; + if ((tag & 7) == scm_tc3_forwarded) { + fwd->state = GC_FORWARDING_STATE_FORWARDED; + fwd->data = tag; + } else { + fwd->state = GC_FORWARDING_STATE_NOT_FORWARDED; + fwd->data = tag; + } + return 1; +} + +static inline void +gc_atomic_forward_acquire (struct gc_atomic_forward *fwd) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_NOT_FORWARDED); + _Atomic scm_t_bits *loc = scm_atomic_cell_type_loc_from_forward (fwd); + if (atomic_compare_exchange_strong (loc, &fwd->data, scm_cell_type_busy)) + fwd->state = GC_FORWARDING_STATE_ACQUIRED; + else if (fwd->data == scm_cell_type_busy) + fwd->state = GC_FORWARDING_STATE_BUSY; + else { + GC_ASSERT ((fwd->data & scm_tc3_mask) == scm_tc3_forwarded); + fwd->state = GC_FORWARDING_STATE_FORWARDED; + } +} + +static inline void +gc_atomic_forward_abort (struct gc_atomic_forward *fwd) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_ACQUIRED); + _Atomic scm_t_bits *loc = scm_atomic_cell_type_loc_from_forward (fwd); + atomic_store_explicit (loc, fwd->data, memory_order_release); + fwd->state = GC_FORWARDING_STATE_NOT_FORWARDED; +} + +static inline size_t +gc_atomic_forward_object_size (struct gc_atomic_forward *fwd) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_ACQUIRED); + GC_CRASH (); // Unimplemented. +} + +static inline void +gc_atomic_forward_commit (struct gc_atomic_forward *fwd, struct gc_ref new_ref) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_ACQUIRED); + *scm_cell_type_loc (scm_from_gc_ref (new_ref)) = fwd->data; + atomic_store_explicit (scm_atomic_cell_type_loc_from_forward (fwd), + gc_ref_value (new_ref) + scm_tc3_forwarded, + memory_order_release); + fwd->state = GC_FORWARDING_STATE_FORWARDED; +} + +static inline uintptr_t +gc_atomic_forward_address (struct gc_atomic_forward *fwd) { + GC_ASSERT (fwd->state == GC_FORWARDING_STATE_FORWARDED); + GC_ASSERT ((fwd->data & scm_tc3_mask) == scm_tc3_forwarded); + return fwd->data - scm_tc3_forwarded; +} + + +#endif /* SCM_WHIPPET_EMBEDDER_H */