From 3c6e957edadd896e15c32c5f7765913c8ad4d63c Mon Sep 17 00:00:00 2001 From: Teddy Date: Thu, 15 Aug 2013 08:30:12 +0800 Subject: tail-recursion opt in user-def call --- Makefile | 2 +- builtin.cpp | 32 ++++++++++++++++---------------- eval.cpp | 27 ++++++++++++++------------- gc.h | 2 +- model.h | 11 ++++++++++- types.cpp | 20 ++++++++++++++------ types.h | 1 + 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(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(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 -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 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(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(*(++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(*(++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); -- cgit v1.2.3-70-g09d2