[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/libguile ChangeLog continuatio...
|
From: |
Gary Houston |
|
Subject: |
guile/guile-core/libguile ChangeLog continuatio... |
|
Date: |
Sat, 25 Nov 2000 08:58:26 -0800 |
CVSROOT: /cvs
Module name: guile
Changes by: Gary Houston <address@hidden> 00/11/25 08:58:25
Modified files:
guile-core/libguile: ChangeLog continuations.c continuations.h
debug.c eval.c gc.c hash.c init.c print.c
procprop.c procs.c root.c stacks.c tags.h
Log message:
* use an applicable SMOB to represent continuations, instead of a
custom tc7 type. This will make it easier to support R5RS
multiple value continuations, without the use of a Scheme-level
wrapper.
* continuations.c (scm_tc16_continuation, continuation_mark,
continuation_free, continuation_print, continuation_apply):
new SMOB support.
(scm_make_continuation): new procedure, replaces scm_make_cont
with a different interface.
(copy_stack_and_call, scm_dynthrow, scm_init_continuations): rewritten.
(CHEAP_CONTINUATIONS): removed non-working code completely.
(scm_call_continuation): removed.
* continuations.h (struct scm_contregs): add num_stack_items and
stack fields. previously stack was stored following this struct:
use a tail array instead.
(SCM_CONTINUATIONP): new macro.
(SCM_CONTINUATION_LENGTH, SCM_SET_CONTINUATION_LENGTH):
rewritten.
(SCM_SET_CONTREGS): removed.
* tags.h: removed scm_tc7_contin (was tag 61).
* debug.c, gc.c, hash.c, print.c, procprop.c, procs.c:
removed scm_tc7_contin support.
* eval.c: use scm_make_continuation instead of scm_make_cont.
don't set jump buffers here. remove scm_tc7_contin support.
* init.c, root.c: create SMOB continuation for rootcont instead
of scm_tc7_contin. call scm_init_continuations before
scm_init_root.
* root.c: remove support for static jmpbuf. It's not used by
default and I broke it. create SMOB continuation for rootcont.
* stacks.c: use SCM_CONTINUATIONP.
CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ChangeLog.diff?r1=1.1177&r2=1.1178
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/continuations.c.diff?r1=1.25&r2=1.26
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/continuations.h.diff?r1=1.15&r2=1.16
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/debug.c.diff?r1=1.76&r2=1.77
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/eval.c.diff?r1=1.179&r2=1.180
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/gc.c.diff?r1=1.164&r2=1.165
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/hash.c.diff?r1=1.36&r2=1.37
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/init.c.diff?r1=1.104&r2=1.105
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/print.c.diff?r1=1.105&r2=1.106
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/procprop.c.diff?r1=1.30&r2=1.31
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/procs.c.diff?r1=1.45&r2=1.46
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/root.c.diff?r1=1.46&r2=1.47
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/stacks.c.diff?r1=1.50&r2=1.51
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/tags.h.diff?r1=1.68&r2=1.69
Patches:
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1177
guile/guile-core/libguile/ChangeLog:1.1178
--- guile/guile-core/libguile/ChangeLog:1.1177 Fri Nov 24 06:43:41 2000
+++ guile/guile-core/libguile/ChangeLog Sat Nov 25 08:58:25 2000
@@ -1,3 +1,37 @@
+2000-11-25 Gary Houston <address@hidden>
+
+ * use an applicable SMOB to represent continuations, instead of a
+ custom tc7 type. This will make it easier to support R5RS
+ multiple value continuations, without the use of a Scheme-level
+ wrapper.
+
+ * continuations.c (scm_tc16_continuation, continuation_mark,
+ continuation_free, continuation_print, continuation_apply):
+ new SMOB support.
+ (scm_make_continuation): new procedure, replaces scm_make_cont
+ with a different interface.
+ (copy_stack_and_call, scm_dynthrow, scm_init_continuations): rewritten.
+ (CHEAP_CONTINUATIONS): removed non-working code completely.
+ (scm_call_continuation): removed.
+ * continuations.h (struct scm_contregs): add num_stack_items and
+ stack fields. previously stack was stored following this struct:
+ use a tail array instead.
+ (SCM_CONTINUATIONP): new macro.
+ (SCM_CONTINUATION_LENGTH, SCM_SET_CONTINUATION_LENGTH):
+ rewritten.
+ (SCM_SET_CONTREGS): removed.
+ * tags.h: removed scm_tc7_contin (was tag 61).
+ * debug.c, gc.c, hash.c, print.c, procprop.c, procs.c:
+ removed scm_tc7_contin support.
+ * eval.c: use scm_make_continuation instead of scm_make_cont.
+ don't set jump buffers here. remove scm_tc7_contin support.
+ * init.c, root.c: create SMOB continuation for rootcont instead
+ of scm_tc7_contin. call scm_init_continuations before
+ scm_init_root.
+ * root.c: remove support for static jmpbuf. It's not used by
+ default and I broke it. create SMOB continuation for rootcont.
+ * stacks.c: use SCM_CONTINUATIONP.
+
2000-11-24 Matthias Koeppe <address@hidden>
* goops.c (filter_cpl, remove_duplicate_slots), goops.h
Index: guile/guile-core/libguile/continuations.c
diff -u guile/guile-core/libguile/continuations.c:1.25
guile/guile-core/libguile/continuations.c:1.26
--- guile/guile-core/libguile/continuations.c:1.25 Wed Nov 22 07:36:58 2000
+++ guile/guile-core/libguile/continuations.c Sat Nov 25 08:58:25 2000
@@ -48,10 +48,13 @@
#include "libguile/_scm.h"
#include "libguile/root.h"
#include "libguile/stackchk.h"
+#include "libguile/smob.h"
+#include "libguile/ports.h"
+#include "libguile/dynwind.h"
+
#ifdef DEBUG_EXTENSIONS
#include "libguile/debug.h"
#endif
-#include "libguile/dynwind.h"
#include "libguile/continuations.h"
@@ -60,52 +63,92 @@
/* {Continuations}
*/
-static char s_cont[] = "continuation";
+scm_bits_t scm_tc16_continuation;
-static void scm_dynthrow (SCM, SCM);
+static SCM continuation_mark (SCM obj)
+{
+ scm_contregs *continuation = SCM_CONTREGS (obj);
+
+ scm_gc_mark (continuation->throw_value);
+ scm_mark_locations (continuation->stack, continuation->num_stack_items);
+ return continuation->dynenv;
+}
+static scm_sizet continuation_free (SCM obj)
+{
+ scm_contregs *continuation = SCM_CONTREGS (obj);
+ /* stack array size is 1 if num_stack_items is 0 (rootcont). */
+ scm_sizet extra_items = (continuation->num_stack_items > 0)
+ ? (continuation->num_stack_items - 1)
+ : 0;
+ scm_sizet bytes_free = sizeof (scm_contregs)
+ + extra_items * sizeof (SCM_STACKITEM);
+
+ scm_must_free (continuation);
+ return bytes_free;
+}
-#ifndef CHEAP_CONTINUATIONS
+static int continuation_print (SCM obj, SCM port, scm_print_state *state)
+{
+ scm_contregs *continuation = SCM_CONTREGS (obj);
+ scm_puts ("#<continuation ", port);
+ scm_intprint (continuation->num_stack_items, 10, port);
+ scm_puts (" @ ", port);
+ scm_intprint (SCM_CELL_WORD_1 (obj), 16, port);
+ scm_putc ('>', port);
+ return 1;
+}
+/* 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"
SCM
-scm_make_cont (SCM *answer)
+scm_make_continuation (int *first)
{
- long j;
SCM cont;
+ scm_contregs *continuation;
+ scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
+ long stack_size;
SCM_STACKITEM * src;
- SCM_STACKITEM * dst;
- SCM_NEWCELL (cont);
- *answer = cont;
SCM_ENTER_A_SECTION;
SCM_FLUSH_REGISTER_WINDOWS;
- j = scm_stack_size (SCM_BASE (scm_rootcont));
- SCM_SET_CONTREGS (cont,
- scm_must_malloc (sizeof (scm_contregs)
- + j * sizeof (SCM_STACKITEM),
- s_cont));
- SCM_DYNENV (cont) = scm_dynwinds;
- SCM_THROW_VALUE (cont) = SCM_EOL;
- src = SCM_BASE (cont) = SCM_BASE (scm_rootcont);
- SCM_SEQ (cont) = SCM_SEQ (scm_rootcont);
- SCM_SET_CONTINUATION_LENGTH (cont, j);
+ stack_size = scm_stack_size (rootcont->base);
+ continuation = scm_must_malloc (sizeof (scm_contregs)
+ + (stack_size - 1) * sizeof (SCM_STACKITEM),
+ FUNC_NAME);
+ continuation->num_stack_items = stack_size;
+ continuation->dynenv = scm_dynwinds;
+ continuation->throw_value = SCM_EOL;
+ continuation->base = src = rootcont->base;
+ continuation->seq = rootcont->seq;
+#ifdef DEBUG_EXTENSIONS
+ continuation->dframe = scm_last_debug_frame;
+#endif
+ SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
SCM_EXIT_A_SECTION;
-#ifndef SCM_STACK_GROWS_UP
- src -= SCM_CONTINUATION_LENGTH (cont);
-#endif /* ndef SCM_STACK_GROWS_UP */
- dst = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof
(scm_contregs));
-
- /* memcpy should be safe: src and dst will never overlap */
- memcpy (dst, src, sizeof (SCM_STACKITEM) * SCM_CONTINUATION_LENGTH (cont));
-#ifdef DEBUG_EXTENSIONS
- SCM_DFRAME (cont) = scm_last_debug_frame;
+#ifndef SCM_STACK_GROWS_UP
+ src -= stack_size;
#endif
+ memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
- return cont;
+ if (setjmp (continuation->jmpbuf))
+ {
+ *first = 0;
+ return continuation->throw_value;
+ }
+ else
+ {
+ *first = 1;
+ return cont;
+ }
}
+#undef FUNC_NAME
+static void scm_dynthrow (SCM, 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
@@ -131,18 +174,18 @@
* own frame are overwritten. Thus, memcpy can be used for best performance.
*/
static void
-copy_stack_and_call (SCM cont, SCM val,
- SCM_STACKITEM * src, SCM_STACKITEM * dst)
+copy_stack_and_call (scm_contregs *continuation, SCM val,
+ SCM_STACKITEM * dst)
{
- /* memcpy should be safe: src and dst will never overlap */
- memcpy (dst, src, sizeof (SCM_STACKITEM) * SCM_CONTINUATION_LENGTH (cont));
+ memcpy (dst, continuation->stack,
+ sizeof (SCM_STACKITEM) * continuation->num_stack_items);
#ifdef DEBUG_EXTENSIONS
- scm_last_debug_frame = SCM_DFRAME (cont);
+ scm_last_debug_frame = continuation->dframe;
#endif
- SCM_THROW_VALUE (cont) = val;
- longjmp (SCM_JMPBUF (cont), 1);
+ continuation->throw_value = val;
+ longjmp (continuation->jmpbuf, 1);
}
@@ -153,93 +196,59 @@
static void
scm_dynthrow (SCM cont, SCM val)
{
- SCM_STACKITEM * src;
+ scm_contregs *continuation = SCM_CONTREGS (cont);
SCM_STACKITEM * dst = SCM_BASE (scm_rootcont);
SCM_STACKITEM stack_top_element;
#ifdef SCM_STACK_GROWS_UP
- if (SCM_PTR_GE (dst + SCM_CONTINUATION_LENGTH (cont), & stack_top_element))
+ if (SCM_PTR_GE (dst + continuation->num_stack_items, &stack_top_element))
grow_stack (cont, val);
#else
- dst -= SCM_CONTINUATION_LENGTH (cont);
- if (SCM_PTR_LE (dst, & stack_top_element))
+ dst -= continuation->num_stack_items;
+ if (SCM_PTR_LE (dst, &stack_top_element))
grow_stack (cont, val);
#endif /* def SCM_STACK_GROWS_UP */
- SCM_FLUSH_REGISTER_WINDOWS;
- src = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof
(scm_contregs));
- copy_stack_and_call (cont, val, src, dst);
-}
-
-
-#else /* ifndef CHEAP_CONTINUATIONS */
-
-/* Dirk:FIXME:: It seems that nobody has ever tried to use this code, since it
- * contains syntactic errors and thus would not have compiled anyway.
- */
-
-SCM
-scm_make_cont (SCM *answer)
-{
- SCM cont;
-
- SCM_NEWCELL (cont);
- *answer = cont;
- SCM_ENTER_A_SECTION;
- SCM_SET_CONTREGS (cont, scm_must_malloc (sizeof (scm_contregs), s_cont));
- SCM_DYNENV (cont) = scm_dynwinds;
- SCM_THROW_VALUE = SCM_EOL;
- SCM_BASE (cont) = SCM_BASE (rootcont);
- SCM_SEQ (cont) = SCM_SEQ (rootcont);
- SCM_SETCAR (cont, scm_tc7_contin);
- SCM_EXIT_A_SECTION;
-
-#ifdef DEBUG_EXTENSIONS
- SCM_DFRAME (cont) = scm_last_debug_frame;
-#endif
-
- return cont;
-}
-
-
-static void
-scm_dynthrow (SCM cont, SCM val)
-{
-#ifdef DEBUG_EXTENSIONS
- scm_last_debug_frame = SCM_DFRAME (cont);
-#endif
- SCM_THROW_VALUE (cont) = val;
- longjmp (SCM_JMPBUF (cont), 1);
+ SCM_FLUSH_REGISTER_WINDOWS;
+ copy_stack_and_call (continuation, val, dst);
}
-
-#endif
-
-
-SCM
-scm_call_continuation (SCM cont, SCM val)
+#define FUNC_NAME "continuation_apply"
+static SCM continuation_apply (SCM cont, SCM args)
{
- if ((SCM_SEQ (cont) != SCM_SEQ (scm_rootcont))
- || (SCM_BASE (cont) != SCM_BASE (scm_rootcont)))
- /* base compare not needed */
- scm_wta (cont, "continuation from wrong top level", s_cont);
+ /* FIXME: support R5RS multiple value continuations. */
+ scm_contregs *continuation = SCM_CONTREGS (cont);
+ scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
+
+ SCM_ASSERT (scm_ilength (args) == 1, args, SCM_ARGn, FUNC_NAME);
+ if (continuation->seq != rootcont->seq
+ /* this base comparison isn't needed */
+ || continuation->base != rootcont->base)
+ {
+ scm_wta (cont, "continuation from wrong top level", FUNC_NAME);
+ }
- scm_dowinds (SCM_DYNENV (cont),
- scm_ilength (scm_dynwinds) - scm_ilength (SCM_DYNENV (cont)));
+ scm_dowinds (continuation->dynenv,
+ scm_ilength (scm_dynwinds) - continuation->dynenv);
- scm_dynthrow (cont, val);
+ scm_dynthrow (cont, SCM_CAR (args));
return SCM_UNSPECIFIED; /* not reached */
}
+#undef FUNC_NAME
-
void
scm_init_continuations ()
{
+ scm_tc16_continuation = scm_make_smob_type ("continuation", 0);
+ scm_set_smob_mark (scm_tc16_continuation, continuation_mark);
+ scm_set_smob_free (scm_tc16_continuation, continuation_free);
+ scm_set_smob_print (scm_tc16_continuation, continuation_print);
+ scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1);
+
#ifndef SCM_MAGIC_SNARFER
#include "libguile/continuations.x"
#endif
}
-
/*
Local Variables:
Index: guile/guile-core/libguile/continuations.h
diff -u guile/guile-core/libguile/continuations.h:1.15
guile/guile-core/libguile/continuations.h:1.16
--- guile/guile-core/libguile/continuations.h:1.15 Wed Nov 22 07:36:58 2000
+++ guile/guile-core/libguile/continuations.h Sat Nov 25 08:58:25 2000
@@ -47,25 +47,41 @@
+/* a continuation SCM is a non-immediate pointing to a heap cell with:
+ word 0: bits 0-15: unused.
+ bits 16-31: smob type tag: scm_tc16_continuation.
+ word 1: malloc block containing an scm_contregs structure with a
+ tail array of SCM_STACKITEM. the size of the array is stored
+ in the num_stack_items field of the structure.
+*/
+
+extern scm_bits_t scm_tc16_continuation;
+
typedef struct
{
SCM throw_value;
jmp_buf jmpbuf;
SCM dynenv;
- SCM_STACKITEM *base;
- unsigned long seq;
+ SCM_STACKITEM *base; /* base of the live stack, before it was saved. */
+ scm_sizet num_stack_items; /* size of the saved stack. */
+ unsigned long seq; /* dynamic root identifier. */
#ifdef DEBUG_EXTENSIONS
+ /* the most recently created debug frame on the live stack, before
+ it was saved. */
struct scm_debug_frame *dframe;
#endif
+ SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
} scm_contregs;
+#define SCM_CONTINUATIONP(x)\
+ (SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_continuation))
-#define SCM_CONTREGS(x) ((scm_contregs *) SCM_CELL_WORD_1 (x))
-#define SCM_SET_CONTREGS(x, r) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (r)))
-#define SCM_CONTINUATION_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
-#define SCM_SET_CONTINUATION_LENGTH(x, l) (SCM_SET_CELL_WORD_0 ((x), ((l) <<
8) + scm_tc7_contin))
+#define SCM_CONTREGS(x) ((scm_contregs *) SCM_CELL_WORD_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)
@@ -75,8 +91,7 @@
-extern SCM scm_make_cont (SCM * answer);
-extern SCM scm_call_continuation (SCM cont, SCM val);
+extern SCM scm_make_continuation (int *first);
extern void scm_init_continuations (void);
Index: guile/guile-core/libguile/debug.c
diff -u guile/guile-core/libguile/debug.c:1.76
guile/guile-core/libguile/debug.c:1.77
--- guile/guile-core/libguile/debug.c:1.76 Fri Nov 17 08:25:03 2000
+++ guile/guile-core/libguile/debug.c Sat Nov 25 08:58:25 2000
@@ -431,7 +431,6 @@
SCM_EOL,
SCM_ENV (proc))));
}
- case scm_tc7_contin:
case scm_tcs_subrs:
#ifdef CCLO
case scm_tc7_cclo:
@@ -455,7 +454,6 @@
switch (SCM_TYP7 (proc)) {
case scm_tcs_closures:
return SCM_ENV (proc);
- case scm_tc7_contin:
case scm_tcs_subrs:
#ifdef CCLO
case scm_tc7_cclo:
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.179
guile/guile-core/libguile/eval.c:1.180
--- guile/guile-core/libguile/eval.c:1.179 Fri Nov 17 08:25:03 2000
+++ guile/guile-core/libguile/eval.c Sat Nov 25 08:58:25 2000
@@ -1621,8 +1621,9 @@
}\
else\
{\
- scm_make_cont (&tmp);\
- if (!setjmp (SCM_JMPBUF (tmp)))\
+ int first;\
+ tmp = scm_make_continuation (&first);\
+ if (first)\
scm_ithrow (scm_sym_apply_frame, scm_cons2 (tmp, tail, SCM_EOL),
0);\
}\
}\
@@ -1875,10 +1876,14 @@
t.arg1 = scm_make_debugobj (&debug);
else
{
- scm_make_cont (&t.arg1);
- if (setjmp (SCM_JMPBUF (t.arg1)))
+ int first;
+ SCM val = scm_make_continuation (&first);
+
+ if (first)
+ t.arg1 = val;
+ else
{
- x = SCM_THROW_VALUE (t.arg1);
+ x = val;
if (SCM_IMP (x))
{
RETURN (x);
@@ -2218,13 +2223,15 @@
goto evapply;
case (SCM_ISYMNUM (SCM_IM_CONT)):
- scm_make_cont (&t.arg1);
- if (setjmp (SCM_JMPBUF (t.arg1)))
- {
- SCM val;
- val = SCM_THROW_VALUE (t.arg1);
- RETURN (val)
- }
+ {
+ int first;
+ SCM val = scm_make_continuation (&first);
+
+ if (first)
+ t.arg1 = val;
+ else
+ RETURN (val);
+ }
proc = SCM_CDR (x);
proc = evalcar (proc, env);
SCM_ASRTGO (SCM_NIMP (proc), badfun);
@@ -2681,7 +2688,6 @@
else
goto badfun;
}
- case scm_tc7_contin:
case scm_tc7_subr_1:
case scm_tc7_subr_2:
case scm_tc7_subr_2o:
@@ -2815,8 +2821,6 @@
env = EXTEND_ENV (SCM_CAR (x), scm_cons (t.arg1, SCM_EOL), SCM_ENV
(proc));
#endif
goto cdrxbegin;
- case scm_tc7_contin:
- scm_call_continuation (proc, t.arg1);
case scm_tcs_cons_gloc:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
@@ -2970,7 +2974,6 @@
case scm_tc7_subr_1o:
case scm_tc7_subr_1:
case scm_tc7_subr_3:
- case scm_tc7_contin:
goto wrongnumargs;
default:
goto badfun;
@@ -3171,7 +3174,6 @@
case scm_tc7_subr_0:
case scm_tc7_cxr:
case scm_tc7_subr_1:
- case scm_tc7_contin:
goto wrongnumargs;
default:
goto badfun;
@@ -3187,10 +3189,14 @@
t.arg1 = scm_make_debugobj (&debug);
else
{
- scm_make_cont (&t.arg1);
- if (setjmp (SCM_JMPBUF (t.arg1)))
+ int first;
+ SCM val = scm_make_continuation (&first);
+
+ if (first)
+ t.arg1 = val;
+ else
{
- proc = SCM_THROW_VALUE (t.arg1);
+ proc = val;
goto ret;
}
}
@@ -3342,8 +3348,10 @@
tmp = scm_make_debugobj (&debug);
else
{
- scm_make_cont (&tmp);
- if (setjmp (SCM_JMPBUF (tmp)))
+ int first;
+
+ tmp = scm_make_continuation (&first);
+ if (!first)
goto entap;
}
scm_ithrow (scm_sym_enter_frame, scm_cons (tmp, SCM_EOL), 0);
@@ -3492,9 +3500,6 @@
RETURN (scm_smob_apply_2 (proc, arg1, SCM_CAR (args)))
else
RETURN (scm_smob_apply_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
- case scm_tc7_contin:
- SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
- scm_call_continuation (proc, arg1);
#ifdef CCLO
case scm_tc7_cclo:
#ifdef DEVAL
@@ -3565,10 +3570,14 @@
arg1 = scm_make_debugobj (&debug);
else
{
- scm_make_cont (&arg1);
- if (setjmp (SCM_JMPBUF (arg1)))
+ int first;
+ SCM val = scm_make_continuation (&first);
+
+ if (first)
+ arg1 = val;
+ else
{
- proc = SCM_THROW_VALUE (arg1);
+ proc = val;
goto ret;
}
}
Index: guile/guile-core/libguile/gc.c
diff -u guile/guile-core/libguile/gc.c:1.164
guile/guile-core/libguile/gc.c:1.165
--- guile/guile-core/libguile/gc.c:1.164 Thu Nov 23 00:59:22 2000
+++ guile/guile-core/libguile/gc.c Sat Nov 25 08:58:25 2000
@@ -1221,15 +1221,6 @@
ptr = SCM_VELTS (ptr)[0];
goto gc_mark_loop;
#endif
- case scm_tc7_contin:
- if (SCM_VELTS (ptr))
- scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr),
- (scm_sizet)
- (SCM_CONTINUATION_LENGTH (ptr) +
- (sizeof (SCM_STACKITEM) + -1 +
- sizeof (scm_contregs)) /
- sizeof (SCM_STACKITEM)));
- break;
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
case scm_tc7_byvect:
@@ -1653,11 +1644,6 @@
case scm_tc7_symbol:
m += SCM_SYMBOL_LENGTH (scmptr) + 1;
scm_must_free (SCM_SYMBOL_CHARS (scmptr));
- break;
- case scm_tc7_contin:
- m += SCM_CONTINUATION_LENGTH (scmptr) * sizeof (SCM_STACKITEM)
- + sizeof (scm_contregs);
- scm_must_free (SCM_CONTREGS (scmptr));
break;
case scm_tcs_subrs:
/* the various "subrs" (primitives) are never freed */
Index: guile/guile-core/libguile/hash.c
diff -u guile/guile-core/libguile/hash.c:1.36
guile/guile-core/libguile/hash.c:1.37
--- guile/guile-core/libguile/hash.c:1.36 Wed Nov 22 03:20:03 2000
+++ guile/guile-core/libguile/hash.c Sat Nov 25 08:58:25 2000
@@ -150,7 +150,6 @@
case scm_tc7_port:
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
case scm_tcs_closures:
- case scm_tc7_contin:
case scm_tcs_subrs:
return 262 % n;
}
Index: guile/guile-core/libguile/init.c
diff -u guile/guile-core/libguile/init.c:1.104
guile/guile-core/libguile/init.c:1.105
--- guile/guile-core/libguile/init.c:1.104 Wed Oct 25 07:49:56 2000
+++ guile/guile-core/libguile/init.c Sat Nov 25 08:58:25 2000
@@ -183,11 +183,13 @@
/* Create an object to hold the root continuation.
*/
- SCM_NEWCELL (scm_rootcont);
- SCM_SET_CONTREGS (scm_rootcont, scm_must_malloc (sizeof (scm_contregs),
- "continuation"));
- SCM_SET_CELL_TYPE (scm_rootcont, scm_tc7_contin);
- SCM_SEQ (scm_rootcont) = 0;
+ {
+ scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
+ "continuation");
+ contregs->num_stack_items = 0;
+ contregs->seq = 0;
+ SCM_NEWSMOB (scm_rootcont, scm_tc16_continuation, contregs);
+ }
/* The root continuation is further initialized by restart_stack. */
/* Create the look-aside stack for variables that are shared between
@@ -488,6 +490,7 @@
scm_weaks_prehistory (); /* Must come after scm_init_storage */
scm_init_subr_table ();
scm_environments_prehistory (); /* create the root environment */
+ scm_init_continuations ();
scm_init_root ();
#ifdef USE_THREADS
scm_init_threads (base);
@@ -501,7 +504,6 @@
scm_init_async ();
scm_init_boolean ();
scm_init_chars ();
- scm_init_continuations ();
#ifdef GUILE_DEBUG_MALLOC
scm_init_debug_malloc ();
#endif
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.105
guile/guile-core/libguile/print.c:1.106
--- guile/guile-core/libguile/print.c:1.105 Wed Nov 22 03:20:03 2000
+++ guile/guile-core/libguile/print.c Sat Nov 25 08:58:25 2000
@@ -673,13 +673,6 @@
}
scm_putc ('>', port);
break;
- case scm_tc7_contin:
- scm_puts ("#<continuation ", port);
- scm_intprint (SCM_CONTINUATION_LENGTH (exp), 10, port);
- scm_puts (" @ ", port);
- scm_intprint ((long) SCM_CONTREGS (exp), 16, port);
- scm_putc ('>', port);
- break;
case scm_tc7_port:
{
register long i = SCM_PTOBNUM (exp);
Index: guile/guile-core/libguile/procprop.c
diff -u guile/guile-core/libguile/procprop.c:1.30
guile/guile-core/libguile/procprop.c:1.31
--- guile/guile-core/libguile/procprop.c:1.30 Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/procprop.c Sat Nov 25 08:58:25 2000
@@ -80,7 +80,6 @@
o = 1;
case scm_tc7_subr_1:
case scm_tc7_cxr:
- case scm_tc7_contin:
a += 1;
break;
case scm_tc7_subr_2:
Index: guile/guile-core/libguile/procs.c
diff -u guile/guile-core/libguile/procs.c:1.45
guile/guile-core/libguile/procs.c:1.46
--- guile/guile-core/libguile/procs.c:1.45 Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/procs.c Sat Nov 25 08:58:25 2000
@@ -196,7 +196,6 @@
if (!SCM_I_OPERATORP (obj))
break;
case scm_tcs_closures:
- case scm_tc7_contin:
case scm_tcs_subrs:
#ifdef CCLO
case scm_tc7_cclo:
@@ -278,8 +277,7 @@
#define FUNC_NAME s_scm_procedure_documentation
{
SCM code;
- SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T)
- && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
+ SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T) && SCM_NIMP (proc),
proc, SCM_ARG1, FUNC_NAME);
switch (SCM_TYP7 (proc))
{
Index: guile/guile-core/libguile/root.c
diff -u guile/guile-core/libguile/root.c:1.46
guile/guile-core/libguile/root.c:1.47
--- guile/guile-core/libguile/root.c:1.46 Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/root.c Sat Nov 25 08:58:25 2000
@@ -58,12 +58,6 @@
#include "libguile/root.h"
-/* Define this if you want to try out the stack allocation of cwdr's
- jumpbuf. It works for me but I'm still worried that the dynwinds
- might be able to make a mess. */
-
-#undef USE_STACKJMPBUF
-
SCM scm_sys_protects[SCM_NUM_PROTECTS];
long scm_tc16_root;
@@ -248,9 +242,6 @@
scm_catch_handler_t handler, void *handler_data,
SCM_STACKITEM *stack_start)
{
-#ifdef USE_STACKJMPBUF
- scm_contregs static_contregs;
-#endif
int old_ints_disabled = scm_ints_disabled;
SCM old_rootcont, old_winds;
struct cwdr_handler_data my_handler_data;
@@ -259,22 +250,22 @@
/* Create a fresh root continuation. */
{
SCM new_rootcont;
- SCM_NEWCELL (new_rootcont);
+
SCM_REDEFER_INTS;
-#ifdef USE_STACKJMPBUF
- SCM_SET_CONTREGS (new_rootcont, &static_contregs);
-#else
- SCM_SET_CONTREGS (new_rootcont,
- scm_must_malloc (sizeof (scm_contregs),
- "inferior root continuation"));
-#endif
- SCM_SET_CELL_TYPE (new_rootcont, scm_tc7_contin);
- SCM_DYNENV (new_rootcont) = SCM_EOL;
- SCM_BASE (new_rootcont) = stack_start;
- SCM_SEQ (new_rootcont) = ++n_dynamic_roots;
+ {
+ scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
+ "inferior root continuation");
+
+ contregs->num_stack_items = 0;
+ contregs->dynenv = SCM_EOL;
+ contregs->base = stack_start;
+ contregs->seq = ++n_dynamic_roots;
+ contregs->throw_value = SCM_BOOL_F;
#ifdef DEBUG_EXTENSIONS
- SCM_DFRAME (new_rootcont) = 0;
+ contregs->dframe = 0;
#endif
+ SCM_NEWSMOB (new_rootcont, scm_tc16_continuation, contregs);
+ }
old_rootcont = scm_rootcont;
scm_rootcont = new_rootcont;
SCM_REALLOW_INTS;
@@ -298,9 +289,6 @@
scm_dowinds (old_winds, - scm_ilength (old_winds));
SCM_REDEFER_INTS;
-#ifdef USE_STACKCJMPBUF
- SCM_SET_CONTREGS (scm_rootcont, NULL);
-#endif
#ifdef DEBUG_EXTENSIONS
scm_last_debug_frame = SCM_DFRAME (old_rootcont);
#endif
Index: guile/guile-core/libguile/stacks.c
diff -u guile/guile-core/libguile/stacks.c:1.50
guile/guile-core/libguile/stacks.c:1.51
--- guile/guile-core/libguile/stacks.c:1.50 Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/stacks.c Sat Nov 25 08:58:25 2000
@@ -433,7 +433,7 @@
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
- else if (scm_tc7_contin == SCM_TYP7 (obj))
+ else if (SCM_CONTINUATIONP (obj))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof
(scm_contregs))
- SCM_BASE (obj));
@@ -517,7 +517,7 @@
SCM_VALIDATE_NIM (1,stack);
if (SCM_DEBUGOBJP (stack))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
- else if (scm_tc7_contin == SCM_TYP7 (stack))
+ else if (SCM_CONTINUATIONP (stack))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof
(scm_contregs))
- SCM_BASE (stack));
@@ -587,7 +587,7 @@
SCM_VALIDATE_NIM (1,obj);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
- else if (scm_tc7_contin == SCM_TYP7 (obj))
+ else if (SCM_CONTINUATIONP (obj))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof
(scm_contregs))
- SCM_BASE (obj));
Index: guile/guile-core/libguile/tags.h
diff -u guile/guile-core/libguile/tags.h:1.68
guile/guile-core/libguile/tags.h:1.69
--- guile/guile-core/libguile/tags.h:1.68 Wed Oct 25 04:01:03 2000
+++ guile/guile-core/libguile/tags.h Sat Nov 25 08:58:25 2000
@@ -356,7 +356,7 @@
#define scm_tc7_ivect 79
#endif
-#define scm_tc7_contin 61
+/* free 61 */
#define scm_tc7_cclo 63
#define scm_tc7_rpsubr 69
#define scm_tc7_subr_0 85
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- guile/guile-core/libguile ChangeLog continuatio...,
Gary Houston <=