[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 21/26: compose-continuation uses an intrinsic
From: |
Andy Wingo |
Subject: |
[Guile-commits] 21/26: compose-continuation uses an intrinsic |
Date: |
Tue, 26 Jun 2018 11:26:14 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit b4553dbb02c2e8ef5ca0a9c42aeec6b2087bd6c6
Author: Andy Wingo <address@hidden>
Date: Tue Jun 26 15:10:58 2018 +0200
compose-continuation uses an intrinsic
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add
compose-continuation intrinsic.
* libguile/vm-engine.c (compose-continuation): Call compose-continuation
intrinsic.
* libguile/vm.c (compose_continuation_inner, compose_continuation): Move
down and rename from vm_reinstate_partial_continuation, and make into
a form that works as an intrinsic.
---
libguile/intrinsics.h | 2 +
libguile/vm-engine.c | 5 +-
libguile/vm.c | 159 +++++++++++++++++++++++++-------------------------
3 files changed, 82 insertions(+), 84 deletions(-)
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index aa24241..2022138 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -55,6 +55,7 @@ typedef SCM (*scm_t_scm_from_scm_scm_scmp_sp_intrinsic) (SCM,
SCM, SCM*,
const union
scm_vm_stack_element*);
typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM)
SCM_NORETURN;
typedef SCM (*scm_t_scm_from_thread_regs_intrinsic) (scm_thread*, jmp_buf*);
+typedef void (*scm_t_thread_regs_scm_intrinsic) (scm_thread*, jmp_buf*, SCM);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@@ -107,6 +108,7 @@ typedef SCM (*scm_t_scm_from_thread_regs_intrinsic)
(scm_thread*, jmp_buf*);
M(scm_from_scm_scm_scmp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \
M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!",
REINSTATE_CONTINUATION_X) \
M(scm_from_thread_regs, capture_continuation, "capture-continuation",
CAPTURE_CONTINUATION) \
+ M(thread_regs_scm, compose_continuation, "compose-continuation",
COMPOSE_CONTINUATION) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 3b46a6f..a11d8cd 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -696,10 +696,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int
resume)
vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx);
SYNC_IP ();
- VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
- vm_error_continuation_not_rewindable (vmcont));
- vm_reinstate_partial_continuation (VP, vmcont, FRAME_LOCALS_COUNT_FROM
(1),
- &thread->dynstack, registers);
+ scm_vm_intrinsics.compose_continuation (thread, registers, vmcont);
CACHE_REGISTER ();
NEXT (0);
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 662b3d6..fdf9727 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -323,78 +323,6 @@ vm_abort (struct scm_vm *vp, SCM tag, size_t nargs,
scm_c_abort (vp, tag, nargs, argv, current_registers);
}
-struct vm_reinstate_partial_continuation_data
-{
- struct scm_vm *vp;
- struct scm_vm_cont *cp;
-};
-
-static void *
-vm_reinstate_partial_continuation_inner (void *data_ptr)
-{
- struct vm_reinstate_partial_continuation_data *data = data_ptr;
- struct scm_vm *vp = data->vp;
- struct scm_vm_cont *cp = data->cp;
-
- memcpy (vp->fp - cp->stack_size,
- cp->stack_bottom,
- cp->stack_size * sizeof (*cp->stack_bottom));
-
- vp->fp -= cp->fp_offset;
- vp->ip = cp->ra;
-
- return NULL;
-}
-
-static void
-vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
- scm_t_dynstack *dynstack,
- jmp_buf *registers)
-{
- struct vm_reinstate_partial_continuation_data data;
- struct scm_vm_cont *cp;
- union scm_vm_stack_element *args;
- ptrdiff_t old_fp_offset;
-
- args = alloca (nargs * sizeof (*args));
- memcpy (args, vp->sp, nargs * sizeof (*args));
-
- cp = SCM_VM_CONT_DATA (cont);
-
- old_fp_offset = vp->stack_top - vp->fp;
-
- vm_push_sp (vp, vp->fp - (cp->stack_size + nargs + 1));
-
- data.vp = vp;
- data.cp = cp;
- GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner, &data);
-
- /* The resume continuation will expect ARGS on the stack as if from a
- multiple-value return. Fill in the closure slot with #f, and copy
- the arguments into place. */
- vp->sp[nargs].as_scm = SCM_BOOL_F;
- memcpy (vp->sp, args, nargs * sizeof (*args));
-
- /* The prompt captured a slice of the dynamic stack. Here we wind
- those entries onto the current thread's stack. We also have to
- relocate any prompts that we see along the way. */
- {
- scm_t_bits *walk;
-
- for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
- SCM_DYNSTACK_TAG (walk);
- walk = SCM_DYNSTACK_NEXT (walk))
- {
- scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
-
- if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
- scm_dynstack_wind_prompt (dynstack, walk, old_fp_offset, registers);
- else
- scm_dynstack_wind_1 (dynstack, walk);
- }
- }
-}
-
/*
* VM Error Handling
@@ -412,7 +340,6 @@ static void vm_error_wrong_type_apply (SCM proc)
SCM_NORETURN SCM_NOINLINE;
static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_number_of_values (uint32_t expected) SCM_NORETURN
SCM_NOINLINE;
-static void vm_error_continuation_not_rewindable (SCM cont) SCM_NORETURN
SCM_NOINLINE;
static void
vm_throw (SCM key, SCM args)
@@ -503,12 +430,6 @@ vm_error_wrong_number_of_values (uint32_t expected)
scm_from_uint32 (expected));
}
-static void
-vm_error_continuation_not_rewindable (SCM cont)
-{
- vm_error ("Unrewindable partial continuation", cont);
-}
-
@@ -1274,7 +1195,7 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
"invoking continuation would cross continuation barrier: ~A",
scm_list_1 (cont));
- n = frame_locals_count (thread) - 1,
+ n = frame_locals_count (thread) - 1;
argv = alloca (n * sizeof (*argv));
memcpy (argv, vp->sp, n * sizeof (*argv));
@@ -1312,6 +1233,83 @@ capture_continuation (scm_thread *thread, jmp_buf
*registers)
return scm_i_make_continuation (registers, thread, vm_cont);
}
+struct compose_continuation_data
+{
+ struct scm_vm *vp;
+ struct scm_vm_cont *cp;
+};
+
+static void *
+compose_continuation_inner (void *data_ptr)
+{
+ struct compose_continuation_data *data = data_ptr;
+ struct scm_vm *vp = data->vp;
+ struct scm_vm_cont *cp = data->cp;
+
+ memcpy (vp->fp - cp->stack_size,
+ cp->stack_bottom,
+ cp->stack_size * sizeof (*cp->stack_bottom));
+
+ vp->fp -= cp->fp_offset;
+ vp->ip = cp->ra;
+
+ return NULL;
+}
+
+static void
+compose_continuation (scm_thread *thread, jmp_buf *registers, SCM cont)
+{
+ struct scm_vm *vp = &thread->vm;
+ size_t nargs;
+ struct compose_continuation_data data;
+ struct scm_vm_cont *cp;
+ union scm_vm_stack_element *args;
+ ptrdiff_t old_fp_offset;
+
+ if (SCM_UNLIKELY (! SCM_VM_CONT_REWINDABLE_P (cont)))
+ vm_error ("Unrewindable partial continuation", cont);
+
+ nargs = frame_locals_count (thread) - 1;
+ args = alloca (nargs * sizeof (*args));
+ memcpy (args, vp->sp, nargs * sizeof (*args));
+
+ cp = SCM_VM_CONT_DATA (cont);
+
+ old_fp_offset = vp->stack_top - vp->fp;
+
+ vm_push_sp (vp, vp->fp - (cp->stack_size + nargs + 1));
+
+ data.vp = vp;
+ data.cp = cp;
+ 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. Fill in the closure slot with #f, and copy
+ the arguments into place. */
+ vp->sp[nargs].as_scm = SCM_BOOL_F;
+ memcpy (vp->sp, args, nargs * sizeof (*args));
+
+ /* The prompt captured a slice of the dynamic stack. Here we wind
+ those entries onto the current thread's stack. We also have to
+ relocate any prompts that we see along the way. */
+ {
+ scm_t_bits *walk;
+
+ for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
+ SCM_DYNSTACK_TAG (walk);
+ walk = SCM_DYNSTACK_NEXT (walk))
+ {
+ scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+ if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
+ scm_dynstack_wind_prompt (&thread->dynstack, walk, old_fp_offset,
+ registers);
+ else
+ scm_dynstack_wind_1 (&thread->dynstack, walk);
+ }
+ }
+}
+
SCM
scm_call_n (SCM proc, SCM *argv, size_t nargs)
{
@@ -1657,6 +1655,7 @@ scm_bootstrap_vm (void)
scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame;
scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x;
scm_vm_intrinsics.capture_continuation = capture_continuation;
+ scm_vm_intrinsics.compose_continuation = compose_continuation;
sym_vm_run = scm_from_latin1_symbol ("vm-run");
sym_vm_error = scm_from_latin1_symbol ("vm-error");
- [Guile-commits] 25/26: Optimize abort-to-prompt to avoid alloca, (continued)
- [Guile-commits] 25/26: Optimize abort-to-prompt to avoid alloca, Andy Wingo, 2018/06/26
- [Guile-commits] 15/26: Most header files use forward decl for union scm_vm_stack_element, Andy Wingo, 2018/06/26
- [Guile-commits] 14/26: Add intrinsic for foreign-call, Andy Wingo, 2018/06/26
- [Guile-commits] 11/26: Move VM keyword argument parsing to happen via an intrinsic, Andy Wingo, 2018/06/26
- [Guile-commits] 22/26: Add rest-arg-length intrinsic., Andy Wingo, 2018/06/26
- [Guile-commits] 16/26: Reinstating undelimited continuations uses intrinsic, Andy Wingo, 2018/06/26
- [Guile-commits] 24/26: Refactors to abort-to-prompt implementation, Andy Wingo, 2018/06/26
- [Guile-commits] 12/26: Add push-interrupt-frame VM intrinsic, Andy Wingo, 2018/06/26
- [Guile-commits] 13/26: Give multiple-values objects a tc7, Andy Wingo, 2018/06/26
- [Guile-commits] 26/26: Allow abort_to_prompt to avoid a longjmp, Andy Wingo, 2018/06/26
- [Guile-commits] 21/26: compose-continuation uses an intrinsic,
Andy Wingo <=
- [Guile-commits] 23/26: abort-to-prompt uses an intrinsic, Andy Wingo, 2018/06/26
- [Guile-commits] 19/26: Rename scm_i_thread to scm_thread, Andy Wingo, 2018/06/26
- [Guile-commits] 02/26: Replace uses of scm_t_int8, scm_t_uintmax, etc with stdint types, Andy Wingo, 2018/06/26