#ifndef SCM_TRACE_H
#define SCM_TRACE_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/>.  */



#include "gc-api.h"
#include "gc-edge.h"
#include "gc-conservative-ref.h"
#include "gc-ref.h"
#include "gc-finalizer.h"
#include "gc-ephemeron.h"
#include "libguile/arrays-internal.h"
#include "libguile/atomic.h"
#include "libguile/bitvectors-internal.h"
#include "libguile/bytevectors-internal.h"
#include "libguile/continuations-internal.h"
#include "libguile/dynstack.h"
#include "libguile/ephemerons.h"
#include "libguile/filesys-internal.h"
#include "libguile/fluids-internal.h"
#include "libguile/foreign.h"
#include "libguile/frames-internal.h"
#include "libguile/hashtab.h"
#include "libguile/i18n-internal.h"
#include "libguile/integers.h"
#include "libguile/keywords-internal.h"
#include "libguile/macros-internal.h"
#include "libguile/numbers.h"
#include "libguile/ports-internal.h"
#include "libguile/programs.h"
#include "libguile/random.h"
#include "libguile/regex-posix.h"
#include "libguile/scm.h"
#include "libguile/smob-internal.h"
#include "libguile/srfi-14-internal.h"
#include "libguile/strings-internal.h"
#include "libguile/struct.h"
#include "libguile/symbols.h"
#include "libguile/syntax.h"
#include "libguile/threads-internal.h"
#include "libguile/values-internal.h"
#include "libguile/variable.h"
#include "libguile/vectors-internal.h"
#include "libguile/vm-internal.h"



struct scm_thread;
struct scm_vm;
struct scm_dynstack;
struct gc_heap;
struct gc_heap_roots { int unused; };

static inline SCM
scm_from_ref (struct gc_ref ref)
{
  return SCM_PACK (gc_ref_value (ref));
}

static inline struct gc_ref
scm_to_ref (SCM scm)
{
  return gc_ref (SCM_UNPACK (scm));
}

SCM_INTERNAL void
scm_trace_thread_roots (struct scm_thread *thread,
                        void (*trace_pinned) (struct gc_ref ref,
                                              struct gc_heap *heap,
                                              void *trace_data),
                        void (*trace_ambiguous) (uintptr_t lo,
                                                 uintptr_t hi,
                                                 int possibly_interior,
                                                 struct gc_heap *heap,
                                                 void *trace_data),
                        struct gc_heap *heap,
                        void *trace_data);

SCM_INTERNAL void
scm_trace_vm_roots (struct scm_vm *vp,
                    void (*trace_pinned) (struct gc_ref ref,
                                          struct gc_heap *heap,
                                          void *trace_data),
                    void (*trace_ambiguous) (uintptr_t lo,
                                             uintptr_t hi,
                                             int possibly_interior,
                                             struct gc_heap *heap,
                                             void *trace_data),
                    struct gc_heap *heap,
                    void *trace_data);

SCM_INTERNAL void
scm_trace_loader_roots (void (*trace_ambiguous) (uintptr_t lo,
                                                 uintptr_t hi,
                                                 int possibly_interior,
                                                 struct gc_heap *heap,
                                                 void *trace_data),
                        struct gc_heap *heap,
                        void *trace_data);

SCM_INTERNAL void
scm_trace_dynstack_roots (struct scm_dynstack *dynstack,
                          void (*trace_pinned) (struct gc_ref ref,
                                                struct gc_heap *heap,
                                                void *trace_data),
                          struct gc_heap *heap,
                          void *trace_data);

#define TRACE_PARAMS \
  void (*trace) (struct gc_edge, struct gc_heap *, void *), \
  struct gc_heap *heap, \
  void *trace_data
#define TRACE_ARGS trace, heap, trace_data

static inline void
scm_trace_edge_conservatively (void * addr, int maybe_interior, TRACE_PARAMS)
{
  uintptr_t *loc = addr;
  uintptr_t val = *loc;
  if (SCM_HEAP_OBJECT_P (SCM_PACK (val)))
    {
      struct gc_conservative_ref maybe_ref = gc_conservative_ref (val);
      struct gc_ref ref =
        gc_resolve_conservative_ref (heap, maybe_ref, maybe_interior);
      // Precondition: targers of ambiguous edges are not evacuated.
      // Two ways to make this happen: either nothing is evacuated, or
      // these objects are pinned, as in
      // continuations.c:pin_conservative_roots.
      if (!gc_ref_is_null (ref))
        trace (gc_edge (&ref), heap, trace_data);
    }
}

