From 9f9bd0ee34422aceb9725276292a66b0e7934c6a Mon Sep 17 00:00:00 2001 From: Teddy Date: Thu, 15 Aug 2013 11:04:57 +0800 Subject: tail-rec for `if` and `and` --- builtin.cpp | 135 +++++++++++++++++++++++++++++++++++------------------------- eval.cpp | 2 +- gc.cpp | 16 +++---- gc.h | 23 ++++++++++- model.h | 18 -------- types.cpp | 12 +++--- 6 files changed, 116 insertions(+), 90 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index f4440cb..47fdda8 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -14,8 +14,6 @@ using std::stringstream; extern EmptyList *empty_list; extern UnspecObj *unspec_obj; - - SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {} void SpecialOptIf::prepare(Pair *pc) { @@ -49,8 +47,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; // Move to the next instruction } else @@ -61,21 +58,39 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt, if (TO_PAIR(args->cdr)->car->is_true()) { - second->next = NULL; - // Undo pop and invoke again - gc.attach(static_cast(*(++top_ptr))); - top_ptr++; - cont->state = empty_list; + if (second->car->is_simple_obj()) + { + second->next = NULL; + // Undo pop and invoke again + gc.attach(static_cast(*(++top_ptr))); + top_ptr++; + cont->state = empty_list; + } + else // tail recursion opt + { + cont->tail = true; + cont->state = NULL; + top_ptr++; + } gc.expose(args); return second; } else if (third != empty_list) { - third->next = NULL; - // Undo pop and invoke again - gc.attach(static_cast(*(++top_ptr))); - top_ptr++; - cont->state = empty_list; + if (third->car->is_simple_obj()) + { + third->next = NULL; + // Undo pop and invoke again + gc.attach(static_cast(*(++top_ptr))); + top_ptr++; + cont->state = empty_list; + } + else // tail recursion opt + { + cont->tail = true; + cont->state = NULL; + top_ptr++; + } gc.expose(args); return third; } @@ -83,8 +98,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(unspec_obj); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } } @@ -174,8 +188,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt, gc.expose(*top_ptr); *top_ptr++ = gc.attach(new ProcObj(body, lenvt, params)); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; // Move to the next instruction } @@ -250,8 +263,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_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } @@ -297,8 +309,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_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } @@ -314,8 +325,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt, Pair *ret_addr = cont->pc; gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } @@ -335,8 +345,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_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; // Move to the next instruction } else @@ -361,50 +370,70 @@ void SpecialOptAnd::prepare(Pair *pc) { Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt, Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) { Pair *ret_addr = cont->pc; - if (pc->cdr == empty_list) + Pair *cs = cont->state; + Pair *nexp; + if (pc->cdr == empty_list) // empty list { gc.expose(*top_ptr); *top_ptr++ = gc.attach(new BoolObj(true)); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } - if (!cont->state) + if (!cs) // spawn the first { - gc.attach(static_cast(*(++top_ptr))); - top_ptr++; - cont->state = TO_PAIR(pc->cdr); - cont->state->next = NULL; - gc.expose(args); - return cont->state; + nexp = cont->state = TO_PAIR(pc->cdr); + if (nexp->cdr == empty_list && !nexp->car->is_simple_obj()) + { + cont->tail = true; + cont->state = NULL; + top_ptr++; + gc.expose(args); + return nexp; + } + else + { + gc.attach(static_cast(*(++top_ptr))); + top_ptr++; + nexp->next = NULL; + gc.expose(args); + return nexp; + } } + EvalObj *ret = TO_PAIR(args->cdr)->car; if (ret->is_true()) { - if (cont->state->cdr == empty_list) // the last member + if (cs->cdr == empty_list) // the last member { gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } else { + nexp = TO_PAIR(cs->cdr); + if (nexp->cdr == empty_list && !nexp->car->is_simple_obj()) + { + cont->tail = true; + cont->state = NULL; + top_ptr++; + gc.expose(args); + return nexp; + } gc.attach(static_cast(*(++top_ptr))); top_ptr++; - cont->state = TO_PAIR(cont->state->cdr); - cont->state->next = NULL; + nexp = cont->state = TO_PAIR(cont->state->cdr); + nexp->next = NULL; gc.expose(args); - return cont->state; + return nexp; } } else { gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } throw NormalError(INT_ERR); @@ -423,8 +452,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(new BoolObj(false)); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } if (!cont->state) @@ -443,8 +471,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } else @@ -461,8 +488,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(ret); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; } throw NormalError(INT_ERR); @@ -532,8 +558,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, prom->feed_mem(mem); gc.expose(*top_ptr); *top_ptr++ = gc.attach(mem); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(_args); + EXIT_CURRENT_EXEC(lenvt, cont, _args); return ret_addr->next; // Move to the next instruction } else @@ -546,8 +571,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(mem); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(_args); + EXIT_CURRENT_EXEC(lenvt, cont, _args); return ret_addr->next; } else // force @@ -576,8 +600,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt, Pair *ret_addr = cont->pc; gc.expose(*top_ptr); *top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car)); - EXIT_CURRENT_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; // Move to the next instruction } diff --git a/eval.cpp b/eval.cpp index 45427e4..c6ded6e 100644 --- a/eval.cpp +++ b/eval.cpp @@ -186,7 +186,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) { } else throw TokenError((args->car)->ext_repr(), SYN_ERR_CAN_NOT_APPLY); - gc.collect(); +// gc.collect(); } } gc.expose(prog); diff --git a/gc.cpp b/gc.cpp index 4df2d46..28a7360 100644 --- a/gc.cpp +++ b/gc.cpp @@ -3,8 +3,8 @@ #include "consts.h" #include -#if defined(GC_DEBUG) || defined (GC_INFO) #include +#if defined(GC_DEBUG) || defined (GC_INFO) typedef unsigned long long ull; #endif @@ -24,16 +24,18 @@ GarbageCollector::PendingEntry::PendingEntry( void GarbageCollector::expose(EvalObj *ptr) { if (ptr == NULL) return; #ifdef GC_DEBUG - fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", + fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", (ull)ptr, ptr->gc_get_cnt() - 1, ptr->ext_repr().c_str()); #endif - if (ptr->gc_dec()) - { + /* if (ptr->gc_get_cnt() == 0) + puts("oops");*/ + if (ptr->gc_dec()) + { #ifdef GC_DEBUG - fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr); + fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr); #endif - pending_list = new PendingEntry(ptr, pending_list); - } + pending_list = new PendingEntry(ptr, pending_list); + } } void GarbageCollector::force() { diff --git a/gc.h b/gc.h index 2a0aac6..2d1c179 100644 --- a/gc.h +++ b/gc.h @@ -8,6 +8,7 @@ const int GC_QUEUE_SIZE = 262144; const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 1; typedef std::set EvalObjSet; +class GarbageCollector; #define GC_CYC_TRIGGER(ptr) \ do { \ @@ -21,6 +22,27 @@ do { \ static_cast(ptr)->gc_refs--; \ } while (0) +extern GarbageCollector gc; +#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, args) \ + do { \ + EXIT_CURRENT_ENVT(lenvt); \ + EXIT_CURRENT_CONT(cont); \ + gc.expose(args); \ + gc.collect(); \ + } while (0) class GarbageCollector { @@ -47,6 +69,5 @@ class GarbageCollector { EvalObj *attach(EvalObj *ptr); }; -extern GarbageCollector gc; #endif diff --git a/model.h b/model.h index 964d68b..ba40137 100644 --- a/model.h +++ b/model.h @@ -21,24 +21,6 @@ const int CLS_CONTAINER = 1 << 20; #define TO_PAIR(ptr) \ (static_cast(ptr)) -#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 b00459a..b583061 100644 --- a/types.cpp +++ b/types.cpp @@ -88,17 +88,16 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt, { gc.expose(*top_ptr); *top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car); - EXIT_CURRENT_EXEC(lenvt, cont); // exit cont and envt - gc.expose(_args); + EXIT_CURRENT_EXEC(lenvt, cont, _args); // exit cont and envt return ret_addr->next; } else { if (nexp->cdr == empty_list && !nexp->car->is_simple_obj()) // tail recursion opt { - cont->tail = true; - cont->state = NULL; - top_ptr++; // revert the cont + cont->tail = true; + cont->state = NULL; + top_ptr++; // revert the cont } else { @@ -311,8 +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_EXEC(lenvt, cont); - gc.expose(args); + EXIT_CURRENT_EXEC(lenvt, cont, args); return ret_addr->next; // Move to the next instruction } -- cgit v1.2.3