[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-7-54-gd88
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-7-54-gd8873df |
|
Date: |
Tue, 09 Feb 2010 08:22:42 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=d8873dfe4754daf031a6709738bd31afa8edb443
The branch, master has been updated
via d8873dfe4754daf031a6709738bd31afa8edb443 (commit)
via 269479e31f70d40a82b75be87c1b2a7363c85696 (commit)
via 997659f898d94abccdcba3c444b84e3c6f6e963e (commit)
via babfc7b2c3fce452aa12fed8d89cd3fbc81e8cc8 (commit)
via 1d1cae0e2e063d9a36e7d600f87cf3d6eaf940f3 (commit)
via 217167c6b2e6e400306c8cb4a0bff86c17eef28c (commit)
via adaf86ec49959f6df55947cf69ac98d6bf1074f7 (commit)
from 69f90b0b051e77257a753f1ee7ae6a18a1147c78 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit d8873dfe4754daf031a6709738bd31afa8edb443
Author: Andy Wingo <address@hidden>
Date: Mon Feb 8 22:59:25 2010 +0100
continuations return multiple values on the stack
* libguile/vm.h (struct scm_vm_cont): Instead of saving the "IP", save
"RA" and "MVRA". That is, save singly-valued and multiply-valued
return addresses, so that we can return multiple values on the stack.
(scm_i_vm_reinstate_continuation): Remove.
* libguile/vm.c (vm_capture_continuation): Rename from capture_vm_cont,
and change the prototype so we can capture the RA and MVRA, and so
that tail calls to call/cc can capture a continuation without the
call/cc application frame.
(vm_return_to_continuation): Rename from reinstate_vm_cont, and take
arguments to return to the continuation. Handles returning to single
or multiple-value RA.
(scm_i_vm_capture_continuation): Change to invoke
vm_capture_continuation. Kept around for the benefit of make-stack.
* libguile/vm-i-system.c (continuation-call): Handle reinstatement of
the VM stack, with arguments.
(call/cc, tail-call/cc): Adapt to new vm_capture_continuation
prototype. tail-call/cc captures tail continuations.
* libguile/stacks.c (scm_make_stack): Update for scm_vm_cont structure
change.
* libguile/continuations.h (struct scm_contregs): Remove throw_value
member, which was used to return a value to a continuation.
(scm_i_check_continuation): New internal function, checks that a
continuation may be reinstated.
(scm_i_reinstate_continuation): Replaces scm_i_continuation_call; just
reinstates the C stack.
(scm_i_contregs_vm, scm_i_contregs_vm_cont): New internal accessors.
* libguile/continuations.c (scm_i_make_continuation): Return
SCM_UNDEFINED if we are returning again.
(grow_stack, copy_stack_and_call, scm_dynthrow): Remove extra arg, as
vm opcodes handle value returns.
(copy_stack): No need to instate VM continuation.
(scm_i_reinstate_continuation): Adapt.
commit 269479e31f70d40a82b75be87c1b2a7363c85696
Author: Andy Wingo <address@hidden>
Date: Sun Feb 7 14:50:51 2010 +0100
scm_i_make_continuation takes vm and vm_cont args explicitly
* libguile/continuations.h:
* libguile/continuations.c (scm_i_make_continuation): Take VM and VM
continuation arguments as well; I'm not convinced that saving all VM
continuations was the right thing, and in any case we only ever saved
the latest. Running a new VM should create a continuation barrier.
* libguile/stacks.c (scm_make_stack):
* libguile/vm-i-system.c (call/cc, tail-call/cc): Adapt callers.
* libguile/vm.h (scm_i_vm_capture_continuation)
(scm_i_vm_reinstate_continuation): Change to be internal, and to only
capture and reinstate continuations for a particular VM.
commit 997659f898d94abccdcba3c444b84e3c6f6e963e
Author: Andy Wingo <address@hidden>
Date: Sun Feb 7 14:16:54 2010 +0100
make scm_make_continuation internal
* libguile/continuations.h:
* libguile/continuations.c (scm_i_make_continuation): Change from
scm_make_continuation, and make internal.
* libguile/vm-i-system.c (call/cc, tail-call/cc): Adapt callers.
* test-suite/standalone/test-unwind.c (check_cont_body): Adapt a test.
* doc/ref/api-control.texi (Continuations): Update docs.
commit babfc7b2c3fce452aa12fed8d89cd3fbc81e8cc8
Author: Andy Wingo <address@hidden>
Date: Mon Feb 8 13:33:21 2010 +0100
eval.c uses scm_i_call_with_current_continuation
* libguile/continuations.h
* libguile/continuations.c (scm_i_call_with_current_continuation): New
internal function. Not exported because I'm not sure whether or not
this should have a continuation barrier in the future. Uses a
hand-coded VM procedure.
* libguile/eval.c (eval): Use scm_i_call_with_current_continuation.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-control.texi | 9 -
libguile/continuations.c | 245 +++++++++++++++++++++++++-----
libguile/continuations.h | 31 ++--
libguile/control.c | 31 ++++
libguile/control.h | 28 ++++
libguile/eval.c | 16 +--
libguile/programs.c | 9 +-
libguile/programs.h | 6 +-
libguile/stacks.c | 38 +----
libguile/tags.h | 2 +-
libguile/vm-i-system.c | 82 ++++++-----
libguile/vm.c | 120 +++++++++------
libguile/vm.h | 6 +-
module/language/tree-il/compile-glil.scm | 4 +-
test-suite/standalone/test-unwind.c | 6 +-
15 files changed, 421 insertions(+), 212 deletions(-)
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index b220355..c76bdfe 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -410,15 +410,6 @@ invoke that continuation.
This is in common use since the latter is rather long.
@end deffn
address@hidden {C Function} SCM scm_make_continuation (int *first)
-Capture the current continuation as described above. The return value
-is the new continuation, and @var{*first} is set to 1.
-
-When the continuation is invoked, @code{scm_make_continuation} will
-return again, this time returning the value (or set of multiple
-values) passed in that invocation, and with @var{*first} set to 0.
address@hidden deftypefn
-
@sp 1
@noindent
Here is a simple example,
diff --git a/libguile/continuations.c b/libguile/continuations.c
index aeff62e..118c0b6 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010 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
@@ -34,19 +34,141 @@
#include "libguile/smob.h"
#include "libguile/ports.h"
#include "libguile/dynwind.h"
-#include "libguile/values.h"
#include "libguile/eval.h"
#include "libguile/vm.h"
+#include "libguile/instructions.h"
#include "libguile/validate.h"
#include "libguile/continuations.h"
-/* {Continuations}
+static scm_t_bits tc16_continuation;
+#define SCM_CONTREGSP(x) SCM_TYP16_PREDICATE (tc16_continuation, x)
+
+#define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_SMOB_DATA_1 (x))
+
+#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
+#define SCM_SET_CONTINUATION_LENGTH(x, n)\
+ (SCM_CONTREGS (x)->num_stack_items = (n))
+#define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
+#define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv)
+#define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)
+#define SCM_DFRAME(x) ((SCM_CONTREGS (x))->dframe)
+
+
+
+/* scm_i_make_continuation will return a procedure whose objcode contains an
+ instruction to reinstate the continuation. Here, as in gsubr.c and smob.c,
we
+ define the form of that trampoline function.
*/
-scm_t_bits scm_tc16_continuation;
+#ifdef WORDS_BIGENDIAN
+#define OBJCODE_HEADER(main,meta) 0, 0, 0, main, 0, 0, 0, meta+8
+#define META_HEADER(meta) 0, 0, 0, meta, 0, 0, 0, 0
+#else
+#define OBJCODE_HEADER(main,meta) main, 0, 0, 0, meta+8, 0, 0, 0
+#define META_HEADER(meta) meta, 0, 0, 0, 0, 0, 0, 0
+#endif
+
+#define ROUND_UP(len,align) (((len-1)|(align-1))+1)
+#define ALIGN_PTR(type,p,align) (type*)(ROUND_UP (((scm_t_bits)p), align))
+
+#ifdef SCM_ALIGNED
+#define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym)\
+static const type sym[]
+#define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym)\
+static SCM_ALIGNED (alignment) const type sym[]
+#else
+#define SCM_DECLARE_STATIC_ALIGNED_ARRAY(type, sym)\
+static type *sym
+#define SCM_STATIC_ALIGNED_ARRAY(alignment, type, sym) \
+SCM_SNARF_INIT(sym = scm_malloc (sizeof(sym##__unaligned) + alignment - 1); \
+ sym = ALIGN_PTR (type, sym, alignment); \
+ memcpy (sym, sym##__unaligned, sizeof(sym##__unaligned));) \
+static type *sym = NULL; \
+static const type sym##__unaligned[]
+#endif
+
+#define STATIC_OBJCODE_TAG \
+ SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+
+#define SCM_STATIC_OBJCODE(sym) \
+ SCM_DECLARE_STATIC_ALIGNED_ARRAY (scm_t_uint8, sym##__bytecode); \
+ SCM_STATIC_ALIGNED_ARRAY (8, scm_t_cell, sym##__cells) = { \
+ { STATIC_OBJCODE_TAG, SCM_PACK (sym##__bytecode) }, \
+ { SCM_BOOL_F, SCM_PACK (0) } \
+ }; \
+ static const SCM sym = SCM_PACK (sym##__cells); \
+ SCM_STATIC_ALIGNED_ARRAY (8, scm_t_uint8, sym##__bytecode)
+
+
+SCM_STATIC_OBJCODE (cont_objcode) = {
+ /* This code is the same as in gsubr.c, except we use smob_call instead of
+ struct_call. */
+ OBJCODE_HEADER (8, 19),
+ /* leave args on the stack */
+ /* 0 */ scm_op_object_ref, 0, /* push scm_t_contregs smob */
+ /* 2 */ scm_op_continuation_call, /* and longjmp (whee) */
+ /* 3 */ scm_op_nop, /* pad to 8 bytes */
+ /* 4 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop,
+ /* 8 */
+
+ /* We could put some meta-info to say that this proc is a continuation. Not
sure
+ how to do that, though. */
+ META_HEADER (19),
+ /* 0 */ scm_op_make_eol, /* bindings */
+ /* 1 */ scm_op_make_eol, /* sources */
+ /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 3, /* arity: from ip 0 to ip
3 */
+ /* 6 */ scm_op_make_int8_0, /* the arity is 0 required args */
+ /* 7 */ scm_op_make_int8_0, /* 0 optionals */
+ /* 8 */ scm_op_make_true, /* and a rest arg */
+ /* 9 */ scm_op_list, 0, 5, /* make a list of those 5 vals */
+ /* 12 */ scm_op_list, 0, 1, /* and the arities will be a list of that one
list */
+ /* 15 */ scm_op_list, 0, 3, /* pack bindings, sources, and arities into list
*/
+ /* 18 */ scm_op_return /* and return */
+ /* 19 */
+};
+
+
+SCM_STATIC_OBJCODE (call_cc_objcode) = {
+ /* Before Scheme's call/cc is compiled, eval.c will use this hand-coded
+ call/cc. */
+ OBJCODE_HEADER (8, 17),
+ /* 0 */ scm_op_assert_nargs_ee, 0, 1, /* assert that nargs==1 */
+ /* 3 */ scm_op_local_ref, 0, /* push the proc */
+ /* 5 */ scm_op_tail_call_cc, /* and call/cc */
+ /* 6 */ scm_op_nop, scm_op_nop, /* pad to 8 bytes */
+ /* 8 */
+
+ META_HEADER (17),
+ /* 0 */ scm_op_make_eol, /* bindings */
+ /* 1 */ scm_op_make_eol, /* sources */
+ /* 2 */ scm_op_make_int8, 3, scm_op_make_int8, 6, /* arity: from ip 0 to ip
6 */
+ /* 6 */ scm_op_make_int8_1, /* the arity is 0 required args */
+ /* 7 */ scm_op_list, 0, 3, /* make a list of those 5 vals */
+ /* 10 */ scm_op_list, 0, 1, /* and the arities will be a list of that one
list */
+ /* 13 */ scm_op_list, 0, 3, /* pack bindings, sources, and arities into list
*/
+ /* 16 */ scm_op_return /* and return */
+ /* 17 */
+};
+
+
+static SCM
+make_continuation_trampoline (SCM contregs)
+{
+ SCM ret = scm_make_program (cont_objcode,
+ scm_c_make_vector (1, contregs),
+ SCM_BOOL_F);
+ SCM_SET_CELL_WORD_0 (ret,
+ SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_CONTINUATION);
+
+ return ret;
+}
+
+
+/* {Continuations}
+ */
static int
@@ -63,11 +185,11 @@ continuation_print (SCM obj, SCM port, scm_print_state
*state SCM_UNUSED)
}
/* this may return more than once: the first time with the escape
- procedure, then subsequently with the value to be passed to the
- continuation. */
-#define FUNC_NAME "scm_make_continuation"
+ procedure, then subsequently with SCM_UNDEFINED (the vals already having
been
+ placed on the VM stack). */
+#define FUNC_NAME "scm_i_make_continuation"
SCM
-scm_make_continuation (int *first)
+scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
{
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
SCM cont;
@@ -82,7 +204,6 @@ scm_make_continuation (int *first)
"continuation");
continuation->num_stack_items = stack_size;
continuation->dynenv = scm_i_dynwinds ();
- continuation->throw_value = SCM_EOL;
continuation->root = thread->continuation_root;
src = thread->continuation_base;
#if ! SCM_STACK_GROWS_UP
@@ -90,9 +211,10 @@ scm_make_continuation (int *first)
#endif
continuation->offset = continuation->stack - src;
memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
- continuation->vm_conts = scm_vm_capture_continuations ();
+ continuation->vm = vm;
+ continuation->vm_cont = vm_cont;
- SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
+ SCM_NEWSMOB (cont, tc16_continuation, continuation);
*first = !SCM_I_SETJMP (continuation->jmpbuf);
if (*first)
@@ -110,18 +232,62 @@ scm_make_continuation (int *first)
(void *) thread->register_backing_store_base,
continuation->backing_store_size);
#endif /* __ia64__ */
- return cont;
+ return make_continuation_trampoline (cont);
}
else
+ return SCM_UNDEFINED;
+}
+#undef FUNC_NAME
+
+SCM
+scm_i_call_with_current_continuation (SCM proc)
+{
+ static SCM call_cc = SCM_BOOL_F;
+
+ if (scm_is_false (call_cc))
+ call_cc = scm_make_program (call_cc_objcode, SCM_BOOL_F, SCM_BOOL_F);
+
+ return scm_call_1 (call_cc, proc);
+}
+
+SCM
+scm_i_continuation_to_frame (SCM continuation)
+{
+ SCM contregs;
+ scm_t_contregs *cont;
+
+ contregs = scm_c_vector_ref (scm_program_objects (continuation), 0);
+ cont = SCM_CONTREGS (contregs);
+
+ if (scm_is_true (cont->vm_cont))
{
- SCM ret = continuation->throw_value;
- continuation->throw_value = SCM_BOOL_F;
- return ret;
+ struct scm_vm_cont *data = SCM_VM_CONT_DATA (cont->vm_cont);
+ return scm_c_make_frame (cont->vm_cont,
+ data->fp + data->reloc,
+ data->sp + data->reloc,
+ data->ra,
+ data->reloc);
}
+ else
+ return SCM_BOOL_F;
+}
+
+SCM
+scm_i_contregs_vm (SCM contregs)
+{
+ return SCM_CONTREGS (contregs)->vm;
+}
+
+SCM
+scm_i_contregs_vm_cont (SCM contregs)
+{
+ return SCM_CONTREGS (contregs)->vm_cont;
}
-#undef FUNC_NAME
+/* {Apply}
+ */
+
/* Invoking a continuation proceeds as follows:
*
* - the stack is made large enough for the called continuation
@@ -134,7 +300,7 @@ scm_make_continuation (int *first)
* with their correct stack.
*/
-static void scm_dynthrow (SCM, SCM);
+static void scm_dynthrow (SCM);
/* Grow the stack by a fixed amount to provide space to copy in the
* continuation. Possibly this function has to be called several times
@@ -146,12 +312,12 @@ static void scm_dynthrow (SCM, SCM);
scm_t_bits scm_i_dummy;
static void
-grow_stack (SCM cont, SCM val)
+grow_stack (SCM cont)
{
scm_t_bits growth[100];
scm_i_dummy = (scm_t_bits) growth;
- scm_dynthrow (cont, val);
+ scm_dynthrow (cont);
}
@@ -171,14 +337,13 @@ copy_stack (void *data)
copy_stack_data *d = (copy_stack_data *)data;
memcpy (d->dst, d->continuation->stack,
sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
- scm_vm_reinstate_continuations (d->continuation->vm_conts);
#ifdef __ia64__
SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
#endif
}
static void
-copy_stack_and_call (scm_t_contregs *continuation, SCM val,
+copy_stack_and_call (scm_t_contregs *continuation,
SCM_STACKITEM * dst)
{
long delta;
@@ -189,7 +354,6 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
data.dst = dst;
scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
- continuation->throw_value = val;
SCM_I_LONGJMP (continuation->jmpbuf, 1);
}
@@ -215,7 +379,7 @@ scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
* actual copying and continuation calling.
*/
static void
-scm_dynthrow (SCM cont, SCM val)
+scm_dynthrow (SCM cont)
{
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont);
@@ -230,36 +394,36 @@ scm_dynthrow (SCM cont, SCM val)
#if SCM_STACK_GROWS_UP
if (dst + continuation->num_stack_items >= &stack_top_element)
- grow_stack (cont, val);
+ grow_stack (cont);
#else
dst -= continuation->num_stack_items;
if (dst <= &stack_top_element)
- grow_stack (cont, val);
+ grow_stack (cont);
#endif /* def SCM_STACK_GROWS_UP */
SCM_FLUSH_REGISTER_WINDOWS;
- copy_stack_and_call (continuation, val, dst);
+ copy_stack_and_call (continuation, dst);
}
-static SCM
-continuation_apply (SCM cont, SCM args)
-#define FUNC_NAME "continuation_apply"
+void
+scm_i_check_continuation (SCM cont)
{
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont);
if (continuation->root != thread->continuation_root)
- {
- SCM_MISC_ERROR
- ("invoking continuation would cross continuation barrier: ~A",
- scm_list_1 (cont));
- }
-
- scm_dynthrow (cont, scm_values (args));
- return SCM_UNSPECIFIED; /* not reached */
+ 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);
}
-#undef FUNC_NAME
SCM
scm_i_with_continuation_barrier (scm_t_catch_body body,
@@ -374,9 +538,8 @@ SCM_DEFINE (scm_with_continuation_barrier,
"with-continuation-barrier", 1,0,0,
void
scm_init_continuations ()
{
- scm_tc16_continuation = scm_make_smob_type ("continuation", 0);
- scm_set_smob_print (scm_tc16_continuation, continuation_print);
- scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1);
+ tc16_continuation = scm_make_smob_type ("continuation", 0);
+ scm_set_smob_print (tc16_continuation, continuation_print);
#include "libguile/continuations.x"
}
diff --git a/libguile/continuations.h b/libguile/continuations.h
index a04c53f..e0a4556 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -3,7 +3,7 @@
#ifndef SCM_CONTINUATIONS_H
#define SCM_CONTINUATIONS_H
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010 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
@@ -31,6 +31,9 @@
#endif /* __ia64__ */
+#define SCM_CONTINUATIONP(x) \
+ (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_CONTINUATION (x))
+
/* a continuation SCM is a non-immediate pointing to a heap cell with:
word 0: bits 0-15: smob type tag: scm_tc16_continuation.
bits 16-31: unused.
@@ -39,11 +42,8 @@
in the num_stack_items field of the structure.
*/
-SCM_API scm_t_bits scm_tc16_continuation;
-
typedef struct
{
- SCM throw_value;
scm_i_jmp_buf jmpbuf;
SCM dynenv;
#ifdef __ia64__
@@ -52,7 +52,8 @@ typedef struct
#endif /* __ia64__ */
size_t num_stack_items; /* size of the saved stack. */
SCM root; /* continuation root identifier. */
- SCM vm_conts; /* vm continuations (they use separate stacks) */
+ SCM vm; /* vm */
+ SCM vm_cont; /* vm's stack and regs */
/* The offset from the live stack location to this copy. This is
used to adjust pointers from within the copied stack to the stack
@@ -67,22 +68,18 @@ typedef struct
SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
} scm_t_contregs;
-#define SCM_CONTINUATIONP(x) SCM_TYP16_PREDICATE (scm_tc16_continuation, x)
-#define SCM_CONTREGS(x) ((scm_t_contregs *) SCM_SMOB_DATA_1 (x))
+
-#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
-#define SCM_SET_CONTINUATION_LENGTH(x, n)\
- (SCM_CONTREGS (x)->num_stack_items = (n))
-#define SCM_JMPBUF(x) ((SCM_CONTREGS (x))->jmpbuf)
-#define SCM_DYNENV(x) ((SCM_CONTREGS (x))->dynenv)
-#define SCM_THROW_VALUE(x) ((SCM_CONTREGS (x))->throw_value)
-#define SCM_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)
-#define SCM_DFRAME(x) ((SCM_CONTREGS (x))->dframe)
+SCM_INTERNAL SCM scm_i_make_continuation (int *first, SCM vm, SCM vm_cont);
+SCM_INTERNAL void scm_i_check_continuation (SCM cont);
+SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont);
-
+SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
-SCM_API SCM scm_make_continuation (int *first);
+SCM_INTERNAL SCM scm_i_continuation_to_frame (SCM cont);
+SCM_INTERNAL SCM scm_i_contregs_vm (SCM contregs);
+SCM_INTERNAL SCM scm_i_contregs_vm_cont (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/control.c b/libguile/control.c
index 66bb5f8..bcbc6a1 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -22,6 +22,7 @@
#include "libguile/_scm.h"
#include "libguile/control.h"
+#include "libguile/vm.h"
@@ -47,6 +48,36 @@ SCM_DEFINE (scm_atprompt, "@prompt", 4, 0, 0,
}
#undef FUNC_NAME
+SCM
+scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
+ scm_t_uint8 inline_p, scm_t_uint8 escape_only_p)
+{
+ scm_t_bits tag;
+ SCM ret;
+ struct scm_prompt_registers *regs;
+
+ tag = scm_tc7_prompt;
+ if (inline_p)
+ tag |= SCM_F_PROMPT_INLINE;
+ if (escape_only_p)
+ tag |= SCM_F_PROMPT_ESCAPE;
+ ret = scm_words (tag, 6);
+
+ regs = scm_gc_malloc_pointerless (sizeof (*regs), "prompt registers");
+ regs->fp = SCM_VM_DATA (vm)->fp;
+ regs->sp = SCM_VM_DATA (vm)->sp;
+ regs->ip = SCM_VM_DATA (vm)->ip;
+
+ SCM_SET_CELL_OBJECT (ret, 1, k);
+ SCM_SET_CELL_WORD (ret, 2, (scm_t_bits)regs);
+ SCM_SET_CELL_OBJECT (ret, 3, scm_i_dynwinds ());
+ SCM_SET_CELL_OBJECT (ret, 4, handler);
+ SCM_SET_CELL_OBJECT (ret, 5, pre_unwind);
+
+ return ret;
+}
+
+
static void
diff --git a/libguile/control.h b/libguile/control.h
index 8354c7e..b498562 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -20,6 +20,34 @@
#define SCM_CONTROL_H
+#define SCM_F_PROMPT_INLINE 0x1
+#define SCM_F_PROMPT_ESCAPE 0x2
+
+#define SCM_PROMPT_P(x) (!SCM_IMP (x) && SCM_TYP7(x) ==
scm_tc7_prompt)
+#define SCM_PROMPT_FLAGS(x) (SCM_CELL_WORD ((x), 0) >> 8)
+#define SCM_PROMPT_INLINE_P(x) (SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_INLINE)
+#define SCM_PROMPT_ESCAPE_P(x) (SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
+#define SCM_PROMPT_TAG(x) (SCM_CELL_OBJECT ((x), 1)
+#define SCM_PROMPT_REGISTERS(x) ((struct
scm_prompt_registers*)SCM_CELL_WORD ((x), 2))
+#define SCM_PROMPT_DYNENV(x) (SCM_CELL_OBJECT ((x), 3))
+#define SCM_PROMPT_HANDLER(x) (SCM_CELL_OBJECT ((x), 4))
+#define SCM_PROMPT_PRE_UNWIND_HANDLER(x) (SCM_CELL_OBJECT ((x), 5))
+
+#define SCM_PROMPT_SETJMP(p) (SCM_I_SETJMP (SCM_PROMPT_REGISTERS (p)->regs))
+
+struct scm_prompt_registers
+{
+ scm_t_uint8 *ip;
+ SCM *sp;
+ SCM *fp;
+ scm_i_jmp_buf regs;
+};
+
+
+SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
+ scm_t_uint8 inline_p, scm_t_uint8
escape_only_p);
+
+
SCM_INTERNAL void scm_register_control (void);
diff --git a/libguile/eval.c b/libguile/eval.c
index 65103a1..6cfe438 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
+/* Copyright (C)
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -295,19 +295,7 @@ eval (SCM x, SCM env)
}
case SCM_M_CONT:
- {
- int first;
- SCM val = scm_make_continuation (&first);
-
- if (!first)
- return val;
- else
- {
- proc = eval (mx, env);
- args = scm_list_1 (val);
- goto apply_proc;
- }
- }
+ return scm_i_call_with_current_continuation (eval (mx, env));
case SCM_M_CALL_WITH_VALUES:
{
diff --git a/libguile/programs.c b/libguile/programs.c
index 189b64e..ac35e3c 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -79,7 +79,14 @@ scm_i_program_print (SCM program, SCM port, scm_print_state
*pstate)
(scm_c_resolve_module ("system vm program"),
scm_from_locale_symbol ("write-program"));
- if (scm_is_false (write_program) || print_error)
+ if (SCM_PROGRAM_IS_CONTINUATION (program))
+ {
+ /* twingliness */
+ scm_puts ("#<continuation ", port);
+ scm_uintprint (SCM_CELL_WORD_1 (program), 16, port);
+ scm_putc ('>', port);
+ }
+ else if (scm_is_false (write_program) || print_error)
{
scm_puts ("#<program ", port);
scm_uintprint (SCM_CELL_WORD_1 (program), 16, port);
diff --git a/libguile/programs.h b/libguile/programs.h
index 1545734..2611550 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -27,8 +27,9 @@
*/
#define SCM_F_PROGRAM_IS_BOOT 0x100
-#define SCM_F_PROGRAM_IS_PRIMITIVE 0x100
-#define SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC 0x200
+#define SCM_F_PROGRAM_IS_PRIMITIVE 0x200
+#define SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC 0x400
+#define SCM_F_PROGRAM_IS_CONTINUATION 0x800
#define SCM_PROGRAM_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
#define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x))
@@ -42,6 +43,7 @@
#define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
#define SCM_PROGRAM_IS_PRIMITIVE(x) (SCM_CELL_WORD_0 (x) &
SCM_F_PROGRAM_IS_PRIMITIVE)
#define SCM_PROGRAM_IS_PRIMITIVE_GENERIC(x) (SCM_CELL_WORD_0 (x) &
SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC)
+#define SCM_PROGRAM_IS_CONTINUATION(x) (SCM_CELL_WORD_0 (x) &
SCM_F_PROGRAM_IS_CONTINUATION)
SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index ce16063..431d6b1 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
/* A stack holds a frame chain
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software
Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010 Free
Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -199,31 +199,17 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM cont;
struct scm_vm_cont *c;
- cont = scm_cdar (scm_vm_capture_continuations ());
+ cont = scm_i_vm_capture_continuation (scm_the_vm ());
c = SCM_VM_CONT_DATA (cont);
frame = scm_c_make_frame (cont, c->fp + c->reloc,
- c->sp + c->reloc, c->ip,
+ c->sp + c->reloc, c->ra,
c->reloc);
}
else if (SCM_VM_FRAME_P (obj))
frame = obj;
else if (SCM_CONTINUATIONP (obj))
- {
- scm_t_contregs *cont = SCM_CONTREGS (obj);
- if (!scm_is_null (cont->vm_conts))
- { SCM vm_cont;
- struct scm_vm_cont *data;
- vm_cont = scm_cdr (scm_car (cont->vm_conts));
- data = SCM_VM_CONT_DATA (vm_cont);
- frame = scm_c_make_frame (vm_cont,
- data->fp + data->reloc,
- data->sp + data->reloc,
- data->ip,
- data->reloc);
- } else
- frame = SCM_BOOL_F;
- }
+ frame = scm_i_continuation_to_frame (obj);
else
{
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
@@ -301,21 +287,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
else if (SCM_VM_FRAME_P (stack))
frame = stack;
else if (SCM_CONTINUATIONP (stack))
- {
- scm_t_contregs *cont = SCM_CONTREGS (stack);
- if (!scm_is_null (cont->vm_conts))
- { SCM vm_cont;
- struct scm_vm_cont *data;
- vm_cont = scm_cdr (scm_car (cont->vm_conts));
- data = SCM_VM_CONT_DATA (vm_cont);
- frame = scm_c_make_frame (vm_cont,
- data->fp + data->reloc,
- data->sp + data->reloc,
- data->ip,
- data->reloc);
- } else
- frame = SCM_BOOL_F;
- }
+ frame = scm_i_continuation_to_frame (stack);
else
{
SCM_WRONG_TYPE_ARG (SCM_ARG1, stack);
diff --git a/libguile/tags.h b/libguile/tags.h
index 143a300..e98f965 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -421,7 +421,7 @@ typedef scm_t_uintptr scm_t_bits;
#define scm_tc7_vm 55
#define scm_tc7_vm_cont 71
-#define scm_tc7_unused_17 61
+#define scm_tc7_prompt 61
#define scm_tc7_unused_21 63
#define scm_tc7_unused_19 69
#define scm_tc7_program 79
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 0d54fa5..6827e79 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -978,6 +978,21 @@ VM_DEFINE_INSTRUCTION (58, foreign_call, "foreign-call",
1, -1, -1)
}
}
+VM_DEFINE_INSTRUCTION (89, continuation_call, "continuation-call", 0, -1, 0)
+{
+ SCM contregs;
+ POP (contregs);
+
+ scm_i_check_continuation (contregs);
+ vm_return_to_continuation (scm_i_contregs_vm (contregs),
+ scm_i_contregs_vm_cont (contregs),
+ sp - (fp - 1), fp);
+ scm_i_reinstate_continuation (contregs);
+
+ /* no NEXT */
+ abort ();
+}
+
VM_DEFINE_INSTRUCTION (59, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
{
SCM x;
@@ -1081,10 +1096,11 @@ VM_DEFINE_INSTRUCTION (63, tail_apply, "tail-apply", 1,
-1, 1)
VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
{
int first;
- SCM proc, cont;
+ SCM proc, vm_cont, cont;
POP (proc);
SYNC_ALL ();
- cont = scm_make_continuation (&first);
+ vm_cont = vm_capture_continuation (vp->stack_base, fp, sp, ip, NULL);
+ cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
PUSH ((SCM)fp); /* dynamic link */
@@ -1095,22 +1111,14 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
nargs = 1;
goto vm_call;
}
- ASSERT (sp == vp->sp);
- ASSERT (fp == vp->fp);
- else if (SCM_VALUESP (cont))
- {
- /* multiple values returned to continuation */
- SCM values;
- values = scm_struct_ref (cont, SCM_INUM0);
- if (scm_is_null (values))
- goto vm_error_no_values;
- /* non-tail context does not accept multiple values? */
- PUSH (SCM_CAR (values));
- NEXT;
- }
- else
+ else
{
- PUSH (cont);
+ /* otherwise, the vm continuation was reinstated, and
+ scm_i_vm_return_to_continuation pushed on one value. So pull our regs
+ back down from the vp, and march on to the next instruction. */
+ CACHE_REGISTER ();
+ program = SCM_FRAME_PROGRAM (fp);
+ CACHE_PROGRAM ();
NEXT;
}
}
@@ -1118,12 +1126,17 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1)
{
int first;
- SCM proc, cont;
+ SCM proc, vm_cont, cont;
POP (proc);
SYNC_ALL ();
- cont = scm_make_continuation (&first);
- ASSERT (sp == vp->sp);
- ASSERT (fp == vp->fp);
+ /* In contrast to call/cc, tail-call/cc captures the continuation without the
+ stack frame. */
+ vm_cont = vm_capture_continuation (vp->stack_base,
+ SCM_FRAME_DYNAMIC_LINK (fp),
+ SCM_FRAME_LOWER_ADDRESS (fp) - 1,
+ SCM_FRAME_RETURN_ADDRESS (fp),
+ SCM_FRAME_MV_RETURN_ADDRESS (fp));
+ cont = scm_i_make_continuation (&first, vm, vm_cont);
if (first)
{
PUSH (proc);
@@ -1131,19 +1144,14 @@ VM_DEFINE_INSTRUCTION (65, tail_call_cc,
"tail-call/cc", 0, 1, 1)
nargs = 1;
goto vm_tail_call;
}
- else if (SCM_VALUESP (cont))
- {
- /* multiple values returned to continuation */
- SCM values;
- values = scm_struct_ref (cont, SCM_INUM0);
- nvalues = scm_ilength (values);
- PUSH_LIST (values, scm_is_null);
- goto vm_return_values;
- }
else
{
- PUSH (cont);
- goto vm_return;
+ /* Otherwise, cache regs and NEXT, as above. Invoking the continuation
+ does a return from the frame, either to the RA or MVRA. */
+ CACHE_REGISTER ();
+ program = SCM_FRAME_PROGRAM (fp);
+ CACHE_PROGRAM ();
+ NEXT;
}
}
@@ -1446,7 +1454,7 @@ VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
{
scm_t_int32 offset;
scm_t_uint8 inline_handler_p, escape_only_p;
- SCM k, handler, pre_unwind, jmpbuf;
+ SCM k, handler, pre_unwind, prompt;
inline_handler_p = FETCH ();
escape_only_p = FETCH ();
@@ -1458,9 +1466,11 @@ VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
SYNC_REGISTER ();
/* Push the prompt onto the dynamic stack. The setjmp itself has to be local
to this procedure. */
- jmpbuf = vm_prepare_prompt_jmpbuf (vm, k, handler, pre_unwind,
- inline_handler_p, escape_only_p);
- if (VM_SETJMP (jmpbuf))
+ /* FIXME: do more error checking */
+ prompt = scm_c_make_prompt (vm, k, handler, pre_unwind,
+ inline_handler_p, escape_only_p);
+ scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
+ if (SCM_PROMPT_SETJMP (prompt))
{
/* The prompt exited nonlocally. Cache the regs back from the vp, and go
to the handler or post-handler label. (The meaning of the label
differs
diff --git a/libguile/vm.c b/libguile/vm.c
index 4c647b0..66d89a4 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -28,6 +28,7 @@
#include <gc/gc_mark.h>
#include "_scm.h"
+#include "control.h"
#include "frames.h"
#include "instructions.h"
#include "objcodes.h"
@@ -79,74 +80,105 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state
*pstate)
scm_puts (">", port);
}
+/* In theory, a number of vm instances can be active in the call trace, and we
+ only want to reify the continuations of those in the current continuation
+ root. I don't see a nice way to do this -- ideally it would involve
dynwinds,
+ and previous values of the *the-vm* fluid within the current continuation
+ root. But we don't have access to continuation roots in the dynwind stack.
+ So, just punt for now, we just capture the continuation for the current VM.
+
+ While I'm on the topic, 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; but that's currently not implemented.
+ */
static SCM
-capture_vm_cont (struct scm_vm *vp)
+vm_capture_continuation (SCM *stack_base,
+ SCM *fp, SCM *sp, scm_t_uint8 *ra, scm_t_uint8 *mvra)
{
- struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
- p->stack_size = vp->sp - vp->stack_base + 1;
+ struct scm_vm_cont *p;
+
+ p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
+ p->stack_size = sp - stack_base + 1;
p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
"capture_vm_cont");
-#ifdef VM_ENABLE_STACK_NULLING
- if (vp->sp >= vp->stack_base)
+#if defined(VM_ENABLE_STACK_NULLING) && 0
+ /* Tail continuations leave their frame on the stack for subsequent
+ application, but don't capture the frame -- so there are some elements on
+ the stack then, and this check doesn't work, so disable it for now. */
+ if (sp >= vp->stack_base)
if (!vp->sp[0] || vp->sp[1])
abort ();
memset (p->stack_base, 0, p->stack_size * sizeof (SCM));
#endif
- p->ip = vp->ip;
- p->sp = vp->sp;
- p->fp = vp->fp;
- memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
- p->reloc = p->stack_base - vp->stack_base;
+ p->ra = ra;
+ p->mvra = mvra;
+ p->sp = sp;
+ p->fp = fp;
+ memcpy (p->stack_base, stack_base, (sp + 1 - stack_base) * sizeof (SCM));
+ p->reloc = p->stack_base - stack_base;
return scm_cell (scm_tc7_vm_cont, (scm_t_bits)p);
}
static void
-reinstate_vm_cont (struct scm_vm *vp, SCM cont)
+vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv)
{
- struct scm_vm_cont *p = SCM_VM_CONT_DATA (cont);
- if (vp->stack_size < p->stack_size)
+ struct scm_vm *vp;
+ struct scm_vm_cont *cp;
+ SCM *argv_copy;
+
+ argv_copy = alloca (n * sizeof(SCM));
+ memcpy (argv_copy, argv, n * sizeof(SCM));
+
+ vp = SCM_VM_DATA (vm);
+ cp = SCM_VM_CONT_DATA (cont);
+
+ if (n == 0 && !cp->mvra)
+ scm_misc_error (NULL, "Too few values returned to continuation",
+ SCM_EOL);
+
+ if (vp->stack_size < cp->stack_size + n + 1)
{
/* puts ("FIXME: Need to expand"); */
abort ();
}
#ifdef VM_ENABLE_STACK_NULLING
{
- scm_t_ptrdiff nzero = (vp->sp - p->sp);
+ scm_t_ptrdiff nzero = (vp->sp - cp->sp);
if (nzero > 0)
- memset (vp->stack_base + p->stack_size, 0, nzero * sizeof (SCM));
+ memset (vp->stack_base + cp->stack_size, 0, nzero * sizeof (SCM));
/* actually nzero should always be negative, because vm_reset_stack will
unwind the stack to some point *below* this continuation */
}
#endif
- vp->ip = p->ip;
- vp->sp = p->sp;
- vp->fp = p->fp;
- memcpy (vp->stack_base, p->stack_base, p->stack_size * sizeof (SCM));
-}
-
-/* In theory, a number of vm instances can be active in the call trace, and we
- only want to reify the continuations of those in the current continuation
- root. I don't see a nice way to do this -- ideally it would involve
dynwinds,
- and previous values of the *the-vm* fluid within the current continuation
- root. But we don't have access to continuation roots in the dynwind stack.
- So, just punt for now -- take the current value of *the-vm*.
+ vp->sp = cp->sp;
+ vp->fp = cp->fp;
+ memcpy (vp->stack_base, cp->stack_base, cp->stack_size * sizeof (SCM));
- While I'm on the topic, 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; but that's currently not implemented.
- */
-SCM
-scm_vm_capture_continuations (void)
-{
- SCM vm = scm_the_vm ();
- return scm_acons (vm, capture_vm_cont (SCM_VM_DATA (vm)), SCM_EOL);
+ if (n == 1 || !cp->mvra)
+ {
+ vp->ip = cp->ra;
+ vp->sp++;
+ *vp->sp = argv_copy[0];
+ }
+ else
+ {
+ size_t i;
+ for (i = 0; i < n; i++)
+ {
+ vp->sp++;
+ *vp->sp = argv_copy[i];
+ }
+ vp->sp++;
+ *vp->sp = scm_from_size_t (n);
+ vp->ip = cp->mvra;
+ }
}
-void
-scm_vm_reinstate_continuations (SCM conts)
+SCM
+scm_i_vm_capture_continuation (SCM vm)
{
- for (; conts != SCM_EOL; conts = SCM_CDR (conts))
- reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
+ struct scm_vm *vp = SCM_VM_DATA (vm);
+ return vm_capture_continuation (vp->stack_base, vp->fp, vp->sp, vp->ip,
NULL);
}
static void
@@ -173,14 +205,6 @@ vm_dispatch_hook (SCM vm, int hook_num)
/*
* The dynamic stack
*/
-static SCM
-vm_prepare_prompt_jmpbuf (SCM vm, SCM k, SCM handler, SCM pre_unwind,
- scm_t_uint8 inline_p, scm_t_uint8 escape_only_p)
-{
- abort ();
- return SCM_BOOL_F;
-}
-
#define VM_SETJMP(jmpbuf) 0
static void vm_throw (SCM vm, SCM k, SCM args) SCM_NORETURN;
diff --git a/libguile/vm.h b/libguile/vm.h
index c121061..17445ea 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -87,9 +87,9 @@ SCM_API SCM scm_vm_trace_level (SCM vm);
SCM_API SCM scm_set_vm_trace_level_x (SCM vm, SCM level);
struct scm_vm_cont {
- scm_t_uint8 *ip;
SCM *sp;
SCM *fp;
+ scm_t_uint8 *ra, *mvra;
scm_t_ptrdiff stack_size;
SCM *stack_base;
scm_t_ptrdiff reloc;
@@ -98,13 +98,11 @@ struct scm_vm_cont {
#define SCM_VM_CONT_P(OBJ) (SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) ==
scm_tc7_vm_cont)
#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
-SCM_API SCM scm_vm_capture_continuations (void);
-SCM_API void scm_vm_reinstate_continuations (SCM conts);
-
SCM_API SCM scm_load_compiled_with_vm (SCM file);
SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
scm_print_state *pstate);
+SCM_INTERNAL SCM scm_i_vm_capture_continuation (SCM vm);
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_bootstrap_vm (void);
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index 41c78c3..7148e1e 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -981,8 +981,8 @@
(escape-only? (hashq-ref allocation x)))
;; First, set up the prompt.
(comp-push tag)
- (if (not inline?)
- ;; handler is not rendered inline, push it on the stack
+ (if inline?
+ (emit-code #f (make-glil-const #f)) ;; push #f as handler
(comp-push handler))
(if pre-unwind-handler
(comp-push pre-unwind-handler)
diff --git a/test-suite/standalone/test-unwind.c
b/test-suite/standalone/test-unwind.c
index f333c8c..2d6894d 100644
--- a/test-suite/standalone/test-unwind.c
+++ b/test-suite/standalone/test-unwind.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2004, 2005, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2004, 2005, 2008, 2009, 2010 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
@@ -137,12 +137,10 @@ SCM
check_cont_body (void *data)
{
scm_t_dynwind_flags flags = (data? SCM_F_DYNWIND_REWINDABLE : 0);
- int first;
SCM val;
scm_dynwind_begin (flags);
-
- val = scm_make_continuation (&first);
+ val = scm_c_eval_string ("(call/cc (lambda (k) k))");
scm_dynwind_end ();
return val;
}
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-7-54-gd8873df,
Andy Wingo <=