[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/13: Continuations capture machine code address
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 07/13: Continuations capture machine code address |
|
Date: |
Sun, 19 Aug 2018 04:44:16 -0400 (EDT) |
wingo pushed a commit to branch lightning
in repository guile.
commit a20feea43e3a8cf2460c254fb65d5e3aed6bd756
Author: Andy Wingo <address@hidden>
Date: Sun Aug 12 15:57:53 2018 +0200
Continuations capture machine code address
* libguile/continuations.c (scm_i_continuation_to_frame): Adapt to vra
field renaming.
(scm_i_reinstate_continuation, grow_stack, copy_stack_and_call)
(scm_dynthrow): Take mra of continuation. Set on the vp before the
longjmp.
* libguile/continuations.h: Update scm_i_reinstate_continuation
prototype.
* libguile/dynstack.h:
* libguile/control.c (scm_suspendable_continuation_p):
* libguile/dynstack.c (PROMPT_WORDS, PROMPT_VRA, PROMPT_MRA):
(PROMPT_JMPBUF, scm_dynstack_push_prompt, scm_dynstack_find_prompt)
(scm_dynstack_wind_prompt): Store both virtual and machine return
addresses on the dynstack, for prompts.
* libguile/eval.c (eval): Pass NULL for mra.
* libguile/intrinsics.c (push_prompt): Add mra arg, and pass it to the
dynstack.
* libguile/intrinsics.h: Update prototypes so that continuation-related
intrinsics can save and restore the MRA.
* libguile/jit.h:
* libguile/jit.c: Return VRA when JIT code needs to tier down.
* libguile/stacks.c (find_prompt, scm_make_stack)
* libguile/throw.c (catch): Adapt find-prompt calls.
* libguile/vm-engine.c (instrument-entry, instrument-loop): Add logic to
continue with vcode after the mcode finishes.
(compose-continuation, capture-continuation, abort, prompt): Add logic
to pass NULL as captured MRA, but continue with mcode from new
continuations, if appropriate.
* libguile/vm.c (scm_i_vm_cont_to_frame, capture_stack)
(scm_i_capture_current_stack, reinstate_continuation_x)
(capture_continuation, compose_continuation_inner, compose_continuation)
(capture_delimited_continuation, abort_to_prompt): Adapt to plumb
around machine code continuations.
(scm_call_n): Check "mra_after_abort" field for machine code
continuation, if any.
* libguile/vm.h (struct scm_vm): Add "mra_after_abort" field.
(struct scm_vm_cont): Rename "ra" field to "vra" and add "mra" field.
---
libguile/continuations.c | 21 ++++++------
libguile/continuations.h | 3 +-
libguile/control.c | 2 +-
libguile/dynstack.c | 25 ++++++++------
libguile/dynstack.h | 4 ++-
libguile/eval.c | 3 +-
libguile/intrinsics.c | 5 +--
libguile/intrinsics.h | 19 ++++++-----
libguile/jit.c | 3 +-
libguile/jit.h | 3 +-
libguile/stacks.c | 4 +--
libguile/throw.c | 2 ++
libguile/vm-engine.c | 50 +++++++++++++++++++++-------
libguile/vm.c | 86 ++++++++++++++++++++++++++++--------------------
libguile/vm.h | 11 +++----
15 files changed, 149 insertions(+), 92 deletions(-)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index c7e008f..479266e 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 8893eef..d83bed9 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 61ead5e..20b3e74 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 0325450..2eec7a7 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 6fc824a..4c32a09 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 589a297..d60b8de 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 3175266..cf4833d 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 877aced..aa2355b 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 69b2021..346e919 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 09e8d1b..34f5751 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 db91208..044e4ce 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 f1f8540..e0149df 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 26ba168..9789fc8 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 d475005..36255b2 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 6d6bd4e..a4dc780 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,
- [Guile-commits] branch lightning updated (0d00164 -> 3827769), Andy Wingo, 2018/08/19
- [Guile-commits] 01/13: Minor optimization in RESET_FRAME, Andy Wingo, 2018/08/19
- [Guile-commits] 04/13: Add unpack-values-object intrinsic, Andy Wingo, 2018/08/19
- [Guile-commits] 03/13: Change call/cc inst to capture-continuation, Andy Wingo, 2018/08/19
- [Guile-commits] 09/13: Update error-wrong-num-args intrinsic prototype, Andy Wingo, 2018/08/19
- [Guile-commits] 02/13: Rework program->ip mapping in VM to always call intrinsic, Andy Wingo, 2018/08/19
- [Guile-commits] 12/13: Define intrinsics for atomic ops, Andy Wingo, 2018/08/19
- [Guile-commits] 07/13: Continuations capture machine code address,
Andy Wingo <=
- [Guile-commits] 05/13: Invoke VM hooks through intrinsics, Andy Wingo, 2018/08/19
- [Guile-commits] 06/13: Rework foreign-call trampoline, Andy Wingo, 2018/08/19
- [Guile-commits] 08/13: Adapt JIT calling convention; continuations take mra from stack, Andy Wingo, 2018/08/19
- [Guile-commits] 11/13: 64-bit intrinsic args and return values passed indirectly on 32-bit, Andy Wingo, 2018/08/19
- [Guile-commits] 10/13: Avoid needless 64-bit args on 32-bit machines for some intrinsics, Andy Wingo, 2018/08/19
- [Guile-commits] 13/13: Add instrumentation to VM builtins, Andy Wingo, 2018/08/19