[uim-commit] r1961 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Thu Nov 3 03:44:29 PST 2005
Author: kzk
Date: 2005-11-03 03:44:25 -0800 (Thu, 03 Nov 2005)
New Revision: 1961
Added:
branches/r5rs/sigscheme/storage-continuation.c
Modified:
branches/r5rs/sigscheme/Makefile.am
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* Move continuation related functions to storage-continuation.c
* sigscheme/sigschemeinternal.h
- (INVALID_CONTINUATION_JMPENV,
CONTINUATION_JMPENV,
CONTINUATION_SET_JMPENV,
CONTINUATION_DYNEXT,
CONTINUATION_SET_DYNEXT): moved from data.c
- (SigScm_InitContinuation,
SigScm_FinalizeContinuation): new func
* sigscheme/datas.c
- (INVALID_CONTINUATION_JMPENV,
CONTINUATION_JMPENV,
CONTINUATION_SET_JMPENV,
CONTINUATION_DYNEXT,
CONTINUATION_SET_DYNEXT): moved to sigschemeinternal.h
- (scm_current_dynamic_extent): renamed from current_dynamic_extent
and now declared in storage-continuation.c
- (continuation_thrown_obj, continuation_stack,
initialize_dynamic_extent, finalize_dynamic_extent,
wind_onto_dynamic_extent, unwind_dynamic_extent,
enter_dynamic_extent, exit_dynamic_extent,
initialize_continuation_env, finalize_continuation_env,
continuation_stack_push, continuation_stack_pop,
continuation_stack_unwind): moved to storage-continuation.c
- (SigScm_InitStorage): call SigScm_InitContinuation
- (SigScm_FinalizeStorage): call SigScm_FinalizeContinuation
* sigscheme/storage-continuation.c
- new file
- (continuation_thrown_obj, continuation_stack,
initialize_dynamic_extent, finalize_dynamic_extent,
wind_onto_dynamic_extent, unwind_dynamic_extent,
enter_dynamic_extent, exit_dynamic_extent,
initialize_continuation_env, finalize_continuation_env,
continuation_stack_push, continuation_stack_pop,
continuation_stack_unwind): moved from datas.c
- (scm_current_dynamic_extent): renamed from current_dynamic_extent
and now declared in storage-continuation.c
* sigscheme/Makefile.am
- add storage-continuation.c
Modified: branches/r5rs/sigscheme/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/Makefile.am 2005-11-03 11:12:48 UTC (rev 1960)
+++ branches/r5rs/sigscheme/Makefile.am 2005-11-03 11:44:25 UTC (rev 1961)
@@ -1,12 +1,13 @@
noinst_LTLIBRARIES = libsscm.la
libsscm_la_SOURCES = \
datas.c debug.c \
+ storage-continuation.c \
encoding.c error.c \
eval.c io.c \
operations.c \
read.c sigscheme.c \
sigscheme.h sigschemetype.h
-
+
libsscm_la_CFLAGS = -Wall
bin_PROGRAMS = sscm
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-11-03 11:12:48 UTC (rev 1960)
+++ branches/r5rs/sigscheme/datas.c 2005-11-03 11:44:25 UTC (rev 1961)
@@ -115,19 +115,6 @@
/*=======================================
File Local Macro Declarations
=======================================*/
-/* specifies whether the storage abstraction layer can only handle nested
- * (stacked) continuation or R5RS-conformant full implementation. But current
- * implementation only supports '1'.
- */
-#define SCM_NESTED_CONTINUATION_ONLY 1
-
-#define INVALID_CONTINUATION_JMPENV NULL
-
-#define CONTINUATION_JMPENV SCM_CONTINUATION_OPAQUE0
-#define CONTINUATION_SET_JMPENV SCM_CONTINUATION_SET_OPAQUE0
-#define CONTINUATION_DYNEXT SCM_CONTINUATION_OPAQUE1
-#define CONTINUATION_SET_DYNEXT SCM_CONTINUATION_SET_OPAQUE1
-
#define NAMEHASH_SIZE 1024
#define SCM_NEW_OBJ_INTERNAL(VALNAME) \
@@ -186,13 +173,6 @@
ScmObj SigScm_null_values;
#endif
-/* dynamic extent */
-static ScmObj current_dynamic_extent = NULL;
-
-/* temporary store for a object returned from a continuation */
-static ScmObj continuation_thrown_obj = NULL;
-static ScmObj continuation_stack = NULL;
-
static ScmObj *symbol_hash = NULL;
static gc_protected_var *protected_var_list = NULL;
@@ -202,6 +182,9 @@
static ScmCell SigScm_null_cell, SigScm_true_cell, SigScm_false_cell, SigScm_eof_cell;
static ScmCell SigScm_unbound_cell, SigScm_undef_cell;
+/* storage-continuation.c */
+extern ScmObj scm_current_dynamic_extent;
+
/*=======================================
File Local Function Declarations
=======================================*/
@@ -228,21 +211,6 @@
static void sweep_obj(ScmObj obj);
static void gc_sweep(void);
-/* dynamic extent */
-static void initialize_dynamic_extent(void);
-static void finalize_dynamic_extent(void);
-static void wind_onto_dynamic_extent(ScmObj before, ScmObj after);
-static void unwind_dynamic_extent(void);
-static void enter_dynamic_extent(ScmObj dest);
-static void exit_dynamic_extent(ScmObj dest);
-
-/* continuation */
-static void initialize_continuation_env(void);
-static void finalize_continuation_env(void);
-static void continuation_stack_push(ScmObj cont);
-static ScmObj continuation_stack_pop(void);
-static ScmObj continuation_stack_unwind(ScmObj dest_cont);
-
static void initialize_symbol_hash(void);
static void finalize_symbol_hash(void);
static int symbol_name_hash(const char *name);
@@ -288,15 +256,14 @@
SCM_ENTYPE_VALUEPACKET(SigScm_null_values);
SigScm_GC_Protect(&SigScm_null_values);
#endif
- initialize_dynamic_extent();
- initialize_continuation_env();
+
+ SigScm_InitContinuation();
initialize_symbol_hash();
}
void SigScm_FinalizeStorage(void)
{
- finalize_continuation_env();
- finalize_dynamic_extent();
+ SigScm_FinalizeContinuation();
finalize_heap();
finalize_symbol_hash();
finalize_protected_var();
@@ -870,7 +837,7 @@
SCM_ENTYPE_CONTINUATION(obj);
CONTINUATION_SET_JMPENV(obj, INVALID_CONTINUATION_JMPENV);
- CONTINUATION_SET_DYNEXT(obj, current_dynamic_extent);
+ CONTINUATION_SET_DYNEXT(obj, scm_current_dynamic_extent);
return obj;
}
@@ -913,202 +880,6 @@
#endif /* SCM_USE_NONSTD_FEATURES */
/*============================================================================
- Dynamic Extent
-============================================================================*/
-#define MAKE_DYNEXT_FRAME(before, after) (CONS(before, after))
-#define DYNEXT_FRAME_BEFORE CAR
-#define DYNEXT_FRAME_AFTER CDR
-
-static void initialize_dynamic_extent(void)
-{
- current_dynamic_extent = SCM_NULL;
- SigScm_GC_Protect(¤t_dynamic_extent);
-}
-
-static void finalize_dynamic_extent(void)
-{
-}
-
-static void wind_onto_dynamic_extent(ScmObj before, ScmObj after)
-{
- current_dynamic_extent = CONS(MAKE_DYNEXT_FRAME(before, after),
- current_dynamic_extent);
-}
-
-static void unwind_dynamic_extent(void)
-{
- if (NULLP(current_dynamic_extent))
- SigScm_Error("corrupted dynamic extent");
-
- current_dynamic_extent = CDR(current_dynamic_extent);
-}
-
-/* enter a dynamic extent of another continuation (dest) */
-static void enter_dynamic_extent(ScmObj dest)
-{
- ScmObj frame = SCM_FALSE;
- ScmObj unwound = SCM_FALSE;
- ScmObj retpath = SCM_NULL;
-
- for (unwound = dest; !NULLP(unwound); unwound = CDR(unwound)) {
- if (EQ(unwound, current_dynamic_extent))
- break;
- frame = CAR(unwound);
- retpath = CONS(frame, retpath);
- }
-
- /* assumes that (SCM_NULL != NULL) */
- while (SCM_SHIFT_RAW(frame, retpath)) {
- Scm_call(DYNEXT_FRAME_BEFORE(frame), SCM_NULL);
- }
-}
-
-/* exit to a dynamic extent of another continuation (dest) */
-static void exit_dynamic_extent(ScmObj dest)
-{
- ScmObj frame = SCM_FALSE;
-
- for (;
- !NULLP(current_dynamic_extent);
- current_dynamic_extent = CDR(current_dynamic_extent))
- {
- if (EQ(current_dynamic_extent, dest))
- return;
- frame = CAR(current_dynamic_extent);
- Scm_call(DYNEXT_FRAME_AFTER(frame), SCM_NULL);
- }
-}
-
-ScmObj Scm_DynamicWind(ScmObj before, ScmObj thunk, ScmObj after)
-{
- ScmObj ret = SCM_FALSE;
-
- Scm_call(before, SCM_NULL);
-
- wind_onto_dynamic_extent(before, after);
- ret = Scm_call(thunk, SCM_NULL);
- unwind_dynamic_extent();
-
- Scm_call(after, SCM_NULL);
-
- return ret;
-}
-
-/*============================================================================
- Continuation
-============================================================================*/
-static void initialize_continuation_env(void)
-{
- continuation_thrown_obj = SCM_FALSE;
- continuation_stack = SCM_NULL;
- SigScm_GC_Protect(&continuation_thrown_obj);
- SigScm_GC_Protect(&continuation_stack);
-}
-
-static void finalize_continuation_env(void)
-{
-}
-
-static void continuation_stack_push(ScmObj cont)
-{
- continuation_stack = CONS(cont, continuation_stack);
-}
-
-static ScmObj continuation_stack_pop(void)
-{
- ScmObj recentmost = SCM_FALSE;
-
- if (!NULLP(continuation_stack)) {
- recentmost = CAR(continuation_stack);
- continuation_stack = CDR(continuation_stack);
- }
-
- return recentmost;
-}
-
-/* expire all descendant continuations and dest_cont */
-static ScmObj continuation_stack_unwind(ScmObj dest_cont)
-{
- ScmObj cont = SCM_FALSE;
-
- do {
- cont = continuation_stack_pop();
- if (FALSEP(cont))
- return SCM_FALSE;
- CONTINUATION_SET_JMPENV(cont, INVALID_CONTINUATION_JMPENV);
- } while (!EQ(dest_cont, cont));
-
- return dest_cont;
-}
-
-ScmObj Scm_CallWithCurrentContinuation(ScmObj proc, ScmEvalState *eval_state)
-{
- jmp_buf env;
- ScmObj cont = SCM_FALSE;
- ScmObj ret = SCM_FALSE;
-
- cont = Scm_NewContinuation();
- CONTINUATION_SET_JMPENV(cont, &env);
-#if SCM_NESTED_CONTINUATION_ONLY
- continuation_stack_push(cont);
-#endif
-
- if (setjmp(env)) {
- /* returned from longjmp */
- ret = continuation_thrown_obj;
- continuation_thrown_obj = SCM_FALSE; /* make ret sweepable */
-
- enter_dynamic_extent(CONTINUATION_DYNEXT(cont));
-
- eval_state->ret_type = SCM_RETTYPE_AS_IS;
- return ret;
- } else {
-#if SCM_NESTED_CONTINUATION_ONLY
- /* call proc with current continutation as (proc cont): This call must
- * not be Scm_tailcall(), to preserve current stack until longjmp()
- * called.
- */
- eval_state->ret_type = SCM_RETTYPE_AS_IS;
- ret = Scm_call(proc, LIST_1(cont));
-#else
- /* ONLY FOR TESTING: This call is properly recursible, but all
- * continuations are broken and cannot be called, if the continuation
- * is implemented by longjmp().
- */
- ret = Scm_tailcall(proc, LIST_1(cont), eval_state);
-#endif
-
-#if SCM_NESTED_CONTINUATION_ONLY
- /* the continuation expires when this function returned */
- continuation_stack_unwind(cont);
-#endif
- return ret;
- }
-}
-
-void Scm_CallContinuation(ScmObj cont, ScmObj ret)
-{
- jmp_buf *env;
-
- env = CONTINUATION_JMPENV(cont);
-
- if (env != INVALID_CONTINUATION_JMPENV
-#if SCM_NESTED_CONTINUATION_ONLY
- && CONTINUATIONP(continuation_stack_unwind(cont))
-#endif
- )
- {
- exit_dynamic_extent(CONTINUATION_DYNEXT(cont));
-
- continuation_thrown_obj = ret;
- longjmp(*env, 1);
- /* NOTREACHED */
- } else {
- ERR("Scm_CallContinuation: called expired continuation");
- }
-}
-
-/*============================================================================
Symbol table
============================================================================*/
/*
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-03 11:12:48 UTC (rev 1960)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-03 11:44:25 UTC (rev 1961)
@@ -326,14 +326,26 @@
(scm_exception_continuations = CDR(scm_exception_continuations))
#endif /* SCM_USE_SRFI34 */
+/* Macros For Handling Continuation Object */
+#define INVALID_CONTINUATION_JMPENV NULL
+
+#define CONTINUATION_JMPENV SCM_CONTINUATION_OPAQUE0
+#define CONTINUATION_SET_JMPENV SCM_CONTINUATION_SET_OPAQUE0
+#define CONTINUATION_DYNEXT SCM_CONTINUATION_OPAQUE1
+#define CONTINUATION_SET_DYNEXT SCM_CONTINUATION_SET_OPAQUE1
+
/*=======================================
Function Declarations
=======================================*/
/* datas.c */
void SigScm_InitStorage(void);
void SigScm_FinalizeStorage(void);
+
+/* storage-continuation.c */
+void SigScm_InitContinuation(void);
+void SigScm_FinalizeContinuation(void);
ScmObj Scm_CallWithCurrentContinuation(ScmObj proc, ScmEvalState *eval_state);
-void Scm_CallContinuation(ScmObj cont, ScmObj ret);
+void Scm_CallContinuation(ScmObj cont, ScmObj ret);
ScmObj Scm_DynamicWind(ScmObj before, ScmObj thunk, ScmObj after);
/* eval.c */
Copied: branches/r5rs/sigscheme/storage-continuation.c (from rev 1960, branches/r5rs/sigscheme/datas.c)
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-11-03 11:12:48 UTC (rev 1960)
+++ branches/r5rs/sigscheme/storage-continuation.c 2005-11-03 11:44:25 UTC (rev 1961)
@@ -0,0 +1,298 @@
+/*===========================================================================
+ * FileName : storage-continuation.c
+ * About : A Continuation implementation with setjmp/longjmp
+ *
+ * Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.jp)
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+ * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+===========================================================================*/
+
+/*=======================================
+ System Include
+=======================================*/
+#include <string.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+/* specifies whether the storage abstraction layer can only handle nested
+ * (stacked) continuation or R5RS-conformant full implementation. But current
+ * implementation only supports '1'.
+ */
+#define SCM_NESTED_CONTINUATION_ONLY 1
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+/* dynamic extent */
+ScmObj scm_current_dynamic_extent = NULL;
+
+/* temporary store for a object returned from a continuation */
+static ScmObj continuation_thrown_obj = NULL;
+static ScmObj continuation_stack = NULL;
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+/* dynamic extent */
+static void initialize_dynamic_extent(void);
+static void finalize_dynamic_extent(void);
+static void wind_onto_dynamic_extent(ScmObj before, ScmObj after);
+static void unwind_dynamic_extent(void);
+static void enter_dynamic_extent(ScmObj dest);
+static void exit_dynamic_extent(ScmObj dest);
+
+/* continuation */
+static void initialize_continuation_env(void);
+static void finalize_continuation_env(void);
+static void continuation_stack_push(ScmObj cont);
+static ScmObj continuation_stack_pop(void);
+static ScmObj continuation_stack_unwind(ScmObj dest_cont);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void SigScm_InitContinuation(void)
+{
+ initialize_dynamic_extent();
+ initialize_continuation_env();
+}
+
+void SigScm_FinalizeContinuation(void)
+{
+ finalize_continuation_env();
+ finalize_dynamic_extent();
+}
+
+/*============================================================================
+ Dynamic Extent
+============================================================================*/
+#define MAKE_DYNEXT_FRAME(before, after) (CONS(before, after))
+#define DYNEXT_FRAME_BEFORE CAR
+#define DYNEXT_FRAME_AFTER CDR
+
+static void initialize_dynamic_extent(void)
+{
+ scm_current_dynamic_extent = SCM_NULL;
+ SigScm_GC_Protect(&scm_current_dynamic_extent);
+}
+
+static void finalize_dynamic_extent(void)
+{
+}
+
+static void wind_onto_dynamic_extent(ScmObj before, ScmObj after)
+{
+ scm_current_dynamic_extent = CONS(MAKE_DYNEXT_FRAME(before, after),
+ scm_current_dynamic_extent);
+}
+
+static void unwind_dynamic_extent(void)
+{
+ if (NULLP(scm_current_dynamic_extent))
+ SigScm_Error("corrupted dynamic extent");
+
+ scm_current_dynamic_extent = CDR(scm_current_dynamic_extent);
+}
+
+/* enter a dynamic extent of another continuation (dest) */
+static void enter_dynamic_extent(ScmObj dest)
+{
+ ScmObj frame = SCM_FALSE;
+ ScmObj unwound = SCM_FALSE;
+ ScmObj retpath = SCM_NULL;
+
+ for (unwound = dest; !NULLP(unwound); unwound = CDR(unwound)) {
+ if (EQ(unwound, scm_current_dynamic_extent))
+ break;
+ frame = CAR(unwound);
+ retpath = CONS(frame, retpath);
+ }
+
+ /* assumes that (SCM_NULL != NULL) */
+ while (SCM_SHIFT_RAW(frame, retpath)) {
+ Scm_call(DYNEXT_FRAME_BEFORE(frame), SCM_NULL);
+ }
+}
+
+/* exit to a dynamic extent of another continuation (dest) */
+static void exit_dynamic_extent(ScmObj dest)
+{
+ ScmObj frame = SCM_FALSE;
+
+ for (;
+ !NULLP(scm_current_dynamic_extent);
+ scm_current_dynamic_extent = CDR(scm_current_dynamic_extent))
+ {
+ if (EQ(scm_current_dynamic_extent, dest))
+ return;
+ frame = CAR(scm_current_dynamic_extent);
+ Scm_call(DYNEXT_FRAME_AFTER(frame), SCM_NULL);
+ }
+}
+
+ScmObj Scm_DynamicWind(ScmObj before, ScmObj thunk, ScmObj after)
+{
+ ScmObj ret = SCM_FALSE;
+
+ Scm_call(before, SCM_NULL);
+
+ wind_onto_dynamic_extent(before, after);
+ ret = Scm_call(thunk, SCM_NULL);
+ unwind_dynamic_extent();
+
+ Scm_call(after, SCM_NULL);
+
+ return ret;
+}
+
+/*============================================================================
+ Continuation
+============================================================================*/
+static void initialize_continuation_env(void)
+{
+ continuation_thrown_obj = SCM_FALSE;
+ continuation_stack = SCM_NULL;
+ SigScm_GC_Protect(&continuation_thrown_obj);
+ SigScm_GC_Protect(&continuation_stack);
+}
+
+static void finalize_continuation_env(void)
+{
+}
+
+static void continuation_stack_push(ScmObj cont)
+{
+ continuation_stack = CONS(cont, continuation_stack);
+}
+
+static ScmObj continuation_stack_pop(void)
+{
+ ScmObj recentmost = SCM_FALSE;
+
+ if (!NULLP(continuation_stack)) {
+ recentmost = CAR(continuation_stack);
+ continuation_stack = CDR(continuation_stack);
+ }
+
+ return recentmost;
+}
+
+/* expire all descendant continuations and dest_cont */
+static ScmObj continuation_stack_unwind(ScmObj dest_cont)
+{
+ ScmObj cont = SCM_FALSE;
+
+ do {
+ cont = continuation_stack_pop();
+ if (FALSEP(cont))
+ return SCM_FALSE;
+ CONTINUATION_SET_JMPENV(cont, INVALID_CONTINUATION_JMPENV);
+ } while (!EQ(dest_cont, cont));
+
+ return dest_cont;
+}
+
+ScmObj Scm_CallWithCurrentContinuation(ScmObj proc, ScmEvalState *eval_state)
+{
+ jmp_buf env;
+ ScmObj cont = SCM_FALSE;
+ ScmObj ret = SCM_FALSE;
+
+ cont = Scm_NewContinuation();
+ CONTINUATION_SET_JMPENV(cont, &env);
+#if SCM_NESTED_CONTINUATION_ONLY
+ continuation_stack_push(cont);
+#endif
+
+ if (setjmp(env)) {
+ /* returned from longjmp */
+ ret = continuation_thrown_obj;
+ continuation_thrown_obj = SCM_FALSE; /* make ret sweepable */
+
+ enter_dynamic_extent(CONTINUATION_DYNEXT(cont));
+
+ eval_state->ret_type = SCM_RETTYPE_AS_IS;
+ return ret;
+ } else {
+#if SCM_NESTED_CONTINUATION_ONLY
+ /* call proc with current continutation as (proc cont): This call must
+ * not be Scm_tailcall(), to preserve current stack until longjmp()
+ * called.
+ */
+ eval_state->ret_type = SCM_RETTYPE_AS_IS;
+ ret = Scm_call(proc, LIST_1(cont));
+#else
+ /* ONLY FOR TESTING: This call is properly recursible, but all
+ * continuations are broken and cannot be called, if the continuation
+ * is implemented by longjmp().
+ */
+ ret = Scm_tailcall(proc, LIST_1(cont), eval_state);
+#endif
+
+#if SCM_NESTED_CONTINUATION_ONLY
+ /* the continuation expires when this function returned */
+ continuation_stack_unwind(cont);
+#endif
+ return ret;
+ }
+}
+
+void Scm_CallContinuation(ScmObj cont, ScmObj ret)
+{
+ jmp_buf *env;
+
+ env = CONTINUATION_JMPENV(cont);
+
+ if (env != INVALID_CONTINUATION_JMPENV
+#if SCM_NESTED_CONTINUATION_ONLY
+ && CONTINUATIONP(continuation_stack_unwind(cont))
+#endif
+ )
+ {
+ exit_dynamic_extent(CONTINUATION_DYNEXT(cont));
+
+ continuation_thrown_obj = ret;
+ longjmp(*env, 1);
+ /* NOTREACHED */
+ } else {
+ ERR("Scm_CallContinuation: called expired continuation");
+ }
+}
More information about the uim-commit
mailing list