mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Add intrinsic for call/cc

Browse source 
* libguile/intrinsics.h: Add "capture-continuation" intrinsic.
* libguile/vm-engine.c (call/cc): Rework to use capture_continuation
  intrinsic.
* libguile/vm.c (capture_continuation): New intrinsic.
This commit is contained in:
Andy Wingo 2018-06-26 12:01:01 +02:00
parent 5804c977d7
commit ba23bc12fd
3 changed files with 21 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/intrinsics.h
View file

@ -24,6 +24,8 @@
#error intrinsics.h is private and uninstalled
#endif
#include <setjmp.h>
#include <libguile/scm.h>
@ -52,6 +54,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_thread*, uint32_t,
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*);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@ -103,6 +106,7 @@ typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORET
M(thread, push_interrupt_frame, "push-interrupt-frame", PUSH_INTERRUPT_FRAME) \
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) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic

12
libguile/vm-engine.c
View file

@ -756,18 +756,10 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
*/
VM_DEFINE_OP (15, call_cc, "call/cc", OP1 (X32))
{
SCM vm_cont, cont;
scm_t_dynstack *dynstack;
SCM cont;
SYNC_IP ();
dynstack = scm_dynstack_capture_all (&thread->dynstack);
vm_cont = scm_i_vm_capture_stack (VP->stack_top,
SCM_FRAME_DYNAMIC_LINK (VP->fp),
SCM_FRAME_PREVIOUS_SP (VP->fp),
SCM_FRAME_RETURN_ADDRESS (VP->fp),
dynstack,
0);
cont = scm_i_make_continuation (registers, thread, vm_cont);
cont = scm_vm_intrinsics.capture_continuation (thread, registers);
RESET_FRAME (2);

15
libguile/vm.c
View file

@ -1298,6 +1298,20 @@ reinstate_continuation_x (scm_thread *thread, SCM cont)
scm_i_reinstate_continuation (cont);
}
static SCM
capture_continuation (scm_thread *thread, jmp_buf *registers)
{
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_RETURN_ADDRESS (vp->fp),
scm_dynstack_capture_all (&thread->dynstack),
0);
return scm_i_make_continuation (registers, thread, vm_cont);
}
SCM
scm_call_n (SCM proc, SCM *argv, size_t nargs)
{
@ -1642,6 +1656,7 @@ scm_bootstrap_vm (void)
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;
scm_vm_intrinsics.capture_continuation = capture_continuation;
sym_vm_run = scm_from_latin1_symbol ("vm-run");
sym_vm_error = scm_from_latin1_symbol ("vm-error");