static inline void
scm_trace_field_conservatively (void *field, TRACE_PARAMS)
{
  scm_trace_edge_conservatively (field, 0, TRACE_ARGS);
}

static inline void
scm_trace_range_conservatively (void *start, size_t size, int maybe_interior,
                                TRACE_PARAMS)
{
  size_t word_size = sizeof (uintptr_t);
  uintptr_t addr = (uintptr_t) start;
  uintptr_t end = (addr + size) & ~(word_size - 1);
  addr = (addr + word_size - 1) & ~(word_size - 1);

  for (; addr < end; addr += word_size)
    scm_trace_edge_conservatively ((void *) addr, maybe_interior, TRACE_ARGS);
}

#define TRACE(loc) trace (gc_edge (loc), heap, trace_data)
#define TRACE_SLOT(x, n) TRACE(&((x)[n]))
#define TRACE_MEMBER(x, m) TRACE(&(x)->m)

#define TRACE_PINNED_AMBIGUOUS_SLOT(x, n) \
  scm_trace_field_conservatively (&((x)[n]), TRACE_ARGS)

#define SIZEOF_WITH_TAIL(x, field, count) \
  (sizeof (*(x)) + sizeof (*((x)->field)) * count)

#define SCM_CAST(x, type) ((type) SCM_UNPACK_POINTER (x))

SCM_INTERNAL void
scm_trace_dynstack (struct scm_dynstack *dynstack, TRACE_PARAMS);

static inline size_t
scm_trace_pair (struct scm_pair *pair, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (pair, car);
      TRACE_MEMBER (pair, cdr);
    }

  return sizeof (*pair);
}

static inline size_t
scm_trace_struct (struct scm_struct *s, TRACE_PARAMS)
{
  // Struct vtables are pinned.
  struct scm_struct *vtable = scm_i_struct_vtable (s);
  size_t nfields = scm_i_vtable_size (vtable);

  if (trace)
    {
      // unboxed_fields is either an inum or a bignum.  If it's a
      // bignum, it's pinned.
      SCM unboxed_fields = scm_i_vtable_unboxed_fields (vtable);
      if (scm_is_eq (unboxed_fields, SCM_INUM0))
        for (size_t i = 0; i < nfields; i++)
          TRACE_SLOT (s->slots, i);
      else
        for (size_t i = 0; i < nfields; i++)
          if (scm_is_false (scm_logbit_p (unboxed_fields, SCM_I_MAKINUM (i))))
            TRACE_SLOT (s->slots, i);
    }

  return SIZEOF_WITH_TAIL (s, slots, nfields);
}

static inline size_t
scm_trace_symbol (struct scm_symbol *s, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (s, name);

  return sizeof (*s);
}

static inline size_t
scm_trace_variable (struct scm_variable *v, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (v, value);

  return sizeof (*v);
}

static inline size_t
scm_trace_vector (struct scm_vector *v, TRACE_PARAMS)
{
  size_t len = scm_i_vector_length (v);

  if (trace)
    for (size_t idx = 0; idx < len; idx++)
      TRACE_SLOT (v->slots, idx);

  return SIZEOF_WITH_TAIL (v, slots, len);
}

static inline size_t
scm_trace_ephemeron_table (struct scm_ephemeron_table *et, TRACE_PARAMS)
{
  if (trace)
    {
      for (size_t idx = 0; idx < et->size; idx++)
        TRACE_SLOT (et->contents, idx);
    }

  return SIZEOF_WITH_TAIL (et, contents, et->size);
}

static inline size_t
scm_trace_string (struct scm_string *s, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (s, chars);

  return sizeof (*s);
}

static inline size_t
scm_trace_number (SCM obj, TRACE_PARAMS)
{
  switch (SCM_TYP16 (obj))
    {
    case scm_tc16_big:
      return scm_integer_size_z (scm_bignum (obj));
    case scm_tc16_real:
      return sizeof (struct scm_t_double);
    case scm_tc16_complex:
      return sizeof (struct scm_t_complex);
    case scm_tc16_fraction:
      {
        struct scm_fraction *f = SCM_CAST (obj, struct scm_fraction *);
        if (trace)
          {
            TRACE_MEMBER (f, numerator);
            TRACE_MEMBER (f, denominator);
          }
        return sizeof (*f);
      }
    default:
      abort();
    }
}

static inline size_t
scm_trace_hashtable (struct scm_t_hashtable *ht, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (ht, buckets);

  return sizeof (*ht);
}

