guile/libguile/whippet-embedder.h

#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 "libguile/scm.h"
#include "libguile/trace.h"
#include "gc-config.h"
#include "gc-embedder-api.h"




struct scm_thread;
struct gc_mutator_roots {
  struct scm_thread *thread;
};

#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) {
  trace_edge (gc_edge (&roots->thread), heap, trace_data);
  scm_trace_thread_mutator_roots (roots->thread, trace_edge, heap, 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 */