[uim-commit] r1741 - branches/r5rs/sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-10-02 09:15:58 -0700 (Sun, 02 Oct 2005)
New Revision: 1741

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
Log:
* sigscheme/sigscheme.h
  - (ScmOp_call_with_current_continuation): Change function type to
    ProcedureFixedTailRec1
* sigscheme/sigscheme.c
  - (SigScm_Initialize_internal): Ditto
* sigscheme/operations.c
  - (ScmOp_call_with_current_continuation):
    * Ditto
    * Support proper tail recursion partially, as disabled code. See
      the comment for further information


Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-10-02 15:45:11 UTC (rev 1740)
+++ branches/r5rs/sigscheme/operations.c	2005-10-02 16:15:58 UTC (rev 1741)
@@ -1784,11 +1784,11 @@
     return Scm_call(closure, SCM_NULL);
 }
 
-ScmObj ScmOp_call_with_current_continuation(ScmObj proc)
+ScmObj ScmOp_call_with_current_continuation(ScmObj proc, ScmEvalState *eval_state)
 {
     ScmObj cont = SCM_FALSE;
     ScmObj ret  = SCM_FALSE;
-    DECLARE_FUNCTION("call-with-current-continuation", ProcedureFixed1);
+    DECLARE_FUNCTION("call-with-current-continuation", ProcedureFixedTailRec1);
 
     ASSERT_PROCEDUREP(proc);
 
@@ -1796,15 +1796,23 @@
 
     if (setjmp(SCM_CONTINUATION_JMPENV(cont))) {
         /* returned from longjmp */
+        eval_state->ret_type = SCM_RETTYPE_AS_IS;
         ret = scm_continuation_thrown_obj;
         scm_continuation_thrown_obj = SCM_FALSE;  /* make ret sweepable */
         return ret;
     } else {
+#if 1
         /* call proc with current continutation as (proc cont): This call must
          * not be Scm_tailcall(), to preserve current stack until longjmp()
          * called.
          */
         return Scm_call(proc, LIST_1(cont));
+#else
+        /* ONLY FOR TESTING: This call is properly recursible, but all
+         * continuations are broken and cannot be called.
+         */
+        return Scm_tailcall(proc, LIST_1(cont), eval_state);
+#endif
     }
 }
 

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-10-02 15:45:11 UTC (rev 1740)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-10-02 16:15:58 UTC (rev 1741)
@@ -274,7 +274,7 @@
     Scm_RegisterProcedureVariadic1("for-each"    , ScmOp_for_each);
     Scm_RegisterProcedureFixed1("force"          , ScmOp_force);
     Scm_RegisterProcedureVariadic0("values"          , ScmOp_values);
-    Scm_RegisterProcedureFixed1("call-with-current-continuation", ScmOp_call_with_current_continuation);
+    Scm_RegisterProcedureFixedTailRec1("call-with-current-continuation", ScmOp_call_with_current_continuation);
     Scm_RegisterProcedureFixedTailRec2("call-with-values", ScmOp_call_with_values);
     /* io.c */
     Scm_RegisterProcedureFixed2("call-with-input-file"     , ScmOp_call_with_input_file);

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-10-02 15:45:11 UTC (rev 1740)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-10-02 16:15:58 UTC (rev 1741)
@@ -506,7 +506,7 @@
 ScmObj ScmOp_map(ScmObj proc, ScmObj args);
 ScmObj ScmOp_for_each(ScmObj proc, ScmObj args);
 ScmObj ScmOp_force(ScmObj closure);
-ScmObj ScmOp_call_with_current_continuation(ScmObj proc);
+ScmObj ScmOp_call_with_current_continuation(ScmObj proc, ScmEvalState *eval_state);
 ScmObj ScmOp_values(ScmObj args);
 ScmObj ScmOp_call_with_values(ScmObj producer, ScmObj consumer, ScmEvalState *eval_state);