~ chicken-core (chicken-5) 3e0f640ecf22f6be7af1947b875132415556ca5b

commit 3e0f640ecf22f6be7af1947b875132415556ca5b
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Mon Apr 8 12:34:52 2019 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Mon Apr 8 12:34:52 2019 +0200

    Revert "Make `call/cc` continuations behave like `values` ones."
    
    This reverts commit 2dc0c5929abc398f1d344500fba9fc10ed4857cc.
    
    The approach didn't work because generated continuations do not
    perform argument count checking and will unsafely access their
    argvectors in positions that may not be there.  When doing a GC this
    will break because save_and_reclaim is called with slots at
    uninitialised memory locations.  Fixes #1601.

diff --git a/NEWS b/NEWS
index 2c73ebd8..5e8a133a 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,10 @@
 - Runtime system
   - Removed the unused, undocumented (and incorrect!) C functions
     C_delete_symbol_table and C_set_symbol_table.
+  - Continuations which discard additional values beyond the first no
+    longer accept multiple values via direct invocation after being
+    captured through `call/cc`, only via `values` (revert of #1390,
+    due to #1601)
 
 - Module system
   - When you try to import the module you are currently defining into
diff --git a/runtime.c b/runtime.c
index b8bccb75..c06b5432 100644
--- a/runtime.c
+++ b/runtime.c
@@ -546,6 +546,7 @@ static void set_profile_timer(C_uword freq);
 static void take_profile_sample();
 
 static C_cpsproc(call_cc_wrapper) C_noret;
+static C_cpsproc(call_cc_values_wrapper) C_noret;
 static C_cpsproc(gc_2) C_noret;
 static C_cpsproc(allocate_vector_2) C_noret;
 static C_cpsproc(generic_trampoline) C_noret;
@@ -877,7 +878,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
 {
   /* IMPORTANT: hardcoded table size -
      this must match the number of C_pte calls + 1 (NULL terminator)! */
-  C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 62);
+  C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 63);
   int i = 0;
 
   if(pt == NULL)
@@ -886,6 +887,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
   C_pte(termination_continuation);
   C_pte(callback_return_continuation);
   C_pte(values_continuation);
+  C_pte(call_cc_values_wrapper);
   C_pte(call_cc_wrapper);
   C_pte(C_gc);
   C_pte(C_allocate_vector);
@@ -7048,7 +7050,10 @@ void C_ccall C_call_cc(C_word c, C_word *av)
   if(C_immediatep(cont) || C_header_bits(cont) != C_CLOSURE_TYPE)
     barf(C_BAD_ARGUMENT_TYPE_ERROR, "call-with-current-continuation", cont);
   
-  wrapper = C_closure(&a, 2, (C_word)call_cc_wrapper, k);
+  /* Check for values-continuation: */
+  if(C_block_item(k, 0) == (C_word)values_continuation)
+    wrapper = C_closure(&a, 2, (C_word)call_cc_values_wrapper, k);
+  else wrapper = C_closure(&a, 2, (C_word)call_cc_wrapper, k);
   
   av2[ 0 ] = cont;
   av2[ 1 ] = k;
@@ -7062,11 +7067,28 @@ void C_ccall call_cc_wrapper(C_word c, C_word *av)
   C_word
     closure = av[ 0 ],
     /* av[ 1 ] is current k and ignored */
+    result,
     k = C_block_item(closure, 1);
+
+  if(c != 3) C_bad_argc(c, 3);
+
+  result = av[ 2 ];
+  C_kontinue(k, result);
+}
+
+
+void C_ccall call_cc_values_wrapper(C_word c, C_word *av)
+{
+  C_word
+    closure = av[ 0 ],
+    /* av[ 1 ] is current k and ignored */
+    k = C_block_item(closure, 1),
+    x1,
+    n = c;
   
   av[ 0 ] = k;               /* reuse av */
-  C_memmove(av + 1, av + 2, (c - 1) * sizeof(C_word));
-  C_do_apply(c - 1, av);
+  C_memmove(av + 1, av + 2, (n - 1) * sizeof(C_word));
+  C_do_apply(n - 1, av);
 }