mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
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.
This commit is contained in:
Andy Wingo
parent
a463e0d376
commit
a80e401540
3 changed files with 229 additions and 4 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
218
libguile/whippet-embedder.h
Normal file
218
libguile/whippet-embedder.h
Normal file
|
|
@ -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 */
|
||||
Loading…
Add table
Add a link
Reference in a new issue