tail-recursion opt in user-def call

7 files changed, 57 insertions, 38 deletions

diff --git a/Makefile b/Makefile
index 2558d7b..6b867c3 100644
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
 CXX = g++ -DGMP_SUPPORT
 BUILD_DIR = build
 
-all: gc_debug
+all: release
 debug: CXX += -DGC_INFO -g -pg
 gc_debug: CXX += -DGC_INFO -DGC_DEBUG -g -pg
 release: CXX += -O2
diff --git a/builtin.cpp b/builtin.cpp
index 6b34d1c..49519e8 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -49,7 +49,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
-            EXIT_CURRENT_CONT(lenvt, cont);
+            EXIT_CURRENT_EXEC(lenvt, cont);
             gc.expose(args);
             return ret_addr->next;          // Move to the next instruction
         }
@@ -84,7 +84,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
             {
                 gc.expose(*top_ptr);
                 *top_ptr++ = gc.attach(unspec_obj);
-                EXIT_CURRENT_CONT(lenvt, cont);
+                EXIT_CURRENT_EXEC(lenvt, cont);
                 gc.expose(args);
                 return ret_addr->next;
             }
@@ -176,7 +176,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt,
 
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(new ProcObj(body, lenvt, params));
-    EXIT_CURRENT_CONT(lenvt, cont);
+    EXIT_CURRENT_EXEC(lenvt, cont);
     gc.expose(args);
     return ret_addr->next;  // Move to the next instruction
 }
@@ -253,7 +253,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt,
     lenvt->add_binding(id, obj);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(unspec_obj);
-    EXIT_CURRENT_CONT(lenvt, cont);
+    EXIT_CURRENT_EXEC(lenvt, cont);
     gc.expose(args);
     return ret_addr->next;
 }
@@ -301,7 +301,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt,
     if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(unspec_obj);
-    EXIT_CURRENT_CONT(lenvt, cont);
+    EXIT_CURRENT_EXEC(lenvt, cont);
     gc.expose(args);
     return ret_addr->next;
 }
@@ -319,7 +319,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt,
     Pair *pc = static_cast<Pair*>(ret_addr->car);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car);
-    EXIT_CURRENT_CONT(lenvt, cont);
+    EXIT_CURRENT_EXEC(lenvt, cont);
     gc.expose(args);
     return ret_addr->next;
 }
@@ -340,7 +340,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
         gc.expose(cont->state);     // Exec done
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;          // Move to the next instruction
     }
@@ -371,7 +371,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(new BoolObj(true));
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;
     }
@@ -391,7 +391,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(ret);
-            EXIT_CURRENT_CONT(lenvt, cont);
+            EXIT_CURRENT_EXEC(lenvt, cont);
             gc.expose(args);
             return ret_addr->next;
         }
@@ -409,7 +409,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(ret);
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;
     }
@@ -430,7 +430,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(new BoolObj(false));
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;
     }
@@ -450,7 +450,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(ret);
-            EXIT_CURRENT_CONT(lenvt, cont);
+            EXIT_CURRENT_EXEC(lenvt, cont);
             gc.expose(args);
             return ret_addr->next;
         }
@@ -468,7 +468,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(ret);
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;
     }
@@ -539,7 +539,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
         prom->feed_mem(mem);
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(mem);
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(_args);
         return ret_addr->next;          // Move to the next instruction
     }
@@ -553,7 +553,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(mem);
-            EXIT_CURRENT_CONT(lenvt, cont);
+            EXIT_CURRENT_EXEC(lenvt, cont);
             gc.expose(_args);
             return ret_addr->next;      
         }
@@ -584,7 +584,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
     Pair *pc = static_cast<Pair*>(ret_addr->car);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car));
-    EXIT_CURRENT_CONT(lenvt, cont);
+    EXIT_CURRENT_EXEC(lenvt, cont);
     gc.expose(args);
     return ret_addr->next;          // Move to the next instruction
 }
diff --git a/eval.cpp b/eval.cpp
index fd301e7..704b07b 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -117,27 +117,26 @@ inline bool make_exec(Pair *ptr) {
     return ptr->cdr == empty_list;
 }
 
