wingo pushed a commit to branch wip-whippet
in repository guile.
commit a80e4015406ec249959a8c0103e5862a73b8176d
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Apr 16 09:33:39 2025 +0200
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 | 2 +-
libguile/Makefile.am | 13 ++-
libguile/whippet-embedder.h | 218 ++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 229 insertions(+), 4 deletions(-)
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
+ <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 */
