From 301c949362d243bb6b69956355e0e7ecccc43ce4 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 17:42:51 +0800 Subject: adding gc framework --- gc.cpp | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ gc.h | 31 +++++++++++++++++++++++++ 2 files changed, 114 insertions(+) create mode 100644 gc.cpp create mode 100644 gc.h diff --git a/gc.cpp b/gc.cpp new file mode 100644 index 0000000..4a3dd89 --- /dev/null +++ b/gc.cpp @@ -0,0 +1,83 @@ +#include "gc.h" +#include "exc.h" +#include "consts.h" + +#ifdef GC_DEBUG +#include +typedef unsigned long long ull; +#endif + +static EvalObj *gcq[GC_QUEUE_SIZE]; + +GarbageCollector::PendingEntry::PendingEntry( + EvalObj *_obj, PendingEntry *_next) : obj(_obj), next(_next) {} + + +void GarbageCollector::expose(EvalObj *ptr) { + bool flag = mapping.count(ptr); + if (flag) + { + if (!--mapping[ptr]) + { +#ifdef GC_DEBUG + fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr); +#endif + pending_list = new PendingEntry(ptr, pending_list); + if (++pend_cnt == GC_QUEUE_SIZE >> 1) + force(); // the gc queue may overflow + } + } +} + +void GarbageCollector::force() { + EvalObj **l = gcq, **r = l; + for (PendingEntry *p = pending_list, *np; p; p = np) + { + np = p->next; + *r++ = p->obj; + delete p; + } // fetch the pending pointers in the list + // clear the list + pending_list = NULL; + +#ifdef GC_DEBUG + size_t cnt = 0; + fprintf(stderr, "GC: Forcing the clear process...\n"); +#endif + for (; l != r; l++) + { +#ifdef GC_DEBUG + fprintf(stderr, "GC: destroying space 0x%llx. \n", (ull)*l); + cnt++; +#endif + delete *l; + // maybe it's a complex structure, + // so that more pointers are reported + for (PendingEntry *p = pending_list, *np; p; p = np) + { + np = p->next; + *r++ = p->obj; + if (r == gcq + GC_QUEUE_SIZE) + throw NormalError(RUN_ERR_GC_OVERFLOW); + delete p; + } + pending_list = NULL; + } +#ifdef GC_DEBUG + fprintf(stderr, "GC: Forced clear, %lu objects are freed\n", cnt); +#endif +} + +EvalObj *GarbageCollector::attach(EvalObj *ptr) { + if (!ptr) return NULL; // NULL pointer + bool flag = mapping.count(ptr); + if (flag) mapping[ptr]++; + else mapping[ptr] = 1; +#ifdef GC_DEBUG + fprintf(stderr, "GC: 0x%llx attached. count = %lu \"%s\"\n", + (ull)ptr, mapping[ptr], ptr->ext_repr().c_str()); +#endif + return ptr; // passing through +} + +GarbageCollector gc; diff --git a/gc.h b/gc.h new file mode 100644 index 0000000..417462f --- /dev/null +++ b/gc.h @@ -0,0 +1,31 @@ +#ifndef GC_H +#define GC_H + +#include "model.h" +#include + +const int GC_QUEUE_SIZE = 262144; + +typedef std::map EvalObj2Int; + +class GarbageCollector { + + struct PendingEntry { + EvalObj *obj; + PendingEntry *next; + PendingEntry(EvalObj *obj, PendingEntry *next); + }; + + EvalObj2Int mapping; + size_t pend_cnt; + PendingEntry *pending_list; + + public: + void force(); + void expose(EvalObj *ptr); + EvalObj *attach(EvalObj *ptr); +}; + +extern GarbageCollector gc; + +#endif -- cgit v1.2.3 From 4d3ed205fc2b86180f81fea388e488f5fa96cef9 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 19:37:57 +0800 Subject: basic gc --- Makefile | 7 ++- builtin.cpp | 7 +-- consts.cpp | 3 +- consts.h | 3 +- eval.cpp | 2 +- gc.cpp | 11 +++-- gc.h | 3 +- main.cpp | 20 +++++---- types.cpp | 143 ++++++++++++++++++++++++++++++++++++++---------------------- types.h | 11 ++++- 10 files changed, 134 insertions(+), 76 deletions(-) diff --git a/Makefile b/Makefile index aeab6a0..acdab1a 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ -sonsi: main.o parser.o builtin.o model.o eval.o exc.o consts.o types.o +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 -O2 + g++ $< -c -g -pg -DGMP_SUPPORT -Wall -DGC_DEBUG clean: rm -f *.o @@ -13,3 +13,6 @@ db: cdb: cgdb sonsi + +run: + ./sonsi diff --git a/builtin.cpp b/builtin.cpp index 760aa2a..e9669b5 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -7,6 +7,7 @@ #include "model.h" #include "exc.h" #include "types.h" +#include "gc.h" using std::stringstream; @@ -45,7 +46,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { if (ret_info->state == empty_list) { - *top_ptr++ = TO_PAIR(args->cdr)->car; + *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); return ret_addr->next; // Move to the next instruction } else @@ -73,7 +74,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, } else { - *top_ptr++ = unspec_obj; + *top_ptr++ = gc.attach(unspec_obj); return ret_addr->next; } } @@ -160,7 +161,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &envt, for (Pair *ptr = body; ptr != empty_list; ptr = TO_PAIR(ptr->cdr)) ptr->next = NULL; // Make each expression isolated - *top_ptr++ = new ProcObj(body, envt, params); + *top_ptr++ = gc.attach(new ProcObj(body, envt, params)); return ret_addr->next; // Move to the next instruction } diff --git a/consts.cpp b/consts.cpp index a04d5c7..fd835a4 100644 --- a/consts.cpp +++ b/consts.cpp @@ -19,5 +19,6 @@ const char *ERR_MSG[] = { "Queue overflowed: the expected expansion is too long!", "%s stack overflowed!", "Numeric overflow!", - "Value out of range" + "Value out of range", + "GC overflow!" }; diff --git a/consts.h b/consts.h index b24e951..10cd951 100644 --- a/consts.h +++ b/consts.h @@ -20,7 +20,8 @@ enum ErrCode { RUN_ERR_QUEUE_OVERFLOW, RUN_ERR_STACK_OVERFLOW, RUN_ERR_NUMERIC_OVERFLOW, - RUN_ERR_VALUE_OUT_OF_RANGE + RUN_ERR_VALUE_OUT_OF_RANGE, + RUN_ERR_GC_OVERFLOW }; extern const char *ERR_MSG[]; diff --git a/eval.cpp b/eval.cpp index 2deb38c..2f5921d 100644 --- a/eval.cpp +++ b/eval.cpp @@ -80,7 +80,7 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC("string?", string_gt); - ADD_BUILTIN_PROC("string<=?", string_ge); + ADD_BUILTIN_PROC("string>=?", string_ge); ADD_BUILTIN_PROC("string=?", string_eq); ADD_BUILTIN_PROC("make-vector", make_vector); diff --git a/gc.cpp b/gc.cpp index 4a3dd89..a5fdc48 100644 --- a/gc.cpp +++ b/gc.cpp @@ -9,15 +9,21 @@ typedef unsigned long long ull; static EvalObj *gcq[GC_QUEUE_SIZE]; +GarbageCollector::GarbageCollector() { + mapping.clear(); + pend_cnt = 0; + pending_list = NULL; +} + GarbageCollector::PendingEntry::PendingEntry( EvalObj *_obj, PendingEntry *_next) : obj(_obj), next(_next) {} -void GarbageCollector::expose(EvalObj *ptr) { +void GarbageCollector::expose(EvalObj *ptr, bool delay) { bool flag = mapping.count(ptr); if (flag) { - if (!--mapping[ptr]) + if (!--mapping[ptr] && !delay) { #ifdef GC_DEBUG fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr); @@ -80,4 +86,3 @@ EvalObj *GarbageCollector::attach(EvalObj *ptr) { return ptr; // passing through } -GarbageCollector gc; diff --git a/gc.h b/gc.h index 417462f..c017156 100644 --- a/gc.h +++ b/gc.h @@ -21,8 +21,9 @@ class GarbageCollector { PendingEntry *pending_list; public: + GarbageCollector(); void force(); - void expose(EvalObj *ptr); + void expose(EvalObj *ptr, bool delay = false); EvalObj *attach(EvalObj *ptr); }; diff --git a/main.cpp b/main.cpp index 78515a6..a193b68 100644 --- a/main.cpp +++ b/main.cpp @@ -3,13 +3,15 @@ #include "parser.h" #include "eval.h" #include "exc.h" +#include "gc.h" #include #include -Tokenizor *tk = new Tokenizor(); -ASTGenerator *ast = new ASTGenerator(); -Evaluator *eval = new Evaluator(); +GarbageCollector gc; +Tokenizor tk; +ASTGenerator ast; +Evaluator eval; void load_file(const char *fname) { FILE *f = fopen(fname, "r"); @@ -18,14 +20,14 @@ void load_file(const char *fname) { printf("Can not open file: %s\n", fname); exit(0); } - tk->set_stream(f); + tk.set_stream(f); while (1) { try { - Pair *tree = ast->absorb(tk); + Pair *tree = ast.absorb(&tk); if (!tree) break; - eval->run_expr(tree); + eval.run_expr(tree); } catch (GeneralError &e) { @@ -79,15 +81,15 @@ int main(int argc, char **argv) { } int rcnt = 0; - tk->set_stream(stdin); // interactive mode + tk.set_stream(stdin); // interactive mode while (1) { fprintf(stderr, "Sonsi> "); try { - Pair *tree = ast->absorb(tk); + Pair *tree = ast.absorb(&tk); if (!tree) break; - string output = eval->run_expr(tree)->ext_repr(); + string output = eval.run_expr(tree)->ext_repr(); fprintf(stderr, "Ret> $%d = %s\n", rcnt++, output.c_str()); } catch (GeneralError &e) diff --git a/types.cpp b/types.cpp index c782433..e3a7542 100644 --- a/types.cpp +++ b/types.cpp @@ -2,6 +2,7 @@ #include "model.h" #include "exc.h" #include "consts.h" +#include "gc.h" #include #include @@ -41,41 +42,43 @@ SymObj::SymObj(const string &str) : OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {} -ProcObj::ProcObj(Pair *_body, - Environment *_envt, - EvalObj *_params) : - OptObj(), body(_body), params(_params), envt(_envt) {} - - Pair *ProcObj::call(Pair *args, Environment * &genvt, - Continuation * &cont, FrameObj ** &top_ptr) { - // Create a new continuation - // static_cast see `call` invocation in eval.cpp - Pair *ret_addr = static_cast(*top_ptr)->addr; - Continuation *_cont = new Continuation(genvt, ret_addr, cont, body); - // Create local env and recall the closure - Environment *_envt = new Environment(envt); - // static_cast because the params is already checked - EvalObj *ppar, *nptr; - for (ppar = params; - ppar->is_pair_obj(); - ppar = TO_PAIR(ppar)->cdr) - { - if ((nptr = args->cdr) != empty_list) - args = TO_PAIR(nptr); - else break; - _envt->add_binding(static_cast(TO_PAIR(ppar)->car), args->car); - } +ProcObj::ProcObj(Pair *_body, Environment *_envt, EvalObj *_params) : + OptObj(), body(_body), params(_params), envt(_envt) { + gc.attach(body); + gc.attach(params); + gc.attach(envt); +} + +Pair *ProcObj::call(Pair *args, Environment * &genvt, + Continuation * &cont, FrameObj ** &top_ptr) { + // Create a new continuation + // static_cast see `call` invocation in eval.cpp + Pair *ret_addr = static_cast(*top_ptr)->addr; + Continuation *_cont = new Continuation(genvt, ret_addr, cont, body); + // Create local env and recall the closure + Environment *_envt = new Environment(envt); + // static_cast because the params is already checked + EvalObj *ppar, *nptr; + for (ppar = params; + ppar->is_pair_obj(); + ppar = TO_PAIR(ppar)->cdr) + { + if ((nptr = args->cdr) != empty_list) + args = TO_PAIR(nptr); + else break; + _envt->add_binding(static_cast(TO_PAIR(ppar)->car), args->car); + } - if (ppar->is_sym_obj()) - _envt->add_binding(static_cast(ppar), args->cdr); // (... . var_n) - else if (args->cdr != empty_list || ppar != empty_list) - throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); + if (ppar->is_sym_obj()) + _envt->add_binding(static_cast(ppar), args->cdr); // (... . var_n) + else if (args->cdr != empty_list || ppar != empty_list) + throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS); - genvt = _envt; - cont = _cont; - *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont - return body; // Move pc to the proc entry point - } + genvt = _envt; + cont = _cont; + *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont + return body; // Move pc to the proc entry point +} ReprCons *ProcObj::get_repr_cons() { return new ReprStr("#"); @@ -212,7 +215,17 @@ ReprCons *BuiltinProcObj::get_repr_cons() { return new ReprStr("#"); } -Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {} +Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) { + gc.attach(prev_envt); +} + +Environment::~Environment() { + gc.expose(prev_envt); +} + +ReprCons *Environment::get_repr_cons() { + return new ReprStr("#"); +} bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) { bool found = false; @@ -224,7 +237,10 @@ bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) { bool has_key = ptr->binding.count(name); if (has_key) { - ptr->binding[name] = eval_obj; + EvalObj * &ref = ptr->binding[name]; + gc.expose(ref); + ref = eval_obj; + gc.attach(ref); found = true; break; } @@ -233,7 +249,18 @@ bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) { } else { - binding[name] = eval_obj; + if (!binding.count(name)) + { + binding[name] = eval_obj; + gc.attach(eval_obj); + } + else + { + EvalObj * &ref = binding[name]; + gc.expose(ref); + ref = eval_obj; + gc.attach(ref); + } return true; } } @@ -253,17 +280,27 @@ EvalObj *Environment::get_obj(EvalObj *obj) { } Continuation::Continuation(Environment *_envt, Pair *_pc, - Continuation *_prev_cont, - Pair *_proc_body) : - prev_cont(_prev_cont), envt(_envt), pc(_pc), - proc_body(_proc_body) {} - - ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {} - ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; } - EvalObj *ReprStr::next(const string &prev) { - throw NormalError(INT_ERR); + Continuation *_prev_cont, Pair *_proc_body) : + prev_cont(_prev_cont), envt(_envt), pc(_pc), proc_body(_proc_body) { + gc.attach(prev_cont); + gc.attach(envt); } +Continuation::~Continuation() { + gc.expose(prev_cont); + gc.expose(envt); +} + +ReprCons *Continuation::get_repr_cons() { + return new ReprStr("#"); +} + +ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {} +ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; } +EvalObj *ReprStr::next(const string &prev) { + throw NormalError(INT_ERR); +} + PairReprCons::PairReprCons(Pair *_ptr, EvalObj *_ori) : ReprCons(false, _ori), state(0), ptr(_ptr) {} @@ -324,8 +361,8 @@ VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) : PromObj::PromObj(EvalObj *exp) : EvalObj(CLS_SIM_OBJ | CLS_PROM_OBJ), entry(new Pair(exp, empty_list)), mem(NULL) { - entry->next = NULL; -} + entry->next = NULL; + } Pair *PromObj::get_entry() { return entry; } @@ -421,13 +458,13 @@ CompNumObj::CompNumObj(double _real, double _imag) : #ifndef GMP_SUPPORT real = int_ptr->val; #else - real = int_ptr->val.get_d(); + real = int_ptr->val.get_d(); #endif else if ((rat_ptr = RatNumObj::from_string(real_str))) #ifndef GMP_SUPPORT real = rat_ptr->a / double(rat_ptr->b); #else - real = rat_ptr->val.get_d(); + real = rat_ptr->val.get_d(); #endif else if ((real_ptr = RealNumObj::from_string(real_str))) real = real_ptr->real; @@ -440,13 +477,13 @@ CompNumObj::CompNumObj(double _real, double _imag) : #ifndef GMP_SUPPORT imag = int_ptr->val; #else - imag = int_ptr->val.get_d(); + imag = int_ptr->val.get_d(); #endif else if ((rat_ptr = RatNumObj::from_string(imag_str))) #ifndef GMP_SUPPORT imag = rat_ptr->a / double(rat_ptr->b); #else - imag = rat_ptr->val.get_d(); + imag = rat_ptr->val.get_d(); #endif else if ((real_ptr = RealNumObj::from_string(imag_str))) imag = real_ptr->real; @@ -661,8 +698,8 @@ RatNumObj *RatNumObj::from_string(string repr) { #else RatNumObj::RatNumObj(mpq_class _val) : ExactNumObj(NUM_LVL_RAT), val(_val) { - val.canonicalize(); -} + val.canonicalize(); + } RatNumObj *RatNumObj::from_string(string repr) { try diff --git a/types.h b/types.h index 11776ab..e6a541c 100644 --- a/types.h +++ b/types.h @@ -25,6 +25,9 @@ const int CLS_CHAR_OBJ = 1 << 6; const int CLS_STR_OBJ = 1 << 7; const int CLS_VECT_OBJ = 1 << 8; +const int CLS_CONT_OBJ = 1 << 9; +const int CLS_ENVT_OBJ = 1 << 10; + static const int NUM_LVL_COMP = 0; static const int NUM_LVL_REAL = 1; static const int NUM_LVL_RAT = 2; @@ -323,7 +326,7 @@ class PromObj: public EvalObj {/*{{{*/ /** @class Environment * The environment of current evaluation, i.e. the local variable binding */ -class Environment {/*{{{*/ +class Environment : public EvalObj{/*{{{*/ private: Environment *prev_envt; /**< Pointer to the upper-level environment */ Str2EvalObj binding; /**< Store all pairs of identifier and its @@ -333,6 +336,7 @@ class Environment {/*{{{*/ * @param prev_envt the outer environment */ Environment(Environment *prev_envt); + ~Environment(); /** Add a binding entry which binds sym_obj to eval_obj * @param def true to force the assignment * @return when def is set to false, this return value is true iff. the @@ -344,6 +348,7 @@ class Environment {/*{{{*/ * @param obj the object as request * */ EvalObj *get_obj(EvalObj *obj); + ReprCons *get_repr_cons(); };/*}}}*/ /** @class Continuation @@ -351,7 +356,7 @@ class Environment {/*{{{*/ * being made (Behave like a stack frame in C). When the call has accomplished, * the system will restore all the registers according to the continuation. */ -class Continuation {/*{{{*/ +class Continuation : public EvalObj {/*{{{*/ public: /** Linking the previous continuation on the chain */ Continuation *prev_cont; @@ -365,6 +370,8 @@ class Continuation {/*{{{*/ /** Create a continuation */ Continuation(Environment *envt, Pair *pc, Continuation *prev_cont, Pair *proc_body); + ~Continuation(); + ReprCons *get_repr_cons(); };/*}}}*/ /** @class InexactNumObj -- cgit v1.2.3 From 55d1072441582936d119ed04fd8c532c2760b9d4 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 20:37:38 +0800 Subject: ... --- builtin.cpp | 34 ++++++++++++++++++++++++++++++++-- eval.cpp | 4 ++++ main.cpp | 8 ++++++++ parser.cpp | 1 + types.cpp | 32 ++++++++++++++++++++++++-------- types.h | 2 ++ 6 files changed, 71 insertions(+), 10 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index e9669b5..8a94a53 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -47,6 +47,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, if (ret_info->state == empty_list) { *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); + gc.expose(args); return ret_addr->next; // Move to the next instruction } else @@ -62,6 +63,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, // Undo pop and invoke again top_ptr += 2; ret_info->state = empty_list; + gc.expose(args); return second; } else if (third != empty_list) @@ -70,11 +72,13 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, // Undo pop and invoke again top_ptr += 2; ret_info->state = empty_list; + gc.expose(args); return third; } else { *top_ptr++ = gc.attach(unspec_obj); + gc.expose(args); return ret_addr->next; } } @@ -84,6 +88,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } throw NormalError(INT_ERR); @@ -162,6 +167,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &envt, ptr->next = NULL; // Make each expression isolated *top_ptr++ = gc.attach(new ProcObj(body, envt, params)); + gc.expose(args); return ret_addr->next; // Move to the next instruction } @@ -199,6 +205,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } if (!first->is_sym_obj()) @@ -235,6 +242,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, } envt->add_binding(id, obj); *top_ptr++ = unspec_obj; + gc.expose(args); return ret_addr->next; } @@ -268,6 +276,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } @@ -279,6 +288,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); *top_ptr++ = unspec_obj; + gc.expose(args); return ret_addr->next; } @@ -294,6 +304,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &envt, Pair *ret_addr = static_cast(*top_ptr)->addr; Pair *pc = static_cast(ret_addr->car); *top_ptr++ = TO_PAIR(pc->cdr)->car; + gc.expose(args); return ret_addr->next; } @@ -312,6 +323,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, if (ret_info->state) { *top_ptr++ = TO_PAIR(args->cdr)->car; + gc.expose(args); return ret_addr->next; // Move to the next instruction } else @@ -319,6 +331,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(args->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } throw NormalError(INT_ERR); @@ -338,6 +351,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, if (pc->cdr == empty_list) { *top_ptr++ = new BoolObj(true); + gc.expose(args); return ret_addr->next; } if (!ret_info->state) @@ -345,6 +359,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } EvalObj *ret = TO_PAIR(args->cdr)->car; @@ -353,6 +368,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, if (ret_info->state->cdr == empty_list) // the last member { *top_ptr++ = ret; + gc.expose(args); return ret_addr->next; } else @@ -360,12 +376,14 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } } else { *top_ptr++ = ret; + gc.expose(args); return ret_addr->next; } throw NormalError(INT_ERR); @@ -385,6 +403,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, if (pc->cdr == empty_list) { *top_ptr++ = new BoolObj(false); + gc.expose(args); return ret_addr->next; } if (!ret_info->state) @@ -392,6 +411,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } EvalObj *ret = TO_PAIR(args->cdr)->car; @@ -400,6 +420,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, if (ret_info->state->cdr == empty_list) // the last member { *top_ptr++ = ret; + gc.expose(args); return ret_addr->next; } else @@ -407,12 +428,14 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; + gc.expose(args); return ret_info->state; } } else { *top_ptr++ = ret; + gc.expose(args); return ret_addr->next; } throw NormalError(INT_ERR); @@ -422,8 +445,9 @@ SpecialOptApply::SpecialOptApply() : SpecialOptObj("apply") {} void SpecialOptApply::prepare(Pair *pc) {} -Pair *SpecialOptApply::call(Pair *args, Environment * &envt, +Pair *SpecialOptApply::call(Pair *_args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { + Pair *args = _args; top_ptr++; // Recover the return address if (args->cdr == empty_list) throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); @@ -458,6 +482,7 @@ Pair *SpecialOptApply::call(Pair *args, Environment * &envt, throw TokenError("a list", RUN_ERR_WRONG_TYPE); } // force the invocation, so that the desired operator will take over + gc.expose(_args); return NULL; } @@ -469,8 +494,9 @@ void SpecialOptForce::prepare(Pair *pc) { throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); } -Pair *SpecialOptForce::call(Pair *args, Environment * &envt, +Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { + Pair *args = _args; args = TO_PAIR(args->cdr); RetAddr *ret_info = static_cast(*top_ptr); Pair *ret_addr = ret_info->addr; @@ -479,6 +505,7 @@ Pair *SpecialOptForce::call(Pair *args, Environment * &envt, EvalObj *mem = args->car; prom->feed_mem(mem); *top_ptr++ = mem; + gc.expose(_args); return ret_addr->next; // Move to the next instruction } else @@ -490,6 +517,7 @@ Pair *SpecialOptForce::call(Pair *args, Environment * &envt, if (mem) // fetch from memorized result { *top_ptr++ = mem; + gc.expose(_args); return ret_addr->next; } else // force @@ -497,6 +525,7 @@ Pair *SpecialOptForce::call(Pair *args, Environment * &envt, top_ptr += 2; ret_info->state = prom->get_entry(); ret_info->state->next = NULL; + gc.expose(_args); return ret_info->state; } } @@ -516,6 +545,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &envt, Pair *ret_addr = static_cast(*top_ptr)->addr; Pair *pc = static_cast(ret_addr->car); *top_ptr++ = new PromObj(TO_PAIR(pc->cdr)->car); + gc.expose(args); return ret_addr->next; // Move to the next instruction } diff --git a/eval.cpp b/eval.cpp index 2f5921d..e21ae7b 100644 --- a/eval.cpp +++ b/eval.cpp @@ -2,6 +2,7 @@ #include "builtin.h" #include "exc.h" #include "consts.h" +#include "gc.h" #include extern Pair *empty_list; @@ -109,6 +110,7 @@ inline bool make_exec(Pair *ptr) { } inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { + gc.attach(pc); // if (pc->car == NULL) // puts("oops"); if (pc->car->is_simple_obj()) // Not an opt invocation @@ -180,6 +182,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) { } else { + gc.attach(args); EvalObj *opt = args->car; if (opt->is_opt_obj()) pc = static_cast(opt)-> @@ -189,6 +192,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) { } } } + gc.expose(prog); // static_cast because the previous while condition return static_cast(*(eval_stack)); } diff --git a/main.cpp b/main.cpp index a193b68..7549daa 100644 --- a/main.cpp +++ b/main.cpp @@ -48,8 +48,15 @@ void print_help(const char *cmd) { exit(0); } +EmptyList *empty_list = new EmptyList(); +UnspecObj *unspec_obj = new UnspecObj(); + int main(int argc, char **argv) { + freopen("in.scm", "r", stdin); + gc.attach(empty_list); + gc.attach(unspec_obj); + for (int i = 1; i < argc; i++) { if (*argv[i] == '-') // parsing options @@ -96,5 +103,6 @@ int main(int argc, char **argv) { { fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str()); } + gc.force(); } } diff --git a/parser.cpp b/parser.cpp index 333311e..6abc1c0 100644 --- a/parser.cpp +++ b/parser.cpp @@ -5,6 +5,7 @@ #include "exc.h" #include "consts.h" #include "builtin.h" +#include "gc.h" using std::stringstream; diff --git a/types.cpp b/types.cpp index e3a7542..1548805 100644 --- a/types.cpp +++ b/types.cpp @@ -12,16 +12,24 @@ const double EPS = 1e-16; const int PREC = 16; -EmptyList *empty_list = new EmptyList(); -UnspecObj *unspec_obj = new UnspecObj(); +extern EmptyList *empty_list; +extern UnspecObj *unspec_obj; -Pair::Pair(EvalObj *_car, EvalObj *_cdr) : - EvalObj(CLS_PAIR_OBJ), car(_car), cdr(_cdr), - next(NULL) {} +Pair::Pair(EvalObj *_car, EvalObj *_cdr) : EvalObj(CLS_PAIR_OBJ), + car(_car), cdr(_cdr), next(NULL) { - ReprCons *Pair::get_repr_cons() { - return new PairReprCons(this, this); - } + gc.attach(car); + gc.attach(cdr); +} + +Pair::~Pair() { + gc.expose(car); + gc.expose(cdr); +} + +ReprCons *Pair::get_repr_cons() { + return new PairReprCons(this, this); +} ParseBracket::ParseBracket(unsigned char _btype) : @@ -49,6 +57,12 @@ ProcObj::ProcObj(Pair *_body, Environment *_envt, EvalObj *_params) : gc.attach(envt); } +ProcObj::~ProcObj() { + gc.expose(body); + gc.expose(params); + gc.expose(envt); +} + Pair *ProcObj::call(Pair *args, Environment * &genvt, Continuation * &cont, FrameObj ** &top_ptr) { // Create a new continuation @@ -77,6 +91,7 @@ Pair *ProcObj::call(Pair *args, Environment * &genvt, genvt = _envt; cont = _cont; *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont + gc.expose(args); return body; // Move pc to the proc entry point } @@ -208,6 +223,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : Pair *ret_addr = static_cast(*top_ptr)->addr; *top_ptr++ = handler(TO_PAIR(args->cdr), name); + gc.expose(args); return ret_addr->next; // Move to the next instruction } diff --git a/types.h b/types.h index e6a541c..1519242 100644 --- a/types.h +++ b/types.h @@ -51,6 +51,7 @@ class Pair : public EvalObj {/*{{{*/ Pair* next; /**< The next branch in effect */ Pair(EvalObj *car, EvalObj *cdr); /**< Create a Pair (car . cdr) */ + ~Pair(); ReprCons *get_repr_cons(); };/*}}}*/ @@ -163,6 +164,7 @@ class ProcObj: public OptObj {/*{{{*/ /** Conctructs a ProcObj */ ProcObj(Pair *body, Environment *envt, EvalObj *params); + ~ProcObj(); Pair *call(Pair *args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr); ReprCons *get_repr_cons(); -- cgit v1.2.3 From d4d9eee6bef1bc9169e765c9bf3d2382a70198c2 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 21:34:55 +0800 Subject: ... --- eval.cpp | 11 +++++++---- gc.cpp | 30 ++++++++++++++++++++++-------- gc.h | 3 ++- types.cpp | 10 ++++++++-- 4 files changed, 39 insertions(+), 15 deletions(-) diff --git a/eval.cpp b/eval.cpp index e21ae7b..7370187 100644 --- a/eval.cpp +++ b/eval.cpp @@ -110,13 +110,11 @@ inline bool make_exec(Pair *ptr) { } inline void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) { - gc.attach(pc); // if (pc->car == NULL) // puts("oops"); if (pc->car->is_simple_obj()) // Not an opt invocation { - *top_ptr = envt->get_obj(pc->car); // Objectify the symbol - top_ptr++; + *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"); @@ -152,6 +150,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) { Continuation *cont = NULL; // envt is this->envt push(pc, top_ptr, envt); + gc.attach(prog); while((*eval_stack)->is_ret_addr()) { @@ -163,7 +162,11 @@ EvalObj *Evaluator::run_expr(Pair *prog) { { Pair *args = empty_list; while (!(*(--top_ptr))->is_ret_addr()) - args = new Pair(static_cast(*top_ptr), args); + { + EvalObj* obj = static_cast(*top_ptr); + gc.expose(obj); + args = new Pair(obj, args); + } //< static_cast because the while condition RetAddr *ret_addr = static_cast(*top_ptr); if (!ret_addr->addr) diff --git a/gc.cpp b/gc.cpp index a5fdc48..5aed8b8 100644 --- a/gc.cpp +++ b/gc.cpp @@ -13,39 +13,46 @@ GarbageCollector::GarbageCollector() { mapping.clear(); pend_cnt = 0; pending_list = NULL; + collecting = false; } GarbageCollector::PendingEntry::PendingEntry( EvalObj *_obj, PendingEntry *_next) : obj(_obj), next(_next) {} -void GarbageCollector::expose(EvalObj *ptr, bool delay) { +void GarbageCollector::expose(EvalObj *ptr) { bool flag = mapping.count(ptr); if (flag) { - if (!--mapping[ptr] && !delay) +#ifdef GC_DEBUG + fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", + (ull)ptr, mapping[ptr], ptr->ext_repr().c_str()); +#endif + if (!--mapping[ptr] && collecting) { #ifdef GC_DEBUG fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr); #endif pending_list = new PendingEntry(ptr, pending_list); - if (++pend_cnt == GC_QUEUE_SIZE >> 1) - force(); // the gc queue may overflow - } + } } } void GarbageCollector::force() { EvalObj **l = gcq, **r = l; - for (PendingEntry *p = pending_list, *np; p; p = np) +/* for (PendingEntry *p = pending_list, *np; p; p = np) { np = p->next; *r++ = p->obj; delete p; } // fetch the pending pointers in the list // clear the list - pending_list = NULL; + pending_list = NULL; */ + for (EvalObj2Int::iterator it = mapping.begin(); + it != mapping.end(); it++) + if (it->second == 0) *r++ = it->first; + collecting = true; #ifdef GC_DEBUG size_t cnt = 0; fprintf(stderr, "GC: Forcing the clear process...\n"); @@ -57,6 +64,7 @@ void GarbageCollector::force() { cnt++; #endif delete *l; + mapping.erase(*l); // maybe it's a complex structure, // so that more pointers are reported for (PendingEntry *p = pending_list, *np; p; p = np) @@ -70,8 +78,14 @@ void GarbageCollector::force() { pending_list = NULL; } #ifdef GC_DEBUG - fprintf(stderr, "GC: Forced clear, %lu objects are freed\n", cnt); + fprintf(stderr, "GC: Forced clear, %lu objects are freed, " + "%lu remains\n", cnt, mapping.size()); +/* for (EvalObj2Int::iterator it = mapping.begin(); + it != mapping.end(); it++) + fprintf(stderr, "%llx => %lu\n", (ull)it->first, it->second); + */ #endif + collecting = false; } EvalObj *GarbageCollector::attach(EvalObj *ptr) { diff --git a/gc.h b/gc.h index c017156..8380210 100644 --- a/gc.h +++ b/gc.h @@ -19,11 +19,12 @@ class GarbageCollector { EvalObj2Int mapping; size_t pend_cnt; PendingEntry *pending_list; + bool collecting; public: GarbageCollector(); void force(); - void expose(EvalObj *ptr, bool delay = false); + void expose(EvalObj *ptr); EvalObj *attach(EvalObj *ptr); }; diff --git a/types.cpp b/types.cpp index 1548805..84106df 100644 --- a/types.cpp +++ b/types.cpp @@ -90,9 +90,13 @@ Pair *ProcObj::call(Pair *args, Environment * &genvt, genvt = _envt; cont = _cont; - *top_ptr++ = new RetAddr(NULL); // Mark the entrance of a cont + + gc.expose(static_cast(*(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); - return body; // Move pc to the proc entry point + return body; // Move pc to the proc entry point } ReprCons *ProcObj::get_repr_cons() { @@ -222,6 +226,8 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) : Continuation * &cont, FrameObj ** &top_ptr) { Pair *ret_addr = static_cast(*top_ptr)->addr; + gc.expose(static_cast(*(top_ptr + 1))); + delete *top_ptr; *top_ptr++ = handler(TO_PAIR(args->cdr), name); gc.expose(args); return ret_addr->next; // Move to the next instruction -- cgit v1.2.3 From 6db7a6a158513b85f99ec2e2f9363bf2063f5133 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 22:11:42 +0800 Subject: ... --- builtin.cpp | 49 ++++++++++++++++++++++++++++++++++++++----------- gc.cpp | 2 +- 2 files changed, 39 insertions(+), 12 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index 8a94a53..9ebbf28 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -46,6 +46,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { if (ret_info->state == empty_list) { + delete *top_ptr; *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); gc.expose(args); return ret_addr->next; // Move to the next instruction @@ -61,7 +62,8 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { second->next = NULL; // Undo pop and invoke again - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = empty_list; gc.expose(args); return second; @@ -70,13 +72,15 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { third->next = NULL; // Undo pop and invoke again - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = empty_list; gc.expose(args); return third; } else { + delete *top_ptr; *top_ptr++ = gc.attach(unspec_obj); gc.expose(args); return ret_addr->next; @@ -85,7 +89,8 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, } else { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -166,6 +171,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &envt, for (Pair *ptr = body; ptr != empty_list; ptr = TO_PAIR(ptr->cdr)) ptr->next = NULL; // Make each expression isolated + delete *top_ptr; *top_ptr++ = gc.attach(new ProcObj(body, envt, params)); gc.expose(args); return ret_addr->next; // Move to the next instruction @@ -202,7 +208,8 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, { if (!ret_info->state) { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -241,6 +248,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, obj = new ProcObj(body, envt, params); } envt->add_binding(id, obj); + delete *top_ptr; *top_ptr++ = unspec_obj; gc.expose(args); return ret_addr->next; @@ -273,7 +281,8 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &envt, if (!ret_info->state) { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -287,6 +296,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; gc.expose(args); return ret_addr->next; @@ -303,6 +313,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Pair *ret_addr = static_cast(*top_ptr)->addr; Pair *pc = static_cast(ret_addr->car); + delete *top_ptr; *top_ptr++ = TO_PAIR(pc->cdr)->car; gc.expose(args); return ret_addr->next; @@ -322,13 +333,15 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, Pair *ret_addr = ret_info->addr; if (ret_info->state) { + delete *top_ptr; *top_ptr++ = TO_PAIR(args->cdr)->car; gc.expose(args); return ret_addr->next; // Move to the next instruction } else { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(args->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -350,13 +363,15 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, Pair *pc = static_cast(ret_addr->car); if (pc->cdr == empty_list) { + delete *top_ptr; *top_ptr++ = new BoolObj(true); gc.expose(args); return ret_addr->next; } if (!ret_info->state) { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -367,13 +382,15 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, { if (ret_info->state->cdr == empty_list) // the last member { + delete *top_ptr; *top_ptr++ = ret; gc.expose(args); return ret_addr->next; } else { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -382,6 +399,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, } else { + delete *top_ptr; *top_ptr++ = ret; gc.expose(args); return ret_addr->next; @@ -402,13 +420,15 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, Pair *pc = static_cast(ret_addr->car); if (pc->cdr == empty_list) { + delete *top_ptr; *top_ptr++ = new BoolObj(false); gc.expose(args); return ret_addr->next; } if (!ret_info->state) { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -419,13 +439,15 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, { if (ret_info->state->cdr == empty_list) // the last member { + delete *top_ptr; *top_ptr++ = ret; gc.expose(args); return ret_addr->next; } else { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; gc.expose(args); @@ -434,6 +456,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, } else { + delete *top_ptr; *top_ptr++ = ret; gc.expose(args); return ret_addr->next; @@ -504,6 +527,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, { EvalObj *mem = args->car; prom->feed_mem(mem); + delete *top_ptr; *top_ptr++ = mem; gc.expose(_args); return ret_addr->next; // Move to the next instruction @@ -516,13 +540,15 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, EvalObj *mem = prom->get_mem(); if (mem) // fetch from memorized result { + delete *top_ptr; *top_ptr++ = mem; gc.expose(_args); return ret_addr->next; } else // force { - top_ptr += 2; + gc.attach(*(++top_ptr)); + top_ptr++; ret_info->state = prom->get_entry(); ret_info->state->next = NULL; gc.expose(_args); @@ -544,6 +570,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &envt, Continuation * &cont, FrameObj ** &top_ptr) { Pair *ret_addr = static_cast(*top_ptr)->addr; Pair *pc = static_cast(ret_addr->car); + delete *top_ptr; *top_ptr++ = new PromObj(TO_PAIR(pc->cdr)->car); gc.expose(args); return ret_addr->next; // Move to the next instruction diff --git a/gc.cpp b/gc.cpp index 5aed8b8..ec49917 100644 --- a/gc.cpp +++ b/gc.cpp @@ -26,7 +26,7 @@ void GarbageCollector::expose(EvalObj *ptr) { { #ifdef GC_DEBUG fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", - (ull)ptr, mapping[ptr], ptr->ext_repr().c_str()); + (ull)ptr, mapping[ptr] - 1, ptr->ext_repr().c_str()); #endif if (!--mapping[ptr] && collecting) { -- cgit v1.2.3 From ca12d00e80d76214d44443bf4f5e62554e526089 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 22:13:25 +0800 Subject: ... --- builtin.cpp | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index 9ebbf28..3d4129f 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -62,7 +62,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { second->next = NULL; // Undo pop and invoke again - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = empty_list; gc.expose(args); @@ -72,7 +72,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, { third->next = NULL; // Undo pop and invoke again - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = empty_list; gc.expose(args); @@ -89,7 +89,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &envt, } else { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(ret_addr->car)->cdr); ret_info->state->next = NULL; @@ -208,7 +208,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &envt, { if (!ret_info->state) { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; @@ -281,7 +281,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &envt, if (!ret_info->state) { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(TO_PAIR(pc->cdr)->cdr); ret_info->state->next = NULL; @@ -340,7 +340,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, } else { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(args->cdr); ret_info->state->next = NULL; @@ -370,7 +370,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, } if (!ret_info->state) { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; @@ -389,7 +389,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &envt, } else { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; @@ -427,7 +427,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, } if (!ret_info->state) { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(pc->cdr); ret_info->state->next = NULL; @@ -446,7 +446,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &envt, } else { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(ret_info->state->cdr); ret_info->state->next = NULL; @@ -547,7 +547,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &envt, } else // force { - gc.attach(*(++top_ptr)); + gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = prom->get_entry(); ret_info->state->next = NULL; -- cgit v1.2.3 From 79a2ecc929b30ae40f9324c258d8ded99ecde259 Mon Sep 17 00:00:00 2001 From: Teddy Date: Tue, 13 Aug 2013 00:31:11 +0800 Subject: gc can now work --- Makefile | 2 +- builtin.cpp | 34 +++++++++++++++++----------------- eval.cpp | 10 +++++++++- gc.cpp | 20 ++++++++++++++------ main.cpp | 10 +++++++--- types.cpp | 18 ++++++++++++------ 6 files changed, 60 insertions(+), 34 deletions(-) diff --git a/Makefile b/Makefile index acdab1a..4d4db95 100644 --- a/Makefile +++ b/Makefile @@ -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(*top_ptr)->addr; Pair *pc = static_cast(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(*top_ptr)->addr; Pair *pc = static_cast(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 } diff --git a/eval.cpp b/eval.cpp index 7370187..5112232 100644 --- a/eval.cpp +++ b/eval.cpp @@ -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++; diff --git a/gc.cpp b/gc.cpp index ec49917..3fa1402 100644 --- a/gc.cpp +++ b/gc.cpp @@ -2,7 +2,7 @@ #include "exc.h" #include "consts.h" -#ifdef GC_DEBUG +#if defined(GC_DEBUG) || defined (GC_INFO) #include 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 } diff --git a/main.cpp b/main.cpp index 7549daa..15a877e 100644 --- a/main.cpp +++ b/main.cpp @@ -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) diff --git a/types.cpp b/types.cpp index 84106df..8ccf2ab 100644 --- a/types.cpp +++ b/types.cpp @@ -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 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(*(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(*top_ptr)->addr; - gc.expose(static_cast(*(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); } -- cgit v1.2.3 From d6765d8d42bd543b414d6ae54392247dd26da649 Mon Sep 17 00:00:00 2001 From: Teddy Date: Tue, 13 Aug 2013 10:25:53 +0800 Subj