fixed prog reload bug in tail-rec

6 files changed, 40 insertions, 44 deletions

diff --git a/Makefile b/Makefile
index 6b867c3..5232363 100644
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
 CXX = g++ -DGMP_SUPPORT
 BUILD_DIR = build
 
-all: release
+all: debug
 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 49519e8..f4440cb 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -41,7 +41,7 @@ void SpecialOptIf::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
     if (cont->state)
     {
@@ -55,7 +55,6 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
         }
         else 
         {
-            Pair *pc = TO_PAIR(ret_addr->car);
             Pair *first = TO_PAIR(pc->cdr);
             Pair *second = TO_PAIR(first->cdr);
             Pair *third = TO_PAIR(second->cdr);
@@ -94,7 +93,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
     {
         gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
         top_ptr++;
-        cont->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr);
+        cont->state = TO_PAIR(pc->cdr);
         cont->state->next = NULL;
         gc.expose(args);
         return cont->state;
@@ -149,10 +148,9 @@ void SpecialOptLambda::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
 
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
 
     if (pc->cdr == empty_list)
         throw TokenError(name, SYN_ERR_EMPTY_PARA_LIST);
@@ -201,9 +199,8 @@ void SpecialOptDefine::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     EvalObj *obj;
     SymObj *id;
     EvalObj *first = TO_PAIR(pc->cdr)->car;
@@ -277,9 +274,8 @@ void SpecialOptSet::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     EvalObj *first = TO_PAIR(pc->cdr)->car;
 
     if (!cont->state)
@@ -314,9 +310,8 @@ void SpecialOptQuote::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car);
     EXIT_CURRENT_EXEC(lenvt, cont);
@@ -333,7 +328,7 @@ void SpecialOptEval::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
     if (cont->state)
     {
@@ -364,9 +359,8 @@ void SpecialOptAnd::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     if (pc->cdr == empty_list)
     {
         gc.expose(*top_ptr);
@@ -423,9 +417,8 @@ void SpecialOptOr::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     if (pc->cdr == empty_list)
     {
         gc.expose(*top_ptr);
@@ -480,7 +473,7 @@ SpecialOptApply::SpecialOptApply() : SpecialOptObj("apply") {}
 void SpecialOptApply::prepare(Pair *pc) {}
 
 Pair *SpecialOptApply::call(Pair *_args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *args = _args;
     top_ptr++;          // Recover the return address
     if (args->cdr == empty_list)
@@ -529,7 +522,7 @@ void SpecialOptForce::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *args = _args;
     args = TO_PAIR(args->cdr);
     Pair *ret_addr = cont->pc;
@@ -579,9 +572,8 @@ void SpecialOptDelay::prepare(Pair *pc) {
 }
 
 Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    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_EXEC(lenvt, cont);
diff --git a/builtin.h b/builtin.h
index 9b2a549..b9156ee 100644
--- a/builtin.h
+++ b/builtin.h
@@ -24,7 +24,7 @@ class SpecialOptIf: public SpecialOptObj {/*{{{*/
          * <condition> and <consequence> should be evaluated.  Then when it's
          * invoked again, it will tell the system the corresponding result.*/
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 };/*}}}*/
 
 /** @class SpecialOptLambda
@@ -38,7 +38,7 @@ class SpecialOptLambda: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Make up a ProcObj and push into the stack */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -53,7 +53,7 @@ class SpecialOptDefine: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** See `SpecialOptLambda` */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 };/*}}}*/
 
 /** @class SpecialOptSet
@@ -67,7 +67,7 @@ class SpecialOptSet: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** See `SpecialOptDefine */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 };/*}}}*/
 
 /** @class SpecialOptLambda
@@ -81,7 +81,7 @@ class SpecialOptQuote: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Return the literal */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -98,7 +98,7 @@ class SpecialOptEval: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Behaves like the one in `SpecialOptIf` */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -113,7 +113,7 @@ class SpecialOptAnd: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Acts like `SpecialOptIf` */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -128,7 +128,7 @@ class SpecialOptOr: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** See `SpecialOptAnd` */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -143,7 +143,7 @@ class SpecialOptApply: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Provoke the <proc> with args */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -158,7 +158,7 @@ class SpecialOptDelay: public SpecialOptObj {/*{{{*/
         void prepare(Pair *pc);
         /** Make up a PromObj and push into the stack */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
@@ -179,7 +179,7 @@ class SpecialOptForce: public SpecialOptObj {/*{{{*/
          * while if it has already been evaluated, just push the result into
          * the stack */
         Pair *call(Pair *args, Environment * &envt,
-                Continuation * &cont, EvalObj ** &top_ptr);
+                Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
 
 };/*}}}*/
 
diff --git a/eval.cpp b/eval.cpp
index 704b07b..45427e4 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -138,10 +138,11 @@ inline void push(Pair * &pc, EvalObj ** &top_ptr,
         }
         else cont->tail = false;
 
+
         if (!make_exec(TO_PAIR(pc->car)))
             throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS);
         // static_cast because of is_simple_obj() is false
-        pc = static_cast<Pair*>(pc->car);  // Go deeper to enter the call
+        cont->prog = pc = TO_PAIR(pc->car);  // Go deeper to enter the call
         envt->get_obj(pc->car)->prepare(pc);
     }
 }
