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 . */ - 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 +#include #include #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);