wingo pushed a commit to branch wip-whippet
in repository guile.
commit 0a0ecc518bab1b80b3ae42555d4ac01679f7514f
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue May 27 16:02:01 2025 +0200
Arrange to pin objects captured by a delimited continuation
* libguile/vm.h (struct scm_vm_cont): Include the tag word, and put
flags there. Rename stack bottom to stack slice and make a flexible
array.
(scm_is_vm_cont):
(scm_to_vm_cont):
(scm_from_vm_cont):
(scm_vm_cont_is_partial):
(scm_vm_cont_is_rewindable): New build-time helpers.
* libguile/continuations.c (scm_i_make_continuation):
(scm_i_continuation_to_frame):
(copy_stack_and_call):
* libguile/continuations.h (scm_t_contregs):
* libguile/frames.c (frame_stack_top):
* libguile/stacks.c (scm_make_stack): Adapt to take struct scm_vm_cont*
instead of SCM for continuations.
* libguile/vm.c (capture_stack): Adapt to scm_vm_cont change. Use new
gc_resolve_conservative_ref API to pin conservative refs from the
captured stack.
(scm_i_vm_cont_to_frame):
(scm_i_capture_current_stack):
(reinstate_continuation_x):
(capture_continuation):
(compose_continuation):
(capture_delimited_continuation):
(abort_to_prompt): Adapt to type changes.
---
libguile/continuations.c | 8 ++---
libguile/continuations.h | 9 +++--
libguile/frames.c | 4 +--
libguile/stacks.c | 9 ++---
libguile/vm.c | 90 +++++++++++++++++++++++++++---------------------
libguile/vm.h | 68 ++++++++++++++++++++++++++----------
6 files changed, 115 insertions(+), 73 deletions(-)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index cf7be4cb7..074fc748e 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -183,7 +183,7 @@ restore_auxiliary_stack (scm_thread *thread, scm_t_contregs
*continuation)
}
SCM
-scm_i_make_continuation (scm_thread *thread, SCM vm_cont)
+scm_i_make_continuation (scm_thread *thread, struct scm_vm_cont *vm_cont)
{
SCM cont;
scm_t_contregs *continuation;
@@ -221,9 +221,9 @@ scm_i_continuation_to_frame (SCM continuation, struct
scm_frame *frame)
contregs = SCM_PROGRAM_FREE_VARIABLE_REF (continuation, 0);
cont = SCM_CONTREGS (contregs);
- if (scm_is_true (cont->vm_cont))
+ if (cont->vm_cont)
{
- struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
+ struct scm_vm_cont *data = cont->vm_cont;
frame->stack_holder = data;
frame->fp_offset = data->fp_offset;
@@ -295,7 +295,7 @@ copy_stack_and_call (scm_t_contregs *continuation,
scm_t_bits *joint;
scm_thread *thread = SCM_I_CURRENT_THREAD;
- dynstack = SCM_VM_CONT_DATA (continuation->vm_cont)->dynstack;
+ dynstack = continuation->vm_cont->dynstack;
joint = scm_dynstack_unwind_fork (&thread->dynstack, dynstack);
diff --git a/libguile/continuations.h b/libguile/continuations.h
index ac636512e..260ce7d90 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -1,7 +1,7 @@
#ifndef SCM_CONTINUATIONS_H
#define SCM_CONTINUATIONS_H
-/* Copyright 1995-1996,2000-2001,2006,2008-2010,2012-2014,2018
+/* Copyright 1995-1996,2000-2001,2006,2008-2010,2012-2014,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -44,6 +44,8 @@
in the num_stack_items field of the structure.
*/
+struct scm_vm_cont;
+
typedef struct
{
jmp_buf jmpbuf;
@@ -53,7 +55,7 @@ typedef struct
#endif
size_t num_stack_items; /* size of the saved stack. */
SCM root; /* continuation root identifier. */
- SCM vm_cont; /* vm's stack and regs */
+ struct scm_vm_cont *vm_cont; /* vm's stack and regs */
/* The offset from the live stack location to this copy. This is
used to adjust pointers from within the copied stack to the stack
@@ -71,7 +73,8 @@ typedef struct
-SCM_INTERNAL SCM scm_i_make_continuation (scm_thread *thread, SCM vm_cont);
+SCM_INTERNAL SCM scm_i_make_continuation (scm_thread *thread,
+ struct scm_vm_cont *vm_cont);
SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont,
uint8_t *mra) SCM_NORETURN;
diff --git a/libguile/frames.c b/libguile/frames.c
index b2711df5c..5a5c007f9 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2015,2018,2021
+/* Copyright 2001,2009-2015,2018,2021,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -81,7 +81,7 @@ frame_stack_top (enum scm_vm_frame_kind kind, const struct
scm_frame *frame)
case SCM_VM_FRAME_KIND_CONT:
{
struct scm_vm_cont *cont = frame->stack_holder;
- return cont->stack_bottom + cont->stack_size;
+ return &cont->stack_slice[cont->stack_size];
}
case SCM_VM_FRAME_KIND_VM:
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 36842920b..e9b335f75 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,4 +1,4 @@
-/* Copyright 1996-1997,2000-2001,2006-2015,2017-2019
+/* Copyright 1996-1997,2000-2001,2006-2015,2017-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -324,12 +324,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
scm_make_stack was given. */
if (scm_is_eq (obj, SCM_BOOL_T))
{
- SCM cont;
- struct scm_vm_cont *c;
-
- cont = scm_i_capture_current_stack ();
- c = SCM_VM_CONT_DATA (cont);
-
+ struct scm_vm_cont *c = scm_i_capture_current_stack ();
kind = SCM_VM_FRAME_KIND_CONT;
frame.stack_holder = c;
frame.fp_offset = c->fp_offset;
diff --git a/libguile/vm.c b/libguile/vm.c
index 1711a262a..473d74d6c 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -145,7 +145,7 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state
*pstate)
int
scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
{
- struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont);
+ struct scm_vm_cont *data = scm_to_vm_cont (cont);
frame->stack_holder = data;
frame->fp_offset = data->fp_offset;
@@ -158,8 +158,9 @@ scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame)
/* Ideally we could avoid copying the C stack if the continuation root
is inside VM code, and call/cc was invoked within that same call to
vm_run. That's currently not implemented. */
-static SCM
-capture_stack (union scm_vm_stack_element *stack_top,
+static struct scm_vm_cont*
+capture_stack (scm_thread *thread,
+ union scm_vm_stack_element *stack_top,
union scm_vm_stack_element *fp,
union scm_vm_stack_element *sp,
uint32_t *vra,
@@ -171,24 +172,31 @@ capture_stack (union scm_vm_stack_element *stack_top,
stack_size = stack_top - sp;
- /* Allocate the 'scm_vm_cont' struct and the stack at once. That way,
- keeping a pointer to 'p->stack_bottom' around won't retain it.
- See <https://bugs.gnu.org/59021>. */
- p = scm_gc_malloc (sizeof (*p) + stack_size * sizeof (*p->stack_bottom),
+ p = scm_gc_malloc (sizeof (*p) + stack_size * sizeof (p->stack_slice[0]),
"capture_vm_cont");
-
- p->stack_size = stack_size;
- p->stack_bottom = (void *) ((char *) p + sizeof (*p));
+ p->tag_and_flags = scm_tc7_vm_cont | flags;
+ p->dynstack = dynstack;
p->vra = vra;
p->mra = mra;
p->fp_offset = stack_top - fp;
- memcpy (p->stack_bottom, sp, p->stack_size * sizeof (*p->stack_bottom));
- p->dynstack = dynstack;
- p->flags = flags;
- return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p);
+ p->stack_size = stack_size;
+
+ struct gc_mutator *mut = thread->mutator;
+ struct gc_heap *heap = gc_mutator_heap (mut);
+ for (size_t i = 0; i < stack_size; i++)
+ {
+ union scm_vm_stack_element elt = sp[i];
+ p->stack_slice[i] = elt;
+ struct gc_conservative_ref maybe_ref = gc_conservative_ref (elt.as_bits);
+ struct gc_ref ref = gc_resolve_conservative_ref (heap, maybe_ref, 0);
+ if (!gc_ref_is_null (ref))
+ gc_pin_object (mut, ref);
+ }
+
+ return p;
}
-SCM
+struct scm_vm_cont *
scm_i_capture_current_stack (void)
{
scm_thread *thread;
@@ -197,7 +205,7 @@ scm_i_capture_current_stack (void)
thread = SCM_I_CURRENT_THREAD;
vp = &thread->vm;
- return capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip, NULL,
+ return capture_stack (thread, vp->stack_top, vp->fp, vp->sp, vp->ip, NULL,
scm_dynstack_capture_all (&thread->dynstack),
0);
}
@@ -1089,7 +1097,7 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
argv = alloca (n * sizeof (*argv));
memcpy (argv, vp->sp, n * sizeof (*argv));
- cp = SCM_VM_CONT_DATA (continuation->vm_cont);
+ cp = continuation->vm_cont;
gc_inhibit_preemption (thread->mutator);
/* We know that there is enough space for the continuation, because we
@@ -1097,8 +1105,8 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
since the capture, so we may have to re-link the frame
pointers. */
memcpy (vp->stack_top - cp->stack_size,
- cp->stack_bottom,
- cp->stack_size * sizeof (*cp->stack_bottom));
+ cp->stack_slice,
+ cp->stack_size * sizeof (cp->stack_slice[0]));
vp->fp = vp->stack_top - cp->fp_offset;
vm_restore_sp (vp, vp->stack_top - cp->stack_size);
gc_reallow_preemption (thread->mutator);
@@ -1125,14 +1133,16 @@ capture_continuation (scm_thread *thread)
if (mra == scm_jit_return_to_interpreter_trampoline)
mra = NULL;
#endif
- SCM vm_cont = capture_stack (vp->stack_top,
- SCM_FRAME_DYNAMIC_LINK (vp->fp),
- SCM_FRAME_PREVIOUS_SP (vp->fp),
- SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp),
- mra,
- scm_dynstack_capture_all (&thread->dynstack),
- 0);
- return scm_i_make_continuation (thread, vm_cont);
+ struct scm_vm_cont *cont =
+ capture_stack (thread,
+ vp->stack_top,
+ SCM_FRAME_DYNAMIC_LINK (vp->fp),
+ SCM_FRAME_PREVIOUS_SP (vp->fp),
+ SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp),
+ mra,
+ scm_dynstack_capture_all (&thread->dynstack),
+ 0);
+ return scm_i_make_continuation (thread, cont);
}
static uint8_t*
@@ -1140,11 +1150,11 @@ compose_continuation (scm_thread *thread, SCM cont)
{
struct scm_vm *vp = &thread->vm;
size_t nargs;
- struct scm_vm_cont *cp;
+ struct scm_vm_cont *cp = scm_to_vm_cont (cont);
union scm_vm_stack_element *args;
ptrdiff_t old_fp_offset;
- if (SCM_UNLIKELY (! SCM_VM_CONT_REWINDABLE_P (cont)))
+ if (SCM_UNLIKELY (!scm_vm_cont_is_rewindable (cont)))
scm_wrong_type_arg_msg (NULL, 0, cont, "resumable continuation");
#if ENABLE_JIT
@@ -1157,7 +1167,7 @@ compose_continuation (scm_thread *thread, SCM cont)
args = alloca (nargs * sizeof (*args));
memcpy (args, vp->sp, nargs * sizeof (*args));
- cp = SCM_VM_CONT_DATA (cont);
+ cp = scm_to_vm_cont (cont);
old_fp_offset = vp->stack_top - vp->fp;
@@ -1165,8 +1175,8 @@ compose_continuation (scm_thread *thread, SCM cont)
gc_inhibit_preemption (thread->mutator);
memcpy (vp->fp - cp->stack_size,
- cp->stack_bottom,
- cp->stack_size * sizeof (*cp->stack_bottom));
+ cp->stack_slice,
+ cp->stack_size * sizeof (cp->stack_slice[0]));
vp->fp -= cp->fp_offset;
vp->ip = cp->vra;
gc_reallow_preemption (thread->mutator);
@@ -1242,14 +1252,14 @@ foreign_call (scm_thread *thread, SCM cif, SCM pointer)
}
static SCM
-capture_delimited_continuation (struct scm_vm *vp,
+capture_delimited_continuation (scm_thread *thread,
+ struct scm_vm *vp,
union scm_vm_stack_element *saved_fp,
uint8_t *saved_mra,
jmp_buf *saved_registers,
scm_t_dynstack *dynstack,
jmp_buf *current_registers)
{
- SCM vm_cont;
uint32_t flags;
union scm_vm_stack_element *base_fp;
@@ -1278,10 +1288,11 @@ capture_delimited_continuation (struct scm_vm *vp,
/* Capture from the base_fp to the top thunk application frame. Don't
capture values from the most recent frame, as they are the abort
args. */
- vm_cont = capture_stack (base_fp, vp->fp, vp->fp, vp->ip,
- saved_mra, dynstack, flags);
+ struct scm_vm_cont *vm_cont =
+ capture_stack (thread, base_fp, vp->fp, vp->fp, vp->ip, saved_mra,
+ dynstack, flags);
- return scm_i_make_composable_continuation (vm_cont);
+ return scm_i_make_composable_continuation (scm_from_vm_cont (vm_cont));
}
void
@@ -1401,8 +1412,9 @@ abort_to_prompt (scm_thread *thread, uint8_t *saved_mra)
scm_t_dynstack *captured;
captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
- cont = capture_delimited_continuation (vp, fp, saved_mra, registers,
- captured, thread->vm.registers);
+ cont = capture_delimited_continuation (thread, vp, fp, saved_mra,
+ registers, captured,
+ thread->vm.registers);
}
/* Unwind. */
diff --git a/libguile/vm.h b/libguile/vm.h
index d6175ff8e..d44456c0e 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -27,6 +27,7 @@
#endif
#include <libguile/gc.h>
+#include <libguile/frames.h>
#include <libguile/programs.h>
#define SCM_VM_REGULAR_ENGINE 0
@@ -90,10 +91,17 @@ SCM_API void scm_c_set_default_vm_engine_x (int engine);
SCM_INTERNAL void scm_i_vm_prepare_stack (struct scm_vm *vp);
SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp);
-#define SCM_F_VM_CONT_PARTIAL 0x1
-#define SCM_F_VM_CONT_REWINDABLE 0x2
+#ifdef BUILDING_LIBGUILE
+
+#define SCM_F_VM_CONT_PARTIAL 0x100
+#define SCM_F_VM_CONT_REWINDABLE 0x200
struct scm_vm_cont {
+ /* vmcont tc7 in low 8 bits, partial and/or rewindable flags above. */
+ scm_t_bits tag_and_flags;
+ /* Saved dynamic stack, with prompts relocated to record saved SP/FP
+ offsets from the stack top of this scm_vm_cont. */
+ scm_t_dynstack *dynstack;
/* IP of newest frame. */
uint32_t *vra;
/* Machine code corresponding to IP. */
@@ -104,28 +112,52 @@ struct scm_vm_cont {
the newest frame. */
ptrdiff_t stack_size;
/* Stack bottom, which also keeps saved stack alive for GC. */
- union scm_vm_stack_element *stack_bottom;
- /* Saved dynamic stack, with prompts relocated to record saved SP/FP
- offsets from the stack top of this scm_vm_cont. */
- scm_t_dynstack *dynstack;
- /* See the continuation is partial and/or rewindable. */
- uint32_t flags;
+ union scm_vm_stack_element stack_slice[];
};
-#define SCM_VM_CONT_P(OBJ) (SCM_HAS_TYP7 (OBJ, scm_tc7_vm_cont))
-#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
-#define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags &
SCM_F_VM_CONT_PARTIAL)
-#define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags &
SCM_F_VM_CONT_REWINDABLE)
+static inline int
+scm_is_vm_cont (SCM x)
+{
+ return SCM_HAS_TYP7 (x, scm_tc7_vm_cont);
+}
+
+static inline struct scm_vm_cont *
+scm_to_vm_cont (SCM cont)
+{
+ if (!scm_is_vm_cont (cont)) abort ();
+ return (struct scm_vm_cont *) SCM_UNPACK_POINTER (cont);
+}
+
+static inline SCM
+scm_from_vm_cont (struct scm_vm_cont *cont)
+{
+ return SCM_PACK_POINTER (cont);
+}
+
+static inline int
+scm_vm_cont_is_partial (SCM cont)
+{
+ return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_PARTIAL;
+}
+
+static inline int
+scm_vm_cont_is_rewindable (SCM cont)
+{
+ return scm_to_vm_cont (cont)->tag_and_flags & SCM_F_VM_CONT_REWINDABLE;
+}
+
+SCM_INTERNAL struct scm_vm_cont *scm_i_capture_current_stack (void);
+SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
+SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
+ scm_print_state *pstate);
+
+#endif /* BUILDING_LIBGUILE */
+SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
+SCM_INTERNAL void scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n)
SCM_NORETURN;
SCM_API SCM scm_load_compiled_with_vm (SCM file);
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
-SCM_INTERNAL SCM scm_i_capture_current_stack (void);
-SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
-SCM_INTERNAL void scm_i_vm_emergency_abort (SCM *tag_and_argv, size_t n)
SCM_NORETURN;
-SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
-SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
- scm_print_state *pstate);
SCM_INTERNAL int scm_i_vm_is_boot_continuation_code (uint32_t *ip);
SCM_INTERNAL void scm_bootstrap_vm (void);
SCM_INTERNAL void scm_init_vm (void);