@@ -180,7 +181,8 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
             if ((args->car)->is_opt_obj())
             {
                 OptObj *opt = static_cast<OptObj*>(args->car);
-                pc = opt->call(args, envt, cont, top_ptr);
+//                printf("%s\n", args->ext_repr().c_str());
+                pc = opt->call(args, envt, cont, top_ptr, cont->prog);
             }
             else
                 throw TokenError((args->car)->ext_repr(), SYN_ERR_CAN_NOT_APPLY);
diff --git a/types.cpp b/types.cpp
index 672fead..b00459a 100644
--- a/types.cpp
+++ b/types.cpp
@@ -77,7 +77,7 @@ ProcObj::~ProcObj() {
 }
 
 Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
-        Continuation * &cont, EvalObj ** &top_ptr) {
+        Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     // Create a new continuation
     // static_cast see `call` invocation in eval.cpp
     Pair *ret_addr = cont->pc;
@@ -94,17 +94,18 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
         }
         else 
         {
-            if (!nexp->is_simple_obj() && nexp->cdr == empty_list)    // tail recursion opt
+            if (nexp->cdr == empty_list && !nexp->car->is_simple_obj())    // tail recursion opt
             {
-                cont->tail = true;
-                cont->state = NULL;
+                    cont->tail = true;
+                    cont->state = NULL;
+                    top_ptr++;              // revert the cont
             }
             else
             {
                 gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
                 cont->state = nexp;
+                top_ptr++;
             }
-            top_ptr++;
             gc.expose(_args);
             return nexp;
         }
@@ -305,7 +306,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
     OptObj(), handler(f), name(_name) {}
 
     Pair *BuiltinProcObj::call(Pair *args, Environment * &lenvt,
-            Continuation * &cont, EvalObj ** &top_ptr) {
+            Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
 
         Pair *ret_addr = cont->pc;
         gc.expose(*top_ptr);
@@ -406,7 +407,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), tail(false) {
+    Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL), prog(NULL), tail(false) {
         gc.attach(prev_cont);
         gc.attach(envt);
     }
diff --git a/types.h b/types.h
index 1c122a4..e90e7bb 100644
--- a/types.h
+++ b/types.h
@@ -150,7 +150,7 @@ class OptObj: public Container {/*{{{*/
          * @return New value for pc register
          */
         virtual Pair *call(Pair *args, Environment * &envt,
-                            Continuation * &cont, EvalObj ** &top_ptr) = 0;
+                            Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) = 0;
         virtual void gc_decrement();
         virtual void gc_trigger(EvalObj ** &tail, EvalObjSet &visited);
 
@@ -172,7 +172,7 @@ class ProcObj: public OptObj {/*{{{*/
         ProcObj(Pair *body, Environment *envt, EvalObj *params);
         ~ProcObj();
         Pair *call(Pair *args, Environment * &envt,
-                    Continuation * &cont, EvalObj ** &top_ptr);
+                    Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
         ReprCons *get_repr_cons();
 
         void gc_decrement();
@@ -206,7 +206,7 @@ class BuiltinProcObj: public OptObj {/*{{{*/
          */
         BuiltinProcObj(BuiltinProc proc, string name);
         Pair *call(Pair *args, Environment * &envt,
-                    Continuation * &cont, EvalObj ** &top_ptr);
+                    Continuation * &cont, EvalObj ** &top_ptr, Pair *pc);
         ReprCons *get_repr_cons();
 };/*}}}*/
 
@@ -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 */
+        Pair *prog;         /**< Pointing to ast */
         bool tail;          /**< If the proper tail opt is on */
 
         /** Create a continuation */