summaryrefslogtreecommitdiff
path: root/libguile/continuations.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/continuations.c')
-rw-r--r--libguile/continuations.c264
1 files changed, 133 insertions, 131 deletions
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 80914bc04..3f86c6bd4 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,45 +1,59 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
+/* Copyright 1995-1996,1998,2000-2001,2004,2006,2008-2014,2017-2018
+ Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile is free software: you can redistribute it and/or modify it
+ under the terms of the GNU Lesser General Public License as published
+ by the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Guile is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+ License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
+
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
-#include "libguile/_scm.h"
-
#include <assert.h>
#include <string.h>
#include <stdio.h>
-#include "libguile/async.h"
-#include "libguile/debug.h"
-#include "libguile/stackchk.h"
-#include "libguile/smob.h"
-#include "libguile/ports.h"
-#include "libguile/dynstack.h"
-#include "libguile/eval.h"
-#include "libguile/vm.h"
-#include "libguile/instructions.h"
+#if SCM_HAVE_AUXILIARY_STACK
+#include <ucontext.h>
+#endif
+
+#include "async.h"
+#include "backtrace.h"
+#include "boolean.h"
+#include "debug.h"
+#include "dynstack.h"
+#include "eval.h"
+#include "gsubr.h"
+#include "init.h"
+#include "instructions.h"
+#include "jit.h"
+#include "list.h"
+#include "numbers.h"
+#include "pairs.h"
+#include "ports.h"
+#include "smob.h"
+#include "stackchk.h"
+#include "stacks.h"
+#include "symbols.h"
+#include "vm.h"
+
+#include "continuations.h"
-#include "libguile/validate.h"
-#include "libguile/continuations.h"
@@ -62,10 +76,25 @@ static scm_t_bits tc16_continuation;
of that trampoline function.
*/
-static const scm_t_uint32 continuation_stub_code[] =
+struct goto_continuation_code
+{
+ struct scm_jit_function_data data;
+ uint32_t code[3];
+};
+
+struct goto_continuation_code goto_continuation_code = {
{
- SCM_PACK_OP_24 (continuation_call, 0)
- };
+ /* mcode = */ 0,
+ /* counter = */ 0,
+ /* start = */ sizeof (struct scm_jit_function_data),
+ /* end = */ sizeof (struct scm_jit_function_data) + 12
+ },
+ {
+ SCM_PACK_OP_24 (instrument_entry, 0),
+ ((uint32_t) -(sizeof (struct scm_jit_function_data) / 4)),
+ SCM_PACK_OP_24 (continuation_call, 0),
+ }
+};
static SCM
make_continuation_trampoline (SCM contregs)
@@ -75,7 +104,7 @@ make_continuation_trampoline (SCM contregs)
scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
- SCM_SET_CELL_WORD_1 (ret, continuation_stub_code);
+ SCM_SET_CELL_WORD_1 (ret, goto_continuation_code.code);
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs);
return ret;
@@ -110,18 +139,55 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
#endif
-/* this may return more than once: the first time with the escape
- procedure, then subsequently with SCM_UNDEFINED (the vals already having been
- placed on the VM stack). */
-#define FUNC_NAME "scm_i_make_continuation"
+static void
+capture_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+{
+#if SCM_HAVE_AUXILIARY_STACK
+# if !(defined __ia64 or defined __ia64__)
+# error missing auxiliary stack implementation for architecture
+# endif
+ char *top;
+ ucontext_t ctx;
+
+ if (getcontext (&ctx) != 0)
+ abort ();
+
+#if defined __hpux
+ __uc_get_ar_bsp (ctx, (uint64_t *) &top);
+#elif defined linux
+ top = (char *) ctx->uc_mcontext.sc_ar_bsp;
+#elif defined __FreeBSD__
+ top = (char *)(ctx->uc_mcontext.mc_special.bspstore
+ + ctx->uc_mcontext.mc_special.ndirty);
+#else
+#error missing auxiliary stack implementation for ia64 on this OS
+#endif
+
+ continuation->auxiliary_stack_size =
+ top - (char *) thread->auxiliary_stack_base;
+ continuation->auxiliary_stack =
+ scm_gc_malloc (continuation->auxiliary_stack_size,
+ "continuation auxiliary stack");
+ memcpy (continuation->auxiliary_stack, thread->auxiliary_stack_base,
+ continuation->auxiliary_stack_size);
+#endif /* SCM_HAVE_AUXILIARY_STACK */
+}
+
+static void
+restore_auxiliary_stack (scm_thread *thread, scm_t_contregs *continuation)
+{
+#if SCM_HAVE_AUXILIARY_STACK
+ memcpy (thread->auxiliary_stack_base, continuation->auxiliary_stack,
+ continuation->auxiliary_stack_size);
+#endif
+}
+
SCM
-scm_i_make_continuation (int *first, struct scm_vm *vp, SCM vm_cont)
+scm_i_make_continuation (scm_thread *thread, SCM vm_cont)
{
- scm_i_thread *thread = SCM_I_CURRENT_THREAD;
SCM cont;
scm_t_contregs *continuation;
long stack_size;
- const void *saved_cookie;
SCM_STACKITEM * src;
SCM_FLUSH_REGISTER_WINDOWS;
@@ -137,38 +203,14 @@ 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;
+ memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
continuation->vm_cont = vm_cont;
- saved_cookie = vp->resumable_prompt_cookie;
+ capture_auxiliary_stack (thread, continuation);
SCM_NEWSMOB (cont, tc16_continuation, continuation);
- *first = !SCM_I_SETJMP (continuation->jmpbuf);
- if (*first)
- {
-#ifdef __ia64__
- continuation->backing_store_size =
- (char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx)
- -
- (char *) thread->register_backing_store_base;
- continuation->backing_store = NULL;
- continuation->backing_store =
- scm_gc_malloc (continuation->backing_store_size,
- "continuation backing store");
- memcpy (continuation->backing_store,
- (void *) thread->register_backing_store_base,
- continuation->backing_store_size);
-#endif /* __ia64__ */
- return make_continuation_trampoline (cont);
- }
- else
- {
- vp->resumable_prompt_cookie = saved_cookie;
- scm_gc_after_nonlocal_exit ();
- return SCM_UNDEFINED;
- }
+ return make_continuation_trampoline (cont);
}
-#undef FUNC_NAME
int
scm_i_continuation_to_frame (SCM continuation, struct scm_frame *frame)
@@ -186,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;
}
@@ -194,16 +236,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);
}
@@ -222,7 +261,7 @@ scm_i_contregs_vm_cont (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
@@ -234,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);
}
@@ -250,11 +289,11 @@ 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;
- scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+ scm_thread *thread = SCM_I_CURRENT_THREAD;
dynstack = SCM_VM_CONT_DATA (continuation->vm_cont)->dynstack;
@@ -262,40 +301,22 @@ copy_stack_and_call (scm_t_contregs *continuation,
memcpy (dst, continuation->stack,
sizeof (SCM_STACKITEM) * continuation->num_stack_items);
-#ifdef __ia64__
- thread->pending_rbs_continuation = continuation;
-#endif
+ restore_auxiliary_stack (thread, continuation);
scm_dynstack_wind (&thread->dynstack, joint);
- SCM_I_LONGJMP (continuation->jmpbuf, 1);
+ thread->vm.mra_after_abort = mra;
+ longjmp (continuation->jmpbuf, 1);
}
-#ifdef __ia64__
-void
-scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
-{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
-
- if (t->pending_rbs_continuation)
- {
- memcpy (t->register_backing_store_base,
- t->pending_rbs_continuation->backing_store,
- t->pending_rbs_continuation->backing_store_size);
- t->pending_rbs_continuation = NULL;
- }
- setcontext (&JB->ctx);
-}
-#endif
-
/* Call grow_stack until the stack space is large enough, then, as the current
* stack frame might get overwritten, let copy_stack_and_call perform the
* actual copying and continuation calling.
*/
static void
-scm_dynthrow (SCM cont)
+scm_dynthrow (SCM cont, uint8_t *mra)
{
- scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+ scm_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont);
SCM_STACKITEM *dst = thread->continuation_base;
SCM_STACKITEM stack_top_element;
@@ -306,31 +327,18 @@ 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_check_continuation (SCM cont)
+scm_i_reinstate_continuation (SCM cont, uint8_t *mra)
{
- 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);
+ scm_dynthrow (cont, mra);
+ abort (); /* Unreachable. */
}
SCM
@@ -342,7 +350,7 @@ scm_i_with_continuation_barrier (scm_t_catch_body body,
void *pre_unwind_handler_data)
{
SCM_STACKITEM stack_item;
- scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+ scm_thread *thread = SCM_I_CURRENT_THREAD;
SCM old_controot;
SCM_STACKITEM *old_contbase;
SCM result;
@@ -509,11 +517,5 @@ scm_init_continuations ()
{
tc16_continuation = scm_make_smob_type ("continuation", 0);
scm_set_smob_print (tc16_continuation, continuation_print);
-#include "libguile/continuations.x"
+#include "continuations.x"
}
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/