diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | builtin.cpp | 34 | ||||
| -rw-r--r-- | eval.cpp | 10 | ||||
| -rw-r--r-- | gc.cpp | 20 | ||||
| -rw-r--r-- | main.cpp | 10 | ||||
| -rw-r--r-- | types.cpp | 18 |
6 files changed, 60 insertions, 34 deletions
@@ -2,7 +2,7 @@ sonsi: main.o parser.o builtin.o model.o eval.o exc.o consts.o types.o gc.o g++ -o sonsi $^ -pg -lgmp .cpp.o: - g++ $< -c -g -pg -DGMP_SUPPORT -Wall -DGC_DEBUG + g++ $< -c -pg -DGMP_SUPPORT -Wall -DGC_INFO -O2 clean: rm -f *.o diff --git a/builtin.cpp b/builtin.cpp index 3d4129f..dc1c5c9 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -249,7 +249,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, } envt->add_binding(id, obj); delete *top_ptr; - *top_ptr++ = unspec_obj; + *top_ptr++ = gc.attach(unspec_obj); gc.expose(args); return ret_addr->next; } @@ -297,7 +297,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &envt, bool flag = envt->add_binding(id, TO_PAIR(args->cdr)->car, false); if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR); delete *top_ptr; - *top_ptr++ = unspec_obj; + *top_ptr++ = gc.attach(unspec_obj); gc.expose(args); return ret_addr->next; } @@ -314,7 +314,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &envt, Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; Pair *pc = static_cast<Pair*>(ret_addr->car); delete *top_ptr; - *top_ptr++ = TO_PAIR(pc->cdr)->car; + *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car); gc.expose(args); return ret_addr->next; } @@ -334,7 +334,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, if (ret_info->state) { delete *top_ptr; - *top_ptr++ = TO_PAIR(args->cdr)->car; + *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -364,7 +364,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, if (pc->cdr == empty_list) { delete *top_ptr; - *top_ptr++ = new BoolObj(true); + *top_ptr++ = gc.attach(new BoolObj(true)); gc.expose(args); return ret_addr->next; } @@ -383,7 +383,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, if (ret_info->state->cdr == empty_list) // the last member { delete *top_ptr; - *top_ptr++ = ret; + *top_ptr++ = gc.attach(ret); gc.expose(args); return ret_addr->next; } @@ -400,7 +400,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, else { delete *top_ptr; - *top_ptr++ = ret; + *top_ptr++ = gc.attach(ret); gc.expose(args); return ret_addr->next; } @@ -421,7 +421,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, if (pc->cdr == empty_list) { delete *top_ptr; - *top_ptr++ = new BoolObj(false); + *top_ptr++ = gc.attach(new BoolObj(false)); gc.expose(args); return ret_addr->next; } @@ -440,7 +440,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, if (ret_info->state->cdr == empty_list) // the last member { delete *top_ptr; - *top_ptr++ = ret; + *top_ptr++ = gc.attach(ret); gc.expose(args); return ret_addr->next; } @@ -457,7 +457,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, else { delete *top_ptr; - *top_ptr++ = ret; + *top_ptr++ = gc.attach(ret); gc.expose(args); return ret_addr->next; } @@ -479,13 +479,13 @@ Pair *SpecialOptApply::call(Pair *_args, Environment * &envt, if (!args->car->is_opt_obj()) throw TokenError("an operator", RUN_ERR_WRONG_TYPE); - *top_ptr++ = args->car; // Push the operator into the stack - args = TO_PAIR(args->cdr); // Examine arguments + *top_ptr++ = gc.attach(args->car); // Push the operator into the stack + args = TO_PAIR(args->cdr); // Examine arguments if (args == empty_list) throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); for (; args->cdr != empty_list; args = TO_PAIR(args->cdr)) - *top_ptr++ = args->car; // Add leading arguments: arg_1 ... + *top_ptr++ = gc.attach(args->car); // Add leading arguments: arg_1 ... if (args->car != empty_list) // args->car is the trailing args { @@ -496,7 +496,7 @@ Pair *SpecialOptApply::call(Pair *_args, Environment * &envt, EvalObj *nptr; for (;;) { - *top_ptr++ = args->car; + *top_ptr++ = gc.attach(args->car); if ((nptr = args->cdr)->is_pair_obj()) args = TO_PAIR(nptr); else break; @@ -528,7 +528,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, EvalObj *mem = args->car; prom->feed_mem(mem); delete *top_ptr; - *top_ptr++ = mem; + *top_ptr++ = gc.attach(mem); gc.expose(_args); return ret_addr->next; // Move to the next instruction } @@ -541,7 +541,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, if (mem) // fetch from memorized result { delete *top_ptr; - *top_ptr++ = mem; + *top_ptr++ = gc.attach(mem); gc.expose(_args); return ret_addr->next; } @@ -571,7 +571,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &envt, Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; Pair *pc = static_cast<Pair*>(ret_addr->car); delete *top_ptr; - *top_ptr++ = new PromObj(TO_PAIR(pc->cdr)->car); + *top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car)); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -92,6 +92,7 @@ void Evaluator::add_builtin_routines() { Evaluator::Evaluator() { envt = new Environment(NULL); // Top-level Environment + gc.attach(envt); add_builtin_routines(); } @@ -175,10 +176,17 @@ EvalObj *Evaluator::run_expr(Pair *prog) { cont->proc_body = nexp; if (nexp == empty_list) { - *top_ptr = args->car; + *top_ptr = gc.attach(args->car); + + gc.expose(envt); envt = cont->envt; + gc.attach(envt); + pc = cont->pc->next; + + gc.expose(cont); cont = cont->prev_cont; + gc.attach(cont); } else pc = nexp; top_ptr++; @@ -2,7 +2,7 @@ #include "exc.h" #include "consts.h" -#ifdef GC_DEBUG +#if defined(GC_DEBUG) || defined (GC_INFO) #include <cstdio> typedef unsigned long long ull; #endif @@ -48,19 +48,24 @@ void GarbageCollector::force() { } // fetch the pending pointers in the list // clear the list pending_list = NULL; */ + fprintf(stderr, "%d\n", mapping.size()); for (EvalObj2Int::iterator it = mapping.begin(); it != mapping.end(); it++) if (it->second == 0) *r++ = it->first; collecting = true; -#ifdef GC_DEBUG +#ifdef GC_INFO size_t cnt = 0; - fprintf(stderr, "GC: Forcing the clear process...\n"); +#endif +#ifdef GC_DEBUG + fprintf(stderr, + "================================\n" + "GC: Forcing the clear process...\n"); #endif for (; l != r; l++) { #ifdef GC_DEBUG - fprintf(stderr, "GC: destroying space 0x%llx. \n", (ull)*l); + fprintf(stderr, "GC: !!! destroying space 0x%llx. \n", (ull)*l); cnt++; #endif delete *l; @@ -77,9 +82,10 @@ void GarbageCollector::force() { } pending_list = NULL; } -#ifdef GC_DEBUG +#ifdef GC_INFO fprintf(stderr, "GC: Forced clear, %lu objects are freed, " - "%lu remains\n", cnt, mapping.size()); + "%lu remains\n" + "=============================\n", cnt, mapping.size()); /* for (EvalObj2Int::iterator it = mapping.begin(); it != mapping.end(); it++) fprintf(stderr, "%llx => %lu\n", (ull)it->first, it->second); @@ -97,6 +103,8 @@ EvalObj *GarbageCollector::attach(EvalObj *ptr) { fprintf(stderr, "GC: 0x%llx attached. count = %lu \"%s\"\n", (ull)ptr, mapping[ptr], ptr->ext_repr().c_str()); #endif + if (mapping.size() > GC_QUEUE_SIZE >> 1) + force(); return ptr; // passing through } @@ -27,12 +27,14 @@ void load_file(const char *fname) { { Pair *tree = ast.absorb(&tk); if (!tree) break; - eval.run_expr(tree); + EvalObj *ret = eval.run_expr(tree); + gc.expose(ret); } catch (GeneralError &e) { fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str()); } + gc.force(); } } @@ -53,7 +55,7 @@ UnspecObj *unspec_obj = new UnspecObj(); int main(int argc, char **argv) { - freopen("in.scm", "r", stdin); + //freopen("in.scm", "r", stdin); gc.attach(empty_list); gc.attach(unspec_obj); @@ -96,7 +98,9 @@ int main(int argc, char **argv) { { Pair *tree = ast.absorb(&tk); if (!tree) break; - string output = eval.run_expr(tree)->ext_repr(); + EvalObj *ret = eval.run_expr(tree); + string output = ret->ext_repr(); + gc.expose(ret); fprintf(stderr, "Ret> $%d = %s\n", rcnt++, output.c_str()); } catch (GeneralError &e) @@ -63,7 +63,7 @@ ProcObj::~ProcObj() { gc.expose(envt); } -Pair *ProcObj::call(Pair *args, Environment * &genvt, +Pair *ProcObj::call(Pair *_args, Environment * &genvt, Continuation * &cont, FrameObj ** &top_ptr) { // Create a new continuation // static_cast see `call` invocation in eval.cpp @@ -73,6 +73,7 @@ Pair *ProcObj::call(Pair *args, Environment * &genvt, Environment *_envt = new Environment(envt); // static_cast<SymObj*> because the params is already checked EvalObj *ppar, *nptr; + Pair *args = _args; for (ppar = params; ppar->is_pair_obj(); ppar = TO_PAIR(ppar)->cdr) @@ -88,14 +89,17 @@ Pair *ProcObj::call(Pair *args, Environment * &genvt, else if (args->cdr != empty_list || ppar != empty_list) throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); + gc.expose(genvt); genvt = _envt; + gc.attach(genvt); + + gc.expose(cont); cont = _cont; + gc.attach(cont); - gc.expose(static_cast<EvalObj*>(*(top_ptr + 1))); // release opt obj delete *top_ptr; // release ret addr - *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont - gc.expose(args); + gc.expose(_args); return body; // Move pc to the proc entry point } @@ -226,9 +230,8 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : Continuation * &cont, FrameObj ** &top_ptr) { Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr; - gc.expose(static_cast<EvalObj*>(*(top_ptr + 1))); delete *top_ptr; - *top_ptr++ = handler(TO_PAIR(args->cdr), name); + *top_ptr++ = gc.attach(handler(TO_PAIR(args->cdr), name)); gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -242,6 +245,9 @@ Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) { } Environment::~Environment() { + for (Str2EvalObj::iterator it = binding.begin(); + it != binding.end(); it++) + gc.expose(it->second); gc.expose(prev_envt); } |