From 06d014cb0e95f92945ea01610fd1c52a1b087502 Mon Sep 17 00:00:00 2001 From: Teddy Date: Thu, 15 Aug 2013 09:34:35 +0800 Subject: fixed prog reload bug in tail-rec --- Makefile | 2 +- builtin.cpp | 32 ++++++++++++-------------------- builtin.h | 22 +++++++++++----------- eval.cpp | 6 ++++-- types.cpp | 15 ++++++++------- types.h | 7 ++++--- 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(*(++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(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(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(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(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(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(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(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 {/*{{{*/ * and 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 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(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(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(*(++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 */ -- cgit v1.2.3