From 9de24bd42950c91020c9123b12e862fedc10b51c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 1 Jul 2025 11:07:39 +0200 Subject: [PATCH] Implement scm_trace_object * libguile/trace.h: Make a precise object tracer. --- libguile/trace.h | 669 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 664 insertions(+), 5 deletions(-) diff --git a/libguile/trace.h b/libguile/trace.h index 43df0eab3..eb35f4985 100644 --- a/libguile/trace.h +++ b/libguile/trace.h @@ -21,9 +21,45 @@ -#include "libguile/scm.h" -#include "gc-ref.h" +#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" @@ -92,17 +128,640 @@ scm_trace_dynstack_roots (struct scm_dynstack *dynstack, 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_object (SCM obj, TRACE_PARAMS) +scm_trace_pair (struct scm_pair *pair, TRACE_PARAMS) { - GC_CRASH (); + if (trace) + { + TRACE_MEMBER (pair, car); + TRACE_MEMBER (pair, cdr); + } + + return sizeof (*pair); } -#undef TRACE_PARAMS +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 */