static inline size_t
scm_trace_pointer (struct scm_pointer *p, TRACE_PARAMS)
{
  size_t extra_words = scm_pointer_gc_object_count (p);

  if (trace)
    for (size_t i = 0; i < extra_words; i++)
      TRACE_MEMBER (p, gc_objects);

  return SIZEOF_WITH_TAIL (p, gc_objects, extra_words);
}

static inline size_t
scm_trace_fluid (struct scm_fluid *f, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (f, default_value);

  return sizeof (*f);
}

static inline size_t
scm_trace_stringbuf (struct scm_stringbuf *buf, TRACE_PARAMS)
{
  size_t char_sz = (buf->tag_and_flags & SCM_I_STRINGBUF_F_WIDE) ? 4 : 1;
  return sizeof (*buf) + buf->length * char_sz;
}

static inline size_t
scm_trace_dynamic_state (struct scm_dynamic_state_snapshot *dynstate, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (dynstate, bindings);

  return sizeof (*dynstate);
}

static inline size_t
scm_trace_frame (struct scm_vm_frame *f, TRACE_PARAMS)
{
  if (trace)
    switch (scm_vm_frame_kind (f))
      {
      case SCM_VM_FRAME_KIND_VM:
        break;
      case SCM_VM_FRAME_KIND_CONT:
        TRACE_MEMBER (&f->frame, stack_holder);
        break;
      default:
        abort ();
      }

  return sizeof (*f);
}

static inline size_t
scm_trace_keyword (struct scm_keyword *k, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (k, symbol);

  return sizeof (*k);
}

static inline size_t
scm_trace_atomic_box (struct scm_atomic_box *b, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (b, value);

  return sizeof (*b);
}

static inline size_t
scm_trace_syntax (struct scm_syntax *stx, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (stx, expr);
      TRACE_MEMBER (stx, wrap);
      TRACE_MEMBER (stx, module);
      TRACE_MEMBER (stx, source);
    }

  return sizeof (*stx);
}

static inline size_t
scm_trace_values (struct scm_values *v, TRACE_PARAMS)
{
  size_t count = scm_values_count (v);

  if (trace)
    for (size_t i = 0; i < count; i++)
      TRACE_SLOT (v->values, i);

  return SIZEOF_WITH_TAIL (v, values, count);
}

static inline size_t
scm_trace_program (struct scm_program *p, TRACE_PARAMS)
{
  size_t count = scm_program_free_variable_count (p);

  if (trace)
    for (size_t i = 0; i < count; i++)
      TRACE_SLOT (p->free_variables, i);

  return SIZEOF_WITH_TAIL (p, free_variables, count);
}

static inline size_t
scm_trace_vm_cont (struct scm_vm_cont *c, TRACE_PARAMS)
{
  size_t count = c->stack_size;

  if (trace)
    {
      TRACE_MEMBER (c, dynstack);
      for (size_t i = 0; i < count; i++)
        TRACE_PINNED_AMBIGUOUS_SLOT (c->stack_slice, i);
    }

  return SIZEOF_WITH_TAIL (c, stack_slice, count);
}

static inline size_t
scm_trace_bytevector (struct scm_bytevector *x, TRACE_PARAMS)
{
  if (x->contents == x->inline_contents)
    return SIZEOF_WITH_TAIL (x, inline_contents, x->length);

  if (trace)
    {
      TRACE_MEMBER (x, parent);
      if (scm_is_false (x->parent))
        TRACE_MEMBER (x, contents);
    }

  return sizeof (*x);
}

static inline size_t
scm_trace_thread (struct scm_thread *x, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (x, next_thread);
      TRACE_MEMBER (x, pending_asyncs);
      TRACE_MEMBER (x, continuation_root);
      TRACE_MEMBER (x, join_cond);
      TRACE_MEMBER (x, join_lock);
      TRACE_MEMBER (x, join_results);

      scm_trace_dynstack (&x->dynstack, TRACE_ARGS);
    }

  return sizeof (*x);
}

static inline size_t
scm_trace_port_type (struct scm_t_port_type *ptob, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (ptob, scm_read);
      TRACE_MEMBER (ptob, scm_write);
      TRACE_MEMBER (ptob, input_class);
      TRACE_MEMBER (ptob, output_class);
      TRACE_MEMBER (ptob, input_output_class);
    }

  return sizeof (*ptob);
}

static inline size_t
scm_trace_array (struct scm_array *x, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (x, vector);

  return SIZEOF_WITH_TAIL (x, dims, scm_array_dimension_count (x));
}

static inline size_t
scm_trace_bitvector (struct scm_bitvector *x, TRACE_PARAMS)
{
  return SIZEOF_WITH_TAIL (x, bits, scm_bitvector_word_length (x));
}

