~ chicken-core (chicken-5) d310dc22833d4f45cfa209a4f58bb23ebb39a1c0
commit d310dc22833d4f45cfa209a4f58bb23ebb39a1c0
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Jul 15 12:32:27 2015 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Jul 15 12:32:27 2015 +0200
csi starts
diff --git a/chicken.h b/chicken.h
index 0f9925ac..f05ae42d 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1961,7 +1961,7 @@ C_fctexport int CHICKEN_eval_string(char * str,C_word *result);
C_fctexport int CHICKEN_eval(C_word exp,C_word *result);
C_fctexport int CHICKEN_yield();
-C_fctexport void C_default_5fstub_toplevel(C_word c,C_word d,C_word k) C_noret;
+C_fctexport C_cpsproc(C_default_5fstub_toplevel);
/* Inline functions: */
diff --git a/runtime.c b/runtime.c
index 147565cc..1138c24f 100644
--- a/runtime.c
+++ b/runtime.c
@@ -510,7 +510,7 @@ static C_cpsproc(sigbus_trampoline) C_noret;
static C_PTABLE_ENTRY *create_initial_ptable();
#if !defined(NO_DLOAD2) && (defined(HAVE_DLFCN_H) || defined(HAVE_DL_H) || (defined(HAVE_LOADLIBRARY) && defined(HAVE_GETPROCADDRESS)))
-static void dload_2(void *dummy) C_noret;
+static void C_ccall dload_2(C_word, C_word *) C_noret;
#endif
@@ -6013,13 +6013,13 @@ void C_ccall call_cc_wrapper(C_word c, C_word *av)
{
C_word
closure = av[ 0 ],
- /* av[ 1 ] is k and ignored */
+ /* av[ 1 ] is current k and ignored */
result = av[ 2 ],
- cont = C_block_item(closure,1);
+ k = C_block_item(closure, 1);
if(c != 3) C_bad_argc(c, 3);
- C_kontinue(cont, result);
+ C_kontinue(k, result);
}
@@ -6027,16 +6027,14 @@ void C_ccall call_cc_values_wrapper(C_word c, C_word *av)
{
C_word
closure = av[ 0 ],
- cont = C_block_item(closure,1),
+ /* av[ 1 ] is current k and ignored */
+ k = C_block_item(closure, 1),
x1,
n = c;
- av[ 0 ] = cont; /* reuse av */
-
- if(c > 2) --n;
- else av[ 1 ] = C_SCHEME_UNBOUND;
-
- C_do_apply(n - 2, av);
+ av[ 0 ] = k; /* reuse av */
+ C_memmove(av + 1, av + 2, (n - 1) * sizeof(C_word));
+ C_do_apply(n - 1, av);
}
@@ -6067,8 +6065,8 @@ void C_ccall C_values(C_word c, C_word *av)
/* Check continuation whether it receives multiple values: */
if(C_block_item(k, 0) == (C_word)values_continuation) {
av[ 0 ] = k; /* reuse av */
- av[ 1 ] = C_SCHEME_UNBOUND; /* unbound value marks direct invocation */
- C_do_apply(n - 2, av);
+ C_memmove(av + 2, av + 1, (c - 1) * sizeof(C_word));
+ C_do_apply(c - 1, av);
}
if(c != 3) {
@@ -6098,17 +6096,17 @@ void C_ccall C_apply_values(C_word c, C_word *av)
/* Check continuation wether it receives multiple values: */
if(C_block_item(k, 0) == (C_word)values_continuation) {
C_word *av2;
+ C_word *ptr = C_temporary_stack_limit;
for(n = 0; !C_immediatep(lst) && C_block_header(lst) == C_PAIR_TAG; ++n) {
- C_save(C_u_i_car(lst));
+ *(ptr++) = C_u_i_car(lst);
lst = C_u_i_cdr(lst);
}
/* copy into new array */
- av2 = C_alloc(n + 2);
+ av2 = C_alloc(n + 1);
av2[ 0 ] = k;
- av2[ 1 ] = C_SCHEME_UNBOUND; /* unbound value marks direct invocation */
- C_memcpy(av2 + 2, C_temporary_stack, n * sizeof(C_word));
+ C_memcpy(av2 + 1, C_temporary_stack_limit, n * sizeof(C_word));
C_do_apply(n, av2);
}
@@ -6147,7 +6145,7 @@ void C_ccall C_call_with_values(C_word c, C_word *av)
kk = C_closure(&a, 3, (C_word)values_continuation, kont, k);
av[ 0 ] = thunk; /* reuse av */
av[ 1 ] = kk;
- C_do_apply(0, av);
+ C_do_apply(2, av);
}
@@ -6164,7 +6162,7 @@ void C_ccall C_u_call_with_values(C_word c, C_word *av)
kk = C_closure(&a, 3, (C_word)values_continuation, kont, k);
av[ 0 ] = thunk; /* reuse av */
av[ 1 ] = kk;
- C_do_apply(0, av);
+ C_do_apply(2, av);
}
@@ -6174,25 +6172,12 @@ void C_ccall values_continuation(C_word c, C_word *av)
closure = av[ 0 ],
kont = C_block_item(closure, 1),
k = C_block_item(closure, 2),
- n = c,
- arg0 = av[ 1 ],
- *av2;
-
- if(arg0 == C_SCHEME_UNBOUND) { /* This continuation was called by 'values'... */
- av[ 0 ] = kont; /* reuse av */
- av[ 1 ] = k;
- av2 = av;
- }
- else { /* This continuation was captured and called explicity... */
- av2 = C_alloc(n + 2);
- ++n;
- --c;
- av2[ 0 ] = kont;
- av2[ 1 ] = k;
- C_memcpy(av2 + 2, av + 2, (n - 2) * sizeof(C_word));
- }
+ *av2 = C_alloc(c + 1);
- C_do_apply(n - 2, av2);
+ av2[ 0 ] = kont;
+ av2[ 1 ] = k;
+ C_memcpy(av2 + 2, av + 1, (c - 1) * sizeof(C_word));
+ C_do_apply(c + 1, av2);
}
@@ -8237,7 +8222,7 @@ void C_ccall C_dload(C_word c, C_word *av)
#if !defined(NO_DLOAD2) && defined(HAVE_DL_H) && !defined(DLOAD_2_DEFINED)
# ifdef __hpux__
# define DLOAD_2_DEFINED
-void dload_2(void *dummy)
+void C_ccall dload_2(C_word c, C_word *av0)
{
void *handle, *p;
C_word
@@ -8289,7 +8274,7 @@ void dload_2(void *dummy)
#if !defined(NO_DLOAD2) && defined(HAVE_DLFCN_H) && !defined(DLOAD_2_DEFINED)
# ifndef __hpux__
# define DLOAD_2_DEFINED
-void dload_2(void *dummy)
+void C_ccall dload_2(C_word c, C_word *av0)
{
void *handle, *p, *p2;
C_word
@@ -8327,7 +8312,7 @@ void dload_2(void *dummy)
av[ 0 ] = C_SCHEME_UNDEFINED;
av[ 1 ] = k;
- ((C_proc)p)(2, *av); /* doesn't return */
+ ((C_proc)p)(2, av); /* doesn't return */
}
C_dlclose(handle);
@@ -8342,7 +8327,7 @@ void dload_2(void *dummy)
#if !defined(NO_DLOAD2) && (defined(HAVE_LOADLIBRARY) && defined(HAVE_GETPROCADDRESS)) && !defined(DLOAD_2_DEFINED)
# define DLOAD_2_DEFINED
-void dload_2(void *dummy)
+void C_ccall dload_2(C_word c, C_word *av0)
{
HINSTANCE handle;
FARPROC p = NULL, p2;
Trap