diff --git a/libguile/continuations.c b/libguile/continuations.c index c7e008f18..479266e99 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -228,7 +228,7 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame) frame->stack_holder = data; frame->fp_offset = data->fp_offset; frame->sp_offset = data->stack_size; - frame->ip = data->ra; + frame->ip = data->vra; return 1; } @@ -261,7 +261,7 @@ scm_i_contregs (SCM contregs) * with their correct stack. */ -static void scm_dynthrow (SCM); +static void scm_dynthrow (SCM, uint8_t *); /* Grow the stack by a fixed amount to provide space to copy in the * continuation. Possibly this function has to be called several times @@ -273,12 +273,12 @@ static void scm_dynthrow (SCM); static scm_t_bits scm_i_dummy; static void -grow_stack (SCM cont) +grow_stack (SCM cont, uint8_t *mra) { scm_t_bits growth[100]; scm_i_dummy = (scm_t_bits) growth; - scm_dynthrow (cont); + scm_dynthrow (cont, mra); } @@ -289,7 +289,7 @@ grow_stack (SCM cont) static void copy_stack_and_call (scm_t_contregs *continuation, - SCM_STACKITEM * dst) + SCM_STACKITEM * dst, uint8_t *mra) { scm_t_dynstack *dynstack; scm_t_bits *joint; @@ -305,6 +305,7 @@ copy_stack_and_call (scm_t_contregs *continuation, scm_dynstack_wind (&thread->dynstack, joint); + thread->vm.mra_after_abort = mra; longjmp (continuation->jmpbuf, 1); } @@ -313,7 +314,7 @@ copy_stack_and_call (scm_t_contregs *continuation, * actual copying and continuation calling. */ static void -scm_dynthrow (SCM cont) +scm_dynthrow (SCM cont, uint8_t *mra) { scm_thread *thread = SCM_I_CURRENT_THREAD; scm_t_contregs *continuation = SCM_CONTREGS (cont); @@ -326,17 +327,17 @@ scm_dynthrow (SCM cont) #else dst -= continuation->num_stack_items; if (dst <= &stack_top_element) - grow_stack (cont); + grow_stack (cont, mra); #endif /* def SCM_STACK_GROWS_UP */ SCM_FLUSH_REGISTER_WINDOWS; - copy_stack_and_call (continuation, dst); + copy_stack_and_call (continuation, dst, mra); } void -scm_i_reinstate_continuation (SCM cont) +scm_i_reinstate_continuation (SCM cont, uint8_t *mra) { - scm_dynthrow (cont); + scm_dynthrow (cont, mra); abort (); /* Unreachable. */ } diff --git a/libguile/continuations.h b/libguile/continuations.h index 8893eef07..d83bed9b7 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -68,7 +68,8 @@ typedef struct SCM_INTERNAL SCM scm_i_make_continuation (scm_thread *thread, SCM vm_cont); -SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont) SCM_NORETURN; +SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont, + uint8_t *mra) SCM_NORETURN; SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont, struct scm_frame *frame); diff --git a/libguile/control.c b/libguile/control.c index 61ead5e9b..20b3e74d2 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -138,7 +138,7 @@ scm_suspendable_continuation_p (SCM tag) jmp_buf *registers; if (scm_dynstack_find_prompt (&thread->dynstack, tag, &flags, - NULL, NULL, NULL, ®isters)) + NULL, NULL, NULL, NULL, ®isters)) return scm_from_bool (registers == thread->vm.registers); return SCM_BOOL_F; diff --git a/libguile/dynstack.c b/libguile/dynstack.c index 032545028..2eec7a7eb 100644 --- a/libguile/dynstack.c +++ b/libguile/dynstack.c @@ -38,14 +38,15 @@ -#define PROMPT_WORDS 5 +#define PROMPT_WORDS 6 #define PROMPT_KEY(top) (SCM_PACK ((top)[0])) #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])) #define SET_PROMPT_SP(top, sp) do { top[2] = (scm_t_bits)(sp); } while (0) -#define PROMPT_IP(top) ((uint32_t *) ((top)[3])) -#define PROMPT_JMPBUF(top) ((jmp_buf *) ((top)[4])) +#define PROMPT_VRA(top) ((uint32_t *) ((top)[3])) +#define PROMPT_MRA(top) ((uint8_t *) ((top)[4])) +#define PROMPT_JMPBUF(top) ((jmp_buf *) ((top)[5])) #define WINDER_WORDS 2 #define WINDER_PROC(top) ((scm_t_guard) ((top)[0])) @@ -197,7 +198,7 @@ scm_dynstack_push_prompt (scm_t_dynstack *dynstack, scm_t_dynstack_prompt_flags flags, SCM key, ptrdiff_t fp_offset, ptrdiff_t sp_offset, - uint32_t *ip, jmp_buf *registers) + uint32_t *vra, uint8_t *mra, jmp_buf *registers) { scm_t_bits *words; @@ -206,8 +207,9 @@ scm_dynstack_push_prompt (scm_t_dynstack *dynstack, words[0] = SCM_UNPACK (key); words[1] = (scm_t_bits) fp_offset; words[2] = (scm_t_bits) sp_offset; - words[3] = (scm_t_bits) ip; - words[4] = (scm_t_bits) registers; + words[3] = (scm_t_bits) vra; + words[4] = (scm_t_bits) mra; + words[5] = (scm_t_bits) registers; } void @@ -500,7 +502,7 @@ scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key, scm_t_dynstack_prompt_flags *flags, ptrdiff_t *fp_offset, ptrdiff_t *sp_offset, - uint32_t **ip, jmp_buf **registers) + uint32_t **vra, uint8_t **mra, jmp_buf **registers) { scm_t_bits *walk; @@ -518,8 +520,10 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key, *fp_offset = PROMPT_FP (walk); if (sp_offset) *sp_offset = PROMPT_SP (walk); - if (ip) - *ip = PROMPT_IP (walk); + if (vra) + *vra = PROMPT_VRA (walk); + if (mra) + *mra = PROMPT_MRA (walk); if (registers) *registers = PROMPT_JMPBUF (walk); return walk; @@ -593,7 +597,8 @@ scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item, PROMPT_KEY (item), PROMPT_FP (item) + base_fp_offset, PROMPT_SP (item) + base_fp_offset, - PROMPT_IP (item), + PROMPT_VRA (item), + PROMPT_MRA (item), registers); } diff --git a/libguile/dynstack.h b/libguile/dynstack.h index 6fc824aa7..4c32a0943 100644 --- a/libguile/dynstack.h +++ b/libguile/dynstack.h @@ -160,7 +160,8 @@ SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *, SCM key, ptrdiff_t fp_offset, ptrdiff_t sp_offset, - uint32_t *ip, + uint32_t *vra, + uint8_t *mra, jmp_buf *registers); SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *, SCM enter, SCM leave); @@ -201,6 +202,7 @@ SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM, ptrdiff_t *, ptrdiff_t *, uint32_t **, + uint8_t **, jmp_buf **); SCM_INTERNAL SCM scm_dynstack_find_old_fluid_value (scm_t_dynstack *, diff --git a/libguile/eval.c b/libguile/eval.c index 589a297d8..d60b8de91 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -441,6 +441,7 @@ eval (SCM x, SCM env) jmp_buf registers; jmp_buf *prev_registers; ptrdiff_t saved_stack_depth; + uint8_t *mra = NULL; k = EVAL1 (CAR (mx), env); handler = EVAL1 (CDDR (mx), env); @@ -454,7 +455,7 @@ eval (SCM x, SCM env) k, t->vm.stack_top - t->vm.fp, saved_stack_depth, - t->vm.ip, + t->vm.ip, mra, ®isters); prev_registers = t->vm.registers; diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 317526688..cf4833d71 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -349,7 +349,8 @@ current_module (scm_thread *thread) static void push_prompt (scm_thread *thread, uint8_t escape_only_p, - SCM tag, const union scm_vm_stack_element *sp, uint32_t *ra) + SCM tag, const union scm_vm_stack_element *sp, uint32_t *vra, + uint8_t *mra) { struct scm_vm *vp = &thread->vm; scm_t_dynstack_prompt_flags flags; @@ -357,7 +358,7 @@ push_prompt (scm_thread *thread, uint8_t escape_only_p, flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0; scm_dynstack_push_prompt (&thread->dynstack, flags, tag, vp->stack_top - vp->fp, vp->stack_top - sp, - ra, thread->vm.registers); + vra, mra, thread->vm.registers); } void diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 877aced04..aa2355bf1 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -61,12 +61,15 @@ typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN; typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN; typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t); typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*); -typedef void (*scm_t_thread_u8_scm_sp_vra_intrinsic) (scm_thread*, - uint8_t, SCM, - const union scm_vm_stack_element*, - uint32_t*); +typedef void (*scm_t_thread_u8_scm_sp_vra_mra_intrinsic) (scm_thread*, + uint8_t, SCM, + const union scm_vm_stack_element*, + uint32_t*, uint8_t*); typedef void (*scm_t_thread_mra_intrinsic) (scm_thread*, uint8_t*); typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*); +typedef uint8_t* (*scm_t_mra_from_thread_scm_intrinsic) (scm_thread*, SCM); +typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); +typedef SCM (*scm_t_scm_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -118,10 +121,10 @@ typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*); M(thread_mra, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \ M(thread_scm_scm, foreign_call, "foreign-call", FOREIGN_CALL) \ M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \ - M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \ - M(thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \ + M(scm_from_thread_mra, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \ + M(mra_from_thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \ M(int_from_scm, rest_arg_length, "rest-arg-length", REST_ARG_LENGTH) \ - M(thread, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \ + M(mra_from_thread_mra, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \ M(scm_scm_noreturn, throw_, "throw", THROW) \ M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \ M(scm_scm_noreturn, throw_with_value_and_data, "throw/value+data", THROW_WITH_VALUE_AND_DATA) \ @@ -132,7 +135,7 @@ typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) (scm_thread*); M(vra_from_thread, get_callee_vcode, "get-callee-vcode", GET_CALLEE_VCODE) \ M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \ M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \ - M(thread_u8_scm_sp_vra, push_prompt, "push-prompt", PUSH_PROMPT) \ + M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT) \ M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \ M(thread, invoke_apply_hook, "invoke-apply-hook", INVOKE_APPLY_HOOK) \ M(thread, invoke_return_hook, "invoke-return-hook", INVOKE_RETURN_HOOK) \ diff --git a/libguile/jit.c b/libguile/jit.c index 69b202132..346e9197e 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -1215,10 +1215,11 @@ scm_jit_compute_mcode (scm_thread *thread, struct scm_jit_function_data *data) return NULL; } -void +uint32_t * scm_jit_enter_mcode (scm_thread *thread, const uint8_t *mcode) { abort (); + return NULL; } void diff --git a/libguile/jit.h b/libguile/jit.h index 09e8d1be4..34f5751d9 100644 --- a/libguile/jit.h +++ b/libguile/jit.h @@ -53,7 +53,8 @@ enum scm_jit_counter_value SCM_INTERNAL const uint8_t *scm_jit_compute_mcode (scm_thread *thread, struct scm_jit_function_data *data); -SCM_INTERNAL void scm_jit_enter_mcode (scm_thread *thread, const uint8_t *mcode); +SCM_INTERNAL uint32_t *scm_jit_enter_mcode (scm_thread *thread, + const uint8_t *mcode); SCM_INTERNAL void scm_init_jit (void); diff --git a/libguile/stacks.c b/libguile/stacks.c index db9120877..044e4cefb 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -108,7 +108,7 @@ find_prompt (SCM key) ptrdiff_t fp_offset; if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key, - NULL, &fp_offset, NULL, NULL, NULL)) + NULL, &fp_offset, NULL, NULL, NULL, NULL)) scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack", scm_list_1 (key)); @@ -334,7 +334,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, frame.stack_holder = c; frame.fp_offset = c->fp_offset; frame.sp_offset = c->stack_size; - frame.ip = c->ra; + frame.ip = c->vra; } else if (SCM_VM_FRAME_P (obj)) { diff --git a/libguile/throw.c b/libguile/throw.c index f1f854015..e0149dfef 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -88,6 +88,7 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) jmp_buf registers; jmp_buf *prev_registers; ptrdiff_t saved_stack_depth; + uint8_t *mra = NULL; if (!scm_is_eq (tag, SCM_BOOL_T) && !scm_is_symbol (tag)) scm_wrong_type_arg ("catch", 1, tag); @@ -119,6 +120,7 @@ catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) t->vm.stack_top - t->vm.fp, saved_stack_depth, t->vm.ip, + mra, ®isters); scm_dynstack_push_fluid (dynstack, exception_handler_fluid, eh, dynamic_state); diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 26ba16816..9789fc82d 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -472,8 +472,8 @@ VM_NAME (scm_thread *thread) if (mcode) { - scm_jit_enter_mcode (thread, mcode); - CACHE_REGISTER (); + ip = scm_jit_enter_mcode (thread, mcode); + CACHE_SP (); NEXT (0); } } @@ -672,14 +672,25 @@ VM_NAME (scm_thread *thread) { SCM vmcont; uint32_t cont_idx; + uint8_t *mcode; UNPACK_24 (op, cont_idx); vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx); SYNC_IP (); - CALL_INTRINSIC (compose_continuation, (thread, vmcont)); - CACHE_REGISTER (); - NEXT (0); + mcode = CALL_INTRINSIC (compose_continuation, (thread, vmcont)); + + if (mcode) + { + ip = scm_jit_enter_mcode (thread, mcode); + CACHE_SP (); + NEXT (0); + } + else + { + CACHE_REGISTER (); + NEXT (0); + } } /* instrument-loop _:24 data:32 @@ -705,8 +716,8 @@ VM_NAME (scm_thread *thread) if (mcode) { - scm_jit_enter_mcode (thread, mcode); - CACHE_REGISTER (); + ip = scm_jit_enter_mcode (thread, mcode); + CACHE_SP (); NEXT (0); } } @@ -724,11 +735,12 @@ VM_NAME (scm_thread *thread) VM_DEFINE_OP (15, capture_continuation, "capture-continuation", DOP1 (X8_S24)) { uint32_t dst; + uint8_t *mra = NULL; UNPACK_24 (op, dst); SYNC_IP (); - SP_SET (dst, CALL_INTRINSIC (capture_continuation, (thread))); + SP_SET (dst, CALL_INTRINSIC (capture_continuation, (thread, mra))); NEXT (1); } @@ -741,19 +753,32 @@ VM_NAME (scm_thread *thread) */ VM_DEFINE_OP (16, abort, "abort", OP1 (X32)) { + uint8_t *mcode = NULL; + /* FIXME: Really we should capture the caller's registers. Until then, manually advance the IP so that when the prompt resumes, it continues with the next instruction. */ ip++; SYNC_IP (); - CALL_INTRINSIC (abort_to_prompt, (thread)); + mcode = CALL_INTRINSIC (abort_to_prompt, (thread, mcode)); /* If abort_to_prompt returned, that means there were no intervening C frames to jump over, so we just continue directly. */ - CACHE_REGISTER (); + ABORT_CONTINUATION_HOOK (); - NEXT (0); + + if (mcode) + { + ip = scm_jit_enter_mcode (thread, mcode); + CACHE_SP (); + NEXT (0); + } + else + { + CACHE_REGISTER (); + NEXT (0); + } } /* builtin-ref dst:12 idx:12 @@ -1623,6 +1648,7 @@ VM_NAME (scm_thread *thread) uint32_t tag, proc_slot; int32_t offset; uint8_t escape_only_p; + uint8_t *mra = NULL; UNPACK_24 (op, tag); escape_only_p = ip[1] & 0x1; @@ -1633,7 +1659,7 @@ VM_NAME (scm_thread *thread) /* Push the prompt onto the dynamic stack. */ SYNC_IP (); CALL_INTRINSIC (push_prompt, (thread, escape_only_p, SP_REF (tag), - VP->fp - proc_slot, ip + offset)); + VP->fp - proc_slot, ip + offset, mra)); NEXT (3); } diff --git a/libguile/vm.c b/libguile/vm.c index d4750056b..36255b204 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -153,7 +153,7 @@ scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame) frame->stack_holder = data; frame->fp_offset = data->fp_offset; frame->sp_offset = data->stack_size; - frame->ip = data->ra; + frame->ip = data->vra; return 1; } @@ -161,11 +161,13 @@ 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. */ -SCM -scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top, - union scm_vm_stack_element *fp, - union scm_vm_stack_element *sp, uint32_t *ra, - scm_t_dynstack *dynstack, uint32_t flags) +static SCM +capture_stack (union scm_vm_stack_element *stack_top, + union scm_vm_stack_element *fp, + union scm_vm_stack_element *sp, + uint32_t *vra, + uint8_t *mra, + scm_t_dynstack *dynstack, uint32_t flags) { struct scm_vm_cont *p; @@ -173,7 +175,8 @@ scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top, p->stack_size = stack_top - sp; p->stack_bottom = scm_gc_malloc (p->stack_size * sizeof (*p->stack_bottom), "capture_vm_cont"); - p->ra = ra; + 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; @@ -190,9 +193,9 @@ scm_i_capture_current_stack (void) thread = SCM_I_CURRENT_THREAD; vp = &thread->vm; - return scm_i_vm_capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip, - scm_dynstack_capture_all (&thread->dynstack), - 0); + return capture_stack (vp->stack_top, vp->fp, vp->sp, vp->ip, NULL, + scm_dynstack_capture_all (&thread->dynstack), + 0); } static void invoke_apply_hook (scm_thread *thread); @@ -1077,22 +1080,22 @@ reinstate_continuation_x (scm_thread *thread, SCM cont) vp->sp[n+i].as_scm = SCM_BOOL_F; memcpy(vp->sp, argv, n * sizeof (union scm_vm_stack_element)); - vp->ip = cp->ra; + vp->ip = cp->vra; - scm_i_reinstate_continuation (cont); + scm_i_reinstate_continuation (cont, cp->mra); } static SCM -capture_continuation (scm_thread *thread) +capture_continuation (scm_thread *thread, uint8_t *mra) { struct scm_vm *vp = &thread->vm; - SCM vm_cont = - scm_i_vm_capture_stack (vp->stack_top, - SCM_FRAME_DYNAMIC_LINK (vp->fp), - SCM_FRAME_PREVIOUS_SP (vp->fp), - SCM_FRAME_VIRTUAL_RETURN_ADDRESS (vp->fp), - scm_dynstack_capture_all (&thread->dynstack), - 0); + 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), + SCM_FRAME_MACHINE_RETURN_ADDRESS (vp->fp), + scm_dynstack_capture_all (&thread->dynstack), + 0); return scm_i_make_continuation (thread, vm_cont); } @@ -1114,12 +1117,12 @@ compose_continuation_inner (void *data_ptr) cp->stack_size * sizeof (*cp->stack_bottom)); vp->fp -= cp->fp_offset; - vp->ip = cp->ra; + vp->ip = cp->vra; - return NULL; + return cp->mra; } -static void +static uint8_t* compose_continuation (scm_thread *thread, SCM cont) { struct scm_vm *vp = &thread->vm; @@ -1128,6 +1131,7 @@ compose_continuation (scm_thread *thread, SCM cont) struct scm_vm_cont *cp; union scm_vm_stack_element *args; ptrdiff_t old_fp_offset; + uint8_t *mra; if (SCM_UNLIKELY (! SCM_VM_CONT_REWINDABLE_P (cont))) scm_wrong_type_arg_msg (NULL, 0, cont, "resumable continuation"); @@ -1144,7 +1148,7 @@ compose_continuation (scm_thread *thread, SCM cont) data.vp = vp; data.cp = cp; - GC_call_with_alloc_lock (compose_continuation_inner, &data); + mra = GC_call_with_alloc_lock (compose_continuation_inner, &data); /* The resumed continuation will expect ARGS on the stack as if from a multiple-value return. */ @@ -1169,6 +1173,8 @@ compose_continuation (scm_thread *thread, SCM cont) scm_dynstack_wind_1 (&thread->dynstack, walk); } } + + return mra; } static int @@ -1210,6 +1216,7 @@ foreign_call (scm_thread *thread, SCM cif, SCM pointer) static SCM capture_delimited_continuation (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) @@ -1243,8 +1250,8 @@ 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 = scm_i_vm_capture_stack (base_fp, vp->fp, vp->fp, vp->ip, dynstack, - flags); + vm_cont = capture_stack (base_fp, vp->fp, vp->fp, vp->ip, + saved_mra, dynstack, flags); return scm_i_make_composable_continuation (vm_cont); } @@ -1257,8 +1264,8 @@ scm_i_vm_abort (SCM *tag_and_argv, size_t n) abort (); } -static void -abort_to_prompt (scm_thread *thread) +static uint8_t * +abort_to_prompt (scm_thread *thread, uint8_t *saved_mra) { struct scm_vm *vp = &thread->vm; scm_t_dynstack *dynstack = &thread->dynstack; @@ -1268,15 +1275,16 @@ abort_to_prompt (scm_thread *thread) scm_t_dynstack_prompt_flags flags; ptrdiff_t fp_offset, sp_offset; union scm_vm_stack_element *fp, *sp; - uint32_t *ip; + uint32_t *vra; + uint8_t *mra; jmp_buf *registers; tag = SCM_FRAME_LOCAL (vp->fp, 1); nargs = frame_locals_count (thread) - 2; prompt = scm_dynstack_find_prompt (dynstack, tag, - &flags, &fp_offset, &sp_offset, &ip, - ®isters); + &flags, &fp_offset, &sp_offset, + &vra, &mra, ®isters); if (!prompt) scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag)); @@ -1292,8 +1300,8 @@ abort_to_prompt (scm_thread *thread) scm_t_dynstack *captured; captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt)); - cont = capture_delimited_continuation (vp, fp, registers, captured, - thread->vm.registers); + cont = capture_delimited_continuation (vp, fp, saved_mra, registers, + captured, thread->vm.registers); } /* Unwind. */ @@ -1313,13 +1321,18 @@ abort_to_prompt (scm_thread *thread) /* Restore VM regs */ vp->fp = fp; vp->sp = sp; - vp->ip = ip; + vp->ip = vra; /* If there are intervening C frames, then jump over them, making a nonlocal exit. Otherwise fall through and let the VM pick up where it left off. */ if (thread->vm.registers != registers) - longjmp (*registers, 1); + { + vp->mra_after_abort = mra; + longjmp (*registers, 1); + } + + return mra; } static uint32_t * @@ -1422,10 +1435,13 @@ scm_call_n (SCM proc, SCM *argv, size_t nargs) resume = setjmp (registers); if (SCM_UNLIKELY (resume)) { + uint8_t *mcode = vp->mra_after_abort; scm_gc_after_nonlocal_exit (); /* Non-local return. */ if (vp->trace_level) invoke_abort_hook (thread); + if (mcode) + vp->ip = scm_jit_enter_mcode (thread, mcode); } else vp->ip = get_callee_vcode (thread); diff --git a/libguile/vm.h b/libguile/vm.h index 6d6bd4e11..a4dc78029 100644 --- a/libguile/vm.h +++ b/libguile/vm.h @@ -58,6 +58,7 @@ struct scm_vm { SCM overflow_handler_stack; /* alist of max-stack-size -> thunk */ SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */ jmp_buf *registers; /* registers captured at latest vm entry */ + uint8_t *mra_after_abort; /* mra to resume after nonlocal exit, or NULL */ int engine; /* which vm engine we're using */ }; @@ -90,7 +91,9 @@ SCM_INTERNAL void scm_i_vm_free_stack (struct scm_vm *vp); struct scm_vm_cont { /* IP of newest frame. */ - uint32_t *ra; + uint32_t *vra; + /* Machine code corresponding to IP. */ + uint8_t *mra; /* Offset of FP of newest frame, relative to stack top. */ ptrdiff_t fp_offset; /* Besides being the stack size, this is also the offset of the SP of @@ -114,12 +117,6 @@ 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 SCM scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top, - union scm_vm_stack_element *fp, - union scm_vm_stack_element *sp, - uint32_t *ra, - scm_t_dynstack *dynstack, - uint32_t flags); SCM_INTERNAL void scm_i_vm_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,