static inline size_t
scm_trace_smob (struct scm_smob *x, TRACE_PARAMS)
{
  const struct scm_smob_descriptor *desc = scm_i_smob_descriptor (x);

  if (!desc->field_count)
    {
      size_t size = desc->observed_size * sizeof (scm_t_bits);
      if (trace)
        scm_trace_range_conservatively (x, size, 1, TRACE_ARGS);
      return size;
    }

  if (trace)
    for (size_t i = 0; i < desc->field_count; i++)
      if (scm_smob_field_is_managed (desc, i))
        TRACE (scm_smob_field_loc (x, i));

  return sizeof (*x) + desc->field_count * sizeof (SCM);
}

static inline size_t
scm_trace_port (struct scm_t_port *x, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (x, file_name);
      TRACE_MEMBER (x, position);
      TRACE_MEMBER (x, read_buf);
      TRACE_MEMBER (x, write_buf);
      TRACE_MEMBER (x, encoding);
      TRACE_MEMBER (x, conversion_strategy);
      TRACE_MEMBER (x, precise_encoding);
      TRACE_MEMBER (x, close_handle);
      TRACE_MEMBER (x, alist);

      if (x->ptob->stream_mode != SCM_PORT_STREAM_UNMANAGED)
        TRACE_MEMBER (x, stream);
    }

  return sizeof (*x);
}

static inline size_t
scm_trace_character_set (struct scm_charset *cs, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (cs, ranges);

  return sizeof (*cs);
}

static inline size_t
scm_trace_condition_variable (struct scm_cond *c, TRACE_PARAMS)
{
  if (trace)
    TRACE_MEMBER (c, waiting);

  return sizeof (*c);
}

static inline size_t
scm_trace_mutex (struct scm_mutex *m, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (m, owner);
      TRACE_MEMBER (m, waiting);
    }

  return sizeof (*m);
}

static inline size_t
scm_trace_continuation (struct scm_continuation *c, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (c, root);
      TRACE_MEMBER (c, vm_cont);

      scm_trace_range_conservatively (&c->jmpbuf, sizeof (c->jmpbuf), 1,
                                      TRACE_ARGS);
      scm_trace_range_conservatively (c->stack,
                                      c->num_stack_items * sizeof (SCM_STACKITEM),
                                      1,
                                      TRACE_ARGS);
    }

  return SIZEOF_WITH_TAIL (c, stack, c->num_stack_items);
}

static inline size_t
scm_trace_directory (struct scm_directory *d, TRACE_PARAMS)
{
  return sizeof (*d);
}

static inline size_t
scm_trace_syntax_transformer (struct scm_syntax_transformer *tx, TRACE_PARAMS)
{
  if (trace)
    {
      TRACE_MEMBER (tx, name);
      TRACE_MEMBER (tx, type);
      TRACE_MEMBER (tx, binding);
    }

  return sizeof (*tx);
}

static inline size_t
scm_trace_random_state (struct scm_t_rstate *s, TRACE_PARAMS)
{
  return s->rng->rstate_size;
}

static inline size_t
scm_trace_regexp (struct scm_regexp *rx, TRACE_PARAMS)
{
  return sizeof (*rx);
}

static inline size_t
scm_trace_locale (struct scm_locale *l, TRACE_PARAMS)
{
  return sizeof (*l);
}

static inline size_t
scm_trace_dynstack_slice (struct scm_dynstack *ds, TRACE_PARAMS)
{
  if (trace)
    scm_trace_dynstack (ds, TRACE_ARGS);

  return SIZEOF_WITH_TAIL (ds, inline_storage, scm_dynstack_capacity (ds));
}

#define FOR_EACH_TC7_WITH_STRUCT_TYPE(M)                                 \
  M(tcs_cons_nimcar, pair, scm_pair)                                     \
  M(tcs_cons_imcar, pair, scm_pair)                                      \
  M(tcs_struct, struct, scm_struct)                                      \
  M(tc7_symbol, symbol, scm_symbol)                                      \
  M(tc7_variable, variable, scm_variable)                                \
  M(tc7_vector, vector, scm_vector)                                      \
  M(tc7_ephemeron_table, ephemeron_table, scm_ephemeron_table)           \
  M(tc7_string, string, scm_string)                                      \
  M(tc7_hashtable, hashtable, scm_t_hashtable)                           \
  M(tc7_pointer, pointer, scm_pointer)                                   \
  M(tc7_fluid, fluid, scm_fluid)                                         \
  M(tc7_stringbuf, stringbuf, scm_stringbuf)                             \
  M(tc7_dynamic_state, dynamic_state, scm_dynamic_state_snapshot)        \
  M(tc7_frame, frame, scm_vm_frame)                                      \
  M(tc7_keyword, keyword, scm_keyword)                                   \
  M(tc7_atomic_box, atomic_box, scm_atomic_box)                          \
  M(tc7_syntax, syntax, scm_syntax)                                      \
  M(tc7_values, values, scm_values)                                      \
  M(tc7_program, program, scm_program)                                   \
  M(tc7_vm_cont, vm_cont, scm_vm_cont)                                   \
  M(tc7_bytevector, bytevector, scm_bytevector)                          \
  M(tc7_thread, thread, scm_thread)                                      \
  M(tc7_port_type, port_type, scm_t_port_type)                           \
  M(tc7_array, array, scm_array)                                         \
  M(tc7_bitvector, bitvector, scm_bitvector)                             \
  M(tc7_port, port, scm_t_port)                                          \

