mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-02 02:10:19 +02:00
Code Activity

Arrange to pin objects captured by a delimited continuation

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2025-05-27 16:02:01 +02:00
parent 177643d416
commit 0a0ecc518b
6 changed files with 114 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/continuations.c
View file

@ -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);

9
libguile/continuations.h
View file

@ -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;

4
libguile/frames.c
View file

@ -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:

9
libguile/stacks.c
View file

@ -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;

90
libguile/vm.c
View file

@ -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. */

66
libguile/vm.h
View file

@ -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);
}
SCM_API SCM scm_load_compiled_with_vm (SCM file);
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);
}
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;
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 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);