-inline void push(Pair * &pc, EvalObj ** &top_ptr, Environment * &envt, Continuation * &cont) {
-//    if (pc->car == NULL)
- //       puts("oops");
+inline void push(Pair * &pc, EvalObj ** &top_ptr, 
+        Environment * &envt, Continuation * &cont) {
     if (pc->car->is_simple_obj())           // Not an opt invocation
     {
         *top_ptr++ = gc.attach(envt->get_obj(pc->car));  // Objectify the symbol
         pc = pc->next;                      // Move to the next instruction
-//        if (pc == empty_list)
-//        puts("oops");
     }
     else                                    // Operational Invocation
     {
         if (pc->car == empty_list)
             throw NormalError(SYN_ERR_EMPTY_COMB);
 
-        gc.expose(cont);
-        cont = new Continuation(envt, pc, cont);
-        gc.attach(cont);
-
-        *top_ptr++ = gc.attach(cont);
-
+        if (!cont->tail)                    // a normal invocation
+        {
+            gc.expose(cont);
+            cont = new Continuation(envt, pc, cont);
+            gc.attach(cont);
+            *top_ptr++ = gc.attach(cont);
+        }
+        else cont->tail = false;
 
         if (!make_exec(TO_PAIR(pc->car)))
             throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS);
@@ -150,7 +149,9 @@ inline void push(Pair * &pc, EvalObj ** &top_ptr, Environment * &envt, Continuat
 EvalObj *Evaluator::run_expr(Pair *prog) {
     EvalObj **top_ptr = eval_stack;
     Pair *pc = prog;
-    Continuation *cont = NULL;
+    Continuation *bcont = new Continuation(NULL, NULL, NULL), // dummy cont
+                 *cont = bcont; 
+    gc.attach(cont);
 #ifdef GC_DEBUG
     fprintf(stderr, "Start the evaluation...\n");
 #endif
@@ -158,7 +159,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
     push(pc, top_ptr, envt, cont);
     gc.attach(prog);
 
-    while (cont)
+    while (cont != bcont)
     {
         if (top_ptr == eval_stack + EVAL_STACK_SIZE)
             throw TokenError("Evaluation", RUN_ERR_STACK_OVERFLOW);
diff --git a/gc.h b/gc.h
index 78d26ae..2a0aac6 100644
--- a/gc.h
+++ b/gc.h
@@ -4,7 +4,7 @@
 #include "model.h"
 #include <map>
 
-const int GC_QUEUE_SIZE = 64 * 1024 * 1024;
+const int GC_QUEUE_SIZE = 262144;
 const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 1;
 
 typedef std::set<EvalObj*> EvalObjSet;
diff --git a/model.h b/model.h
index 8d272f8..964d68b 100644
--- a/model.h
+++ b/model.h
@@ -21,16 +21,25 @@ const int CLS_CONTAINER = 1 << 20;
 #define TO_PAIR(ptr) \
     (static_cast<Pair*>(ptr))
 
-#define EXIT_CURRENT_CONT(lenvt, cont) \
+#define EXIT_CURRENT_ENVT(lenvt) \
     do { \
         gc.expose(lenvt); \
         lenvt = cont->envt; \
         gc.attach(lenvt); \
+    } while (0)
+#define EXIT_CURRENT_CONT(cont) \
+    do { \
         gc.expose(cont); \
         cont = cont->prev_cont; \
         gc.attach(cont); \
     } while (0)
 
+#define EXIT_CURRENT_EXEC(lenvt, cont) \
+    do { \
+        EXIT_CURRENT_ENVT(lenvt); \
+        EXIT_CURRENT_CONT(cont); \
+    } while (0)
+
 /** @class FrameObj
  * Objects that can be held in the evaluation stack
  */
diff --git a/types.cpp b/types.cpp
index 1aafca5..672fead 100644
--- a/types.cpp
+++ b/types.cpp
@@ -88,17 +88,25 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car);
-            EXIT_CURRENT_CONT(lenvt, cont);
+            EXIT_CURRENT_EXEC(lenvt, cont); // exit cont and envt
             gc.expose(_args);
             return ret_addr->next;
         }
         else 
         {
-            gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+            if (!nexp->is_simple_obj() && nexp->cdr == empty_list)    // tail recursion opt
+            {
+                cont->tail = true;
+                cont->state = NULL;
+            }
+            else
+            {
+                gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+                cont->state = nexp;
+            }
             top_ptr++;
-            cont->state = nexp;
             gc.expose(_args);
-            return cont->state;
+            return nexp;
         }
     }
     else
@@ -302,7 +310,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
         Pair *ret_addr = cont->pc;
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(handler(TO_PAIR(args->cdr), name));
-        EXIT_CURRENT_CONT(lenvt, cont);
+        EXIT_CURRENT_EXEC(lenvt, cont);
         gc.expose(args);
         return ret_addr->next;          // Move to the next instruction
     }
@@ -398,7 +406,7 @@ Environment *Environment::get_prev() {
 }
 
 Continuation::Continuation(Environment *_envt, Pair *_pc, Continuation *_prev_cont ) :
-    Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL) {
+    Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL), tail(false) {
         gc.attach(prev_cont);
         gc.attach(envt);
     }
diff --git a/types.h b/types.h
index 846d86a..1c122a4 100644
--- a/types.h
+++ b/types.h
@@ -385,6 +385,7 @@ class Continuation : public Container {/*{{{*/
         Environment *envt;  /**< The saved envt */
         Pair *pc;           /**< The saved pc */
         Pair *state;        /**< The state of this compound */
+        bool tail;          /**< If the proper tail opt is on */
 
         /** Create a continuation */
         Continuation(Environment *envt, Pair *pc, Continuation *prev_cont);