#define FOR_EACH_EXT_TC16_WITH_STRUCT_TYPE(M)                            \
  M(charset, character_set, scm_charset)                                 \
  M(condition_variable, condition_variable, scm_cond)                    \
  M(mutex, mutex, scm_mutex)                                             \
  M(continuation, continuation, scm_continuation)                        \
  M(directory, directory, scm_directory)                                 \
  M(syntax_transformer, syntax_transformer, scm_syntax_transformer)      \
  M(random_state, random_state, scm_t_rstate)                            \
  M(regexp, regexp, scm_regexp)                                          \
  M(locale, locale, scm_locale)                                          \
  M(dynstack_slice, dynstack_slice, scm_dynstack)

static inline size_t
scm_trace_object (SCM obj, TRACE_PARAMS)
{
  // Trace an object.  Note that in the rare case in which we need to
  // access another object in order to trace this object, as with
  // structs and vtables, we need to consider that the other object may
  // be evacuated and have a forwarding word in their first word.
  // Sometimes this is OK, sometimes instead we need to make sure to pin
  // the other object.

  switch (SCM_TYP7 (obj))
    {
#define TRACE_TC7(tc, stem, struct_tag)                                 \
    case scm_##tc:                                                      \
      return scm_trace_##stem (SCM_CAST (obj, struct struct_tag *),     \
                               TRACE_ARGS);
      FOR_EACH_TC7_WITH_STRUCT_TYPE(TRACE_TC7)
#undef TRACE_TC7

    case scm_tc7_ext:
      {
        switch (SCM_TYP16 (obj))
          {
#define TRACE_EXT_TC16(tc, stem, struct_tag)                            \
            case scm_tc16_##tc:                                         \
              return scm_trace_##stem (SCM_CAST (obj, struct struct_tag *), \
                                       TRACE_ARGS);
            FOR_EACH_EXT_TC16_WITH_STRUCT_TYPE(TRACE_EXT_TC16)
#undef TRACE_EXT_TC16

          default:
            abort ();
          }
      }

    case scm_tc7_number:
      switch (SCM_TYP16 (obj))
        {
        case scm_tc16_big:
          return scm_integer_size_z (scm_bignum (obj));
        case scm_tc16_real:
          return sizeof (struct scm_t_double);
        case scm_tc16_complex:
          return sizeof (struct scm_t_complex);
        case scm_tc16_fraction:
          {
            struct scm_fraction *f = SCM_CAST (obj, struct scm_fraction *);
            if (trace)
              {
                TRACE_MEMBER (f, numerator);
                TRACE_MEMBER (f, denominator);
              }
            return sizeof (*f);
          }
        default:
          abort();
        }

    case scm_tc7_finalizer:
      gc_trace_finalizer (SCM_CAST (obj, struct gc_finalizer *), TRACE_ARGS);
      return gc_finalizer_size ();

    case scm_tc7_ephemeron:
      gc_trace_ephemeron (SCM_CAST (obj, struct gc_ephemeron *), TRACE_ARGS);
      return gc_ephemeron_size ();

    case scm_tc7_smob:
      {
        struct scm_smob *x = SCM_CAST (obj, struct scm_smob *);
        return sizeof (*x);
      }

    default:
      abort ();
    }
}

#undef FOR_EACH_TC7_WITH_STRUCT_TYPE
#undef FOR_EACH_EXT_TC16_WITH_STRUCT_TYPE

#undef TRACE_PARAMS
#undef TRACE_ARGS

#undef TRACE_MEMBER
#undef TRACE_SLOT
#undef TRACE

#undef SIZEOF_WITH_TAIL

#undef SCM_CAST

#endif  /* SCM_TRACE_H */