diff options
author | Andy Wingo <wingo@pobox.com> | 2018-06-26 10:57:23 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-06-26 11:09:36 +0200 |
commit | 5e8e816c61f99ef1d96ad186d949659bf3aa8853 (patch) | |
tree | da62e39049d3bee7a311757e309428cb20e80b46 | |
parent | 3b6bf20ef5d7d0de34de4fb7ba9777af29ba55ae (diff) | |
download | guile-5e8e816c61f99ef1d96ad186d949659bf3aa8853.tar.gz |
Reinstating undelimited continuations uses intrinsic
* libguile/continuations.h (scm_t_contregs): Remove "struct vm*" member;
unneeded.
* libguile/continuations.c (scm_i_make_continuation): No need to store
continuation->vp.
(scm_i_contregs): New internal function, replaces scm_i_contregs_vp
and scm_i_contregs_vm_cont.
(scm_i_check_continuation): Remove; moved to vm.c.
(scm_i_reinstate_continuation): Add an abort(), to satisfy
SCM_NORETURN.
* libguile/intrinsics.h: Add new "reinstate-continuation!" intrinsic.
* libguile/vm-engine.c (continuation-call): Use new
reinstate-continuation! intrinsic.
* libguile/vm.c (vm_return_to_continuation_inner): Move later in the
file.
(reinstate_continuation_x): New intrinsic.
(scm_bootstrap_vm): Init new intrinsic.
-rw-r--r-- | libguile/continuations.c | 29 | ||||
-rw-r--r-- | libguile/continuations.h | 8 | ||||
-rw-r--r-- | libguile/intrinsics.h | 2 | ||||
-rw-r--r-- | libguile/vm-engine.c | 9 | ||||
-rw-r--r-- | libguile/vm.c | 128 |
5 files changed, 83 insertions, 93 deletions
diff --git a/libguile/continuations.c b/libguile/continuations.c index 6446a565b..c99e0eb43 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -193,7 +193,6 @@ scm_i_make_continuation (int *first, struct scm_vm *vp, SCM vm_cont) #endif continuation->offset = continuation->stack - src; memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size); - continuation->vp = vp; continuation->vm_cont = vm_cont; saved_cookie = vp->resumable_prompt_cookie; capture_auxiliary_stack (thread, continuation); @@ -236,16 +235,13 @@ scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame) return 0; } -struct scm_vm * -scm_i_contregs_vp (SCM contregs) +scm_t_contregs * +scm_i_contregs (SCM contregs) { - return SCM_CONTREGS (contregs)->vp; -} + if (!SCM_CONTREGSP (contregs)) + abort (); -SCM -scm_i_contregs_vm_cont (SCM contregs) -{ - return SCM_CONTREGS (contregs)->vm_cont; + return SCM_CONTREGS (contregs); } @@ -336,24 +332,11 @@ scm_dynthrow (SCM cont) copy_stack_and_call (continuation, dst); } - -void -scm_i_check_continuation (SCM cont) -{ - scm_i_thread *thread = SCM_I_CURRENT_THREAD; - scm_t_contregs *continuation = SCM_CONTREGS (cont); - - if (!scm_is_eq (continuation->root, thread->continuation_root)) - scm_misc_error - ("%continuation-call", - "invoking continuation would cross continuation barrier: ~A", - scm_list_1 (cont)); -} - void scm_i_reinstate_continuation (SCM cont) { scm_dynthrow (cont); + abort (); /* Unreachable. */ } SCM diff --git a/libguile/continuations.h b/libguile/continuations.h index a9ab5eae8..6b52f2649 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -49,7 +49,6 @@ typedef struct #endif size_t num_stack_items; /* size of the saved stack. */ SCM root; /* continuation root identifier. */ - struct scm_vm *vp; /* vm */ SCM vm_cont; /* vm's stack and regs */ /* The offset from the live stack location to this copy. This is @@ -71,15 +70,12 @@ typedef struct SCM_INTERNAL SCM scm_i_make_continuation (int *first, struct scm_vm *vp, SCM vm_cont); -SCM_INTERNAL void scm_i_check_continuation (SCM cont); -SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont); +SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont) SCM_NORETURN; -struct scm_frame; SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont, struct scm_frame *frame); -SCM_INTERNAL struct scm_vm* scm_i_contregs_vp (SCM contregs); -SCM_INTERNAL SCM scm_i_contregs_vm_cont (SCM contregs); +SCM_INTERNAL scm_t_contregs* scm_i_contregs (SCM contregs); SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *); SCM_API SCM scm_with_continuation_barrier (SCM proc); diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index df1551529..5b183a62c 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -52,6 +52,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_i_thread*, uint32_ uint8_t); typedef SCM (*scm_t_scm_from_scm_scm_intp_sp_intrinsic) (SCM, SCM, int*, const union scm_vm_stack_element*); +typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_i_thread*, SCM) SCM_NORETURN; #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -102,6 +103,7 @@ typedef SCM (*scm_t_scm_from_scm_scm_intp_sp_intrinsic) (SCM, SCM, int*, M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \ M(thread, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \ M(scm_from_scm_scm_intp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \ + M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \ /* 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 8e863827d..dcbd96eb0 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -650,7 +650,7 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int resume) ALLOC_FRAME (3); SP_SET (1, ret); - SP_SET (0, scm_from_int (err)); + SP_SET (0, scm_vm_intrinsics.s64_to_scm (err)); NEXT (1); } @@ -674,12 +674,7 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int resume) SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx); SYNC_IP (); - scm_i_check_continuation (contregs); - vm_return_to_continuation (scm_i_contregs_vp (contregs), - scm_i_contregs_vm_cont (contregs), - FRAME_LOCALS_COUNT_FROM (1), - sp); - scm_i_reinstate_continuation (contregs); + scm_vm_intrinsics.reinstate_continuation_x (thread, contregs); /* no NEXT */ abort (); diff --git a/libguile/vm.c b/libguile/vm.c index bafdcf26a..b3a680f47 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -182,63 +182,6 @@ scm_i_vm_capture_stack (union scm_vm_stack_element *stack_top, return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p); } -struct return_to_continuation_data -{ - struct scm_vm_cont *cp; - struct scm_vm *vp; -}; - -/* Called with the GC lock to prevent the stack marker from traversing a - stack in an inconsistent state. */ -static void * -vm_return_to_continuation_inner (void *data_ptr) -{ - struct return_to_continuation_data *data = data_ptr; - struct scm_vm *vp = data->vp; - struct scm_vm_cont *cp = data->cp; - - /* We know that there is enough space for the continuation, because we - captured it in the past. However there may have been an expansion - 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)); - vp->fp = vp->stack_top - cp->fp_offset; - vm_restore_sp (vp, vp->stack_top - cp->stack_size); - - return NULL; -} - -static void -vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n, - union scm_vm_stack_element *argv) -{ - struct scm_vm_cont *cp; - union scm_vm_stack_element *argv_copy; - struct return_to_continuation_data data; - - argv_copy = alloca (n * sizeof (*argv)); - memcpy (argv_copy, argv, n * sizeof (*argv)); - - cp = SCM_VM_CONT_DATA (cont); - - data.cp = cp; - data.vp = vp; - GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data); - - /* Now we have the continuation properly copied over. We just need to - copy on an empty frame and the return values, as the continuation - expects. */ - vm_push_sp (vp, vp->sp - 3 - n); - vp->sp[n+2].as_scm = SCM_BOOL_F; - vp->sp[n+1].as_scm = SCM_BOOL_F; - vp->sp[n].as_scm = SCM_BOOL_F; - memcpy(vp->sp, argv_copy, n * sizeof (union scm_vm_stack_element)); - - vp->ip = cp->ra; -} - SCM scm_i_capture_current_stack (void) { @@ -1285,6 +1228,76 @@ push_interrupt_frame (scm_i_thread *thread) SCM_FRAME_LOCAL (thread->vm.fp, 0) = proc; } +struct return_to_continuation_data +{ + struct scm_vm_cont *cp; + struct scm_vm *vp; +}; + +/* Called with the GC lock to prevent the stack marker from traversing a + stack in an inconsistent state. */ +static void * +vm_return_to_continuation_inner (void *data_ptr) +{ + struct return_to_continuation_data *data = data_ptr; + struct scm_vm *vp = data->vp; + struct scm_vm_cont *cp = data->cp; + + /* We know that there is enough space for the continuation, because we + captured it in the past. However there may have been an expansion + 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)); + vp->fp = vp->stack_top - cp->fp_offset; + vm_restore_sp (vp, vp->stack_top - cp->stack_size); + + return NULL; +} + +static void reinstate_continuation_x (scm_i_thread *thread, SCM cont) SCM_NORETURN; + +static void +reinstate_continuation_x (scm_i_thread *thread, SCM cont) +{ + scm_t_contregs *continuation = scm_i_contregs (cont); + struct scm_vm *vp = &thread->vm; + struct scm_vm_cont *cp; + size_t n; + union scm_vm_stack_element *argv; + struct return_to_continuation_data data; + + if (!scm_is_eq (continuation->root, thread->continuation_root)) + scm_misc_error + ("%continuation-call", + "invoking continuation would cross continuation barrier: ~A", + scm_list_1 (cont)); + + n = frame_locals_count (thread) - 1, + argv = alloca (n * sizeof (*argv)); + memcpy (argv, vp->sp, n * sizeof (*argv)); + + cp = SCM_VM_CONT_DATA (continuation->vm_cont); + + data.cp = cp; + data.vp = vp; + GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data); + + /* Now we have the continuation properly copied over. We just need to + copy on an empty frame and the return values, as the continuation + expects. */ + vm_push_sp (vp, vp->sp - 3 - n); + vp->sp[n+2].as_scm = SCM_BOOL_F; + vp->sp[n+1].as_scm = SCM_BOOL_F; + vp->sp[n].as_scm = SCM_BOOL_F; + memcpy(vp->sp, argv, n * sizeof (union scm_vm_stack_element)); + + vp->ip = cp->ra; + + scm_i_reinstate_continuation (cont); +} + SCM scm_call_n (SCM proc, SCM *argv, size_t nargs) { @@ -1628,6 +1641,7 @@ scm_bootstrap_vm (void) scm_vm_intrinsics.compute_kwargs_npositional = compute_kwargs_npositional; scm_vm_intrinsics.bind_kwargs = bind_kwargs; scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame; + scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x; sym_vm_run = scm_from_latin1_symbol ("vm-run"); sym_vm_error = scm_from_latin1_symbol ("vm-error"); |