This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch wip-whippet
in repository guile.
The following commit(s) were added to refs/heads/wip-whippet by this push:
new 278ba9902 Allow precise tracing of dynstacks
278ba9902 is described below
commit 278ba990279b31bcf72806d8460270ae0d45613c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Jun 19 16:32:56 2025 +0200
Allow precise tracing of dynstacks
Gosh this was a slog
* libguile/dynstack.c (dynstack_ensure_space): Use malloc and free.
Threads have off-heap dynstacks, with manual marking.
(scm_trace_dynstack): Implement tracing.
(trace_pinned_trampoline, scm_trace_dynstack_roots): Implement tracing
for active threads.
(scm_dynstack_capture): Tag dynstacks.
* libguile/dynstack.h (scm_t_dynstack): Add a tag.
(scm_t_dynstack_winder_flags): Add SCM_F_DYNSTACK_WINDER_MANAGED.
* libguile/dynwind.h (scm_t_wind_flags): Add SCM_F_WIND_MANAGED.
* libguile/dynwind.c (scm_dynwind_unwind_handler_with_scm)
(scm_dynwind_rewind_handler_with_scm): These values need to be traced by
GC.
* libguile/scm.h (scm_tc16_dynstack_slice): New typecode. No need for
equality etc because it shouldn't escape to Scheme (currently).
* libguile/trace.h: Add trace decls.
* libguile/threads.c (scm_trace_thread_roots): Trace dynstacks
explicitly here, as they are off-heap.
---
libguile/dynstack.c | 138 ++++++++++++++++++++++++++++++++++++++++++++--------
libguile/dynstack.h | 9 +++-
libguile/dynwind.c | 8 +--
libguile/dynwind.h | 5 +-
libguile/scm.h | 1 +
libguile/threads.c | 20 ++------
libguile/trace.h | 17 +++++++
7 files changed, 155 insertions(+), 43 deletions(-)
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index e4ed878c2..a5b659271 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -1,4 +1,4 @@
-/* Copyright 2012-2013,2018
+/* Copyright 2012-2013,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -37,6 +37,7 @@
#include "fluids.h"
#include "variable.h"
#include "threads.h"
+#include "trace.h"
#include "dynstack.h"
@@ -44,7 +45,8 @@
#define PROMPT_WORDS 6
-#define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
+#define PROMPT_KEY_LOC(top) ((SCM*)(top))
+#define PROMPT_KEY(top) (*PROMPT_KEY_LOC(top))
#define PROMPT_FP(top) ((ptrdiff_t) ((top)[1]))
#define SET_PROMPT_FP(top, fp) do { top[1] = (scm_t_bits)(fp); } while (0)
#define PROMPT_SP(top) ((ptrdiff_t) ((top)[2]))
@@ -55,18 +57,24 @@
#define WINDER_WORDS 2
#define WINDER_PROC(top) ((scm_t_guard) ((top)[0]))
-#define WINDER_DATA(top) ((void *) ((top)[1]))
+#define WINDER_DATA_LOC(top) ((void **) ((top) + 1))
+#define WINDER_DATA(top) (*WINDER_DATA_LOC(top))
#define DYNWIND_WORDS 2
-#define DYNWIND_ENTER(top) (SCM_PACK ((top)[0]))
-#define DYNWIND_LEAVE(top) (SCM_PACK ((top)[1]))
+#define DYNWIND_ENTER_LOC(top) ((SCM*)(top))
+#define DYNWIND_LEAVE_LOC(top) ((SCM*)(top) + 1)
+#define DYNWIND_ENTER(top) (*DYNWIND_ENTER_LOC(top))
+#define DYNWIND_LEAVE(top) (*DYNWIND_LEAVE_LOC(top))
#define WITH_FLUID_WORDS 2
-#define WITH_FLUID_FLUID(top) (SCM_PACK ((top)[0]))
-#define WITH_FLUID_VALUE_BOX(top) (SCM_PACK ((top)[1]))
+#define WITH_FLUID_FLUID_LOC(top) ((SCM*)(top))
+#define WITH_FLUID_VALUE_BOX_LOC(top) ((SCM*)(top) + 1)
+#define WITH_FLUID_FLUID(top) (*WITH_FLUID_FLUID_LOC(top))
+#define WITH_FLUID_VALUE_BOX(top) (*WITH_FLUID_VALUE_BOX_LOC(top))
#define DYNAMIC_STATE_WORDS 1
-#define DYNAMIC_STATE_STATE_BOX(top) (SCM_PACK ((top)[0]))
+#define DYNAMIC_STATE_STATE_BOX_LOC(top) ((SCM*)(top))
+#define DYNAMIC_STATE_STATE_BOX(top) (*DYNAMIC_STATE_STATE_BOX_LOC(top))
@@ -100,22 +108,111 @@ dynstack_ensure_space (scm_t_dynstack *dynstack, size_t
n)
if (capacity < height + n)
{
- scm_t_bits *new_base;
-
+ scm_t_bits *old_base = dynstack->base;
while (capacity < height + n)
capacity = (capacity < 4) ? 8 : (capacity * 2);
- new_base = scm_gc_malloc (capacity * sizeof(scm_t_bits), "dynstack");
+ dynstack->base = scm_malloc (capacity * sizeof(scm_t_bits));
+ dynstack->top = dynstack->base + height;
+ dynstack->limit = dynstack->base + capacity;
- copy_scm_t_bits (new_base, dynstack->base, height);
- clear_scm_t_bits (dynstack->base, height);
-
- dynstack->base = new_base;
- dynstack->top = new_base + height;
- dynstack->limit = new_base + capacity;
+ copy_scm_t_bits (dynstack->base, old_base, height);
+ clear_scm_t_bits (dynstack->base + height, capacity - height);
+ free (old_base);
}
}
+void
+scm_dynstack_init_for_thread (scm_t_dynstack *dynstack)
+{
+ dynstack->tag = -1;
+ dynstack->base = NULL;
+ dynstack->limit = NULL;
+ dynstack->top = NULL;
+ dynstack_ensure_space (dynstack, 1000);
+ dynstack->top += SCM_DYNSTACK_HEADER_LEN;
+}
+
+void
+scm_trace_dynstack (struct scm_dynstack *dynstack,
+ void (*trace) (struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data),
+ struct gc_heap *heap, void *trace_data)
+{
+ scm_t_bits *walk;
+
+ for (walk = SCM_DYNSTACK_PREV (dynstack->top); walk;
+ walk = SCM_DYNSTACK_PREV (walk))
+ {
+ scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+ switch (SCM_DYNSTACK_TAG_TYPE (tag))
+ {
+ case SCM_DYNSTACK_TYPE_FRAME:
+ break;
+ case SCM_DYNSTACK_TYPE_UNWINDER:
+ case SCM_DYNSTACK_TYPE_REWINDER:
+ if (SCM_DYNSTACK_TAG_FLAGS (tag) & SCM_F_DYNSTACK_WINDER_MANAGED)
+ trace (gc_edge (WINDER_DATA_LOC (walk)), heap, trace_data);
+ break;
+ case SCM_DYNSTACK_TYPE_WITH_FLUID:
+ trace (gc_edge (WITH_FLUID_FLUID_LOC (walk)), heap, trace_data);
+ trace (gc_edge (WITH_FLUID_VALUE_BOX_LOC (walk)), heap, trace_data);
+ break;
+ case SCM_DYNSTACK_TYPE_PROMPT:
+ trace (gc_edge (PROMPT_KEY_LOC (walk)), heap, trace_data);
+ // No need to trace the jmpbuf; either:
+ // 1. the prompt is active and thus the jmpbuf is on the
+ // stack and traced conservatively already
+ // 2. the dynstack is part of a delimited continuation, in
+ // which case the jmpbuf is garbage and will be rewound
+ // if the dynstack is reinstated
+ // 2. the dynstack is part of an undelimited continuation, in
+ // which case the jmpbuf is conservatively marked as part
+ // of the associated continuation
+ break;
+ case SCM_DYNSTACK_TYPE_DYNWIND:
+ trace (gc_edge (DYNWIND_ENTER_LOC (walk)), heap, trace_data);
+ trace (gc_edge (DYNWIND_LEAVE_LOC (walk)), heap, trace_data);
+ break;
+ case SCM_DYNSTACK_TYPE_DYNAMIC_STATE:
+ trace (gc_edge (DYNAMIC_STATE_STATE_BOX_LOC (walk)), heap,
trace_data);
+ break;
+ default:
+ abort ();
+ }
+ }
+}
+
+struct trace_pinned_trampoline
+{
+ void (*trace_pinned) (struct gc_ref ref,
+ struct gc_heap *heap,
+ void *trace_data);
+ void *trace_data;
+};
+
+static void
+trace_pinned_trampoline (struct gc_edge edge,
+ struct gc_heap *heap,
+ void *trace_data)
+{
+ struct trace_pinned_trampoline *data = trace_data;
+ return data->trace_pinned (gc_edge_ref (edge), heap, data->trace_data);
+}
+
+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)
+{
+ struct trace_pinned_trampoline data = { trace_pinned, trace_data };
+ return scm_trace_dynstack (dynstack, trace_pinned_trampoline, heap, &data);
+}
+
static inline scm_t_bits *
push_dynstack_entry_unchecked (scm_t_dynstack *dynstack,
scm_t_dynstack_item_type type,
@@ -280,7 +377,6 @@ scm_dynstack_capture_all (scm_t_dynstack *dynstack)
scm_t_dynstack *
scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits *item)
{
- char *mem;
scm_t_dynstack *ret;
size_t len;
@@ -288,9 +384,9 @@ scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits
*item)
assert (item <= dynstack->top);
len = dynstack->top - item + SCM_DYNSTACK_HEADER_LEN;
- mem = scm_gc_malloc (sizeof (*ret) + len * sizeof(scm_t_bits), "dynstack");
- ret = (scm_t_dynstack *) mem;
- ret->base = (scm_t_bits *) (mem + sizeof (*ret));
+ ret = scm_gc_malloc (sizeof (*ret) + len * sizeof(scm_t_bits), "dynstack");
+ ret->tag = scm_tc16_dynstack_slice;
+ ret->base = ret->inline_storage;
ret->limit = ret->base + len;
ret->top = ret->base + len;
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 6f0775e40..29cf9a081 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -1,7 +1,7 @@
#ifndef SCM_DYNSTACK_H
#define SCM_DYNSTACK_H
-/* Copyright 2012-2013,2018
+/* Copyright 2012-2013,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -36,9 +36,11 @@
typedef struct scm_dynstack
{
+ scm_t_bits tag;
scm_t_bits *base;
scm_t_bits *top;
scm_t_bits *limit;
+ scm_t_bits inline_storage[];
} scm_t_dynstack;
@@ -133,7 +135,8 @@ typedef enum {
} scm_t_dynstack_frame_flags;
typedef enum {
- SCM_F_DYNSTACK_WINDER_EXPLICIT = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
+ SCM_F_DYNSTACK_WINDER_EXPLICIT = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT),
+ SCM_F_DYNSTACK_WINDER_MANAGED = (2 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
} scm_t_dynstack_winder_flags;
typedef enum {
@@ -145,6 +148,8 @@ typedef void (*scm_t_guard) (void *);
+SCM_INTERNAL void scm_dynstack_init_for_thread (scm_t_dynstack *);
+
/* Pushing and popping entries on the dynamic stack. */
SCM_INTERNAL void scm_dynstack_push_frame (scm_t_dynstack *,
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index 85bf5aabc..e784b1e17 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998-2001,2003-2004,2006,2008,2010-2012,2018
+/* Copyright 1995-1996,1998-2001,2003-2004,2006,2008,2010-2012,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -99,7 +99,8 @@ scm_dynwind_unwind_handler_with_scm (void (*proc) (SCM), SCM
data,
scm_t_wind_flags flags)
{
/* FIXME: This is not a safe cast. */
- scm_dynwind_unwind_handler ((scm_t_guard) proc, SCM2PTR (data), flags);
+ scm_dynwind_unwind_handler ((scm_t_guard) proc, SCM2PTR (data),
+ flags | SCM_F_WIND_MANAGED);
}
void
@@ -107,7 +108,8 @@ scm_dynwind_rewind_handler_with_scm (void (*proc) (SCM),
SCM data,
scm_t_wind_flags flags)
{
/* FIXME: This is not a safe cast. */
- scm_dynwind_rewind_handler ((scm_t_guard) proc, SCM2PTR (data), flags);
+ scm_dynwind_rewind_handler ((scm_t_guard) proc, SCM2PTR (data),
+ flags | SCM_F_WIND_MANAGED);
}
void
diff --git a/libguile/dynwind.h b/libguile/dynwind.h
index 099fee7af..0ebc1deba 100644
--- a/libguile/dynwind.h
+++ b/libguile/dynwind.h
@@ -1,7 +1,7 @@
#ifndef SCM_DYNWIND_H
#define SCM_DYNWIND_H
-/* Copyright 1995-1996,1998-2000,2003-2004,2006,2008,2011-2012,2018
+/* Copyright 1995-1996,1998-2000,2003-2004,2006,2008,2011-2012,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -37,7 +37,8 @@ typedef enum {
} scm_t_dynwind_flags;
typedef enum {
- SCM_F_WIND_EXPLICITLY = SCM_F_DYNSTACK_WINDER_EXPLICIT
+ SCM_F_WIND_EXPLICITLY = SCM_F_DYNSTACK_WINDER_EXPLICIT,
+ SCM_F_WIND_MANAGED = SCM_F_DYNSTACK_WINDER_MANAGED
} scm_t_wind_flags;
SCM_API void scm_dynwind_begin (scm_t_dynwind_flags);
diff --git a/libguile/scm.h b/libguile/scm.h
index feccfc533..38a522602 100644
--- a/libguile/scm.h
+++ b/libguile/scm.h
@@ -517,6 +517,7 @@ typedef uintptr_t scm_t_bits;
#define scm_tc16_random_state 0x067f
#define scm_tc16_regexp 0x077f
#define scm_tc16_locale 0x087f
+#define scm_tc16_dynstack_slice 0x097f
/* Definitions for tc16: */
diff --git a/libguile/threads.c b/libguile/threads.c
index 1f803edb0..a147126ea 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -87,18 +87,6 @@
/* FIXME: For the moment, the bodies of thread objects are traced
conservatively; only bdw, heap-conservative-mmc, and
heap-conservative-parallel-mmc are supported. */
-static void
-scm_trace_dynstack (scm_t_dynstack *dynstack,
- void (*trace_edge) (struct gc_edge edge,
- struct gc_heap *heap,
- void *trace_data),
- struct gc_heap *heap, void *trace_data)
-{
- /* FIXME: Untagged array. Perhaps this should be off-heap... or
- interleaved on the main stack. */
- trace_edge (gc_edge (&dynstack->base), heap, trace_data);
-}
-
void
scm_trace_thread (struct scm_thread *thread,
void (*trace_edge) (struct gc_edge edge,
@@ -151,6 +139,10 @@ scm_trace_thread_roots (struct scm_thread *thread,
struct gc_heap *heap, void *trace_data)
{
trace_pinned (gc_ref_from_heap_object (thread), heap, trace_data);
+#if GC_CONSERVATIVE_TRACE
+ scm_trace_dynstack_roots (&thread->dynstack, trace_pinned, heap, trace_data);
+#endif
+ /* FIXME: Trace is not a tagged allocation. */
scm_trace_vm_roots (&thread->vm, trace_pinned, trace_ambiguous, heap,
trace_data);
}
@@ -480,9 +472,7 @@ guilify_self_2 (SCM dynamic_state)
t->dynamic_state->thread_local_values = scm_c_make_hash_table (0);
scm_set_current_dynamic_state (dynamic_state);
- t->dynstack.base = scm_gc_malloc (16 * sizeof (scm_t_bits), "dynstack");
- t->dynstack.limit = t->dynstack.base + 16;
- t->dynstack.top = t->dynstack.base + SCM_DYNSTACK_HEADER_LEN;
+ scm_dynstack_init_for_thread (&t->dynstack);
t->block_asyncs = 0;
}
diff --git a/libguile/trace.h b/libguile/trace.h
index 4db9c5811..4275b4996 100644
--- a/libguile/trace.h
+++ b/libguile/trace.h
@@ -23,11 +23,13 @@
#include "libguile/scm.h"
#include "gc-ref.h"
+#include "gc-edge.h"
struct scm_thread;
struct scm_vm;
+struct scm_dynstack;
struct gc_heap;
struct gc_heap_roots { int unused; };
@@ -78,5 +80,20 @@ scm_trace_loader_roots (void (*trace_ambiguous) (uintptr_t
lo,
struct gc_heap *heap,
void *trace_data);
+SCM_INTERNAL void
+scm_trace_dynstack (struct scm_dynstack *dynstack,
+ void (*trace) (struct gc_edge edge,
+ 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);
#endif /* SCM_THREADS_INTERNAL_H */
