Add Whippet to libguile/Makefile.am

* configure.ac: Add subdir-objects Makefile.am option, to prevent
accidental collision between object file names.
* libguile/Makefile.am: Include whippet/embed.am, and add the
appropriate hooks to the Makefile.
* libguile/whippet-embedder.h: New file.

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)

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

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
+   <https://www.gnu.org/licenses/>.  */
+
+/* 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 <stdatomic.h>
+
+
+
+#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 */