diff options
| -rw-r--r-- | Makefile | 7 | ||||
| -rw-r--r-- | builtin.cpp | 7 | ||||
| -rw-r--r-- | consts.cpp | 3 | ||||
| -rw-r--r-- | consts.h | 3 | ||||
| -rw-r--r-- | eval.cpp | 2 | ||||
| -rw-r--r-- | gc.cpp | 11 | ||||
| -rw-r--r-- | gc.h | 3 | ||||
| -rw-r--r-- | main.cpp | 20 | ||||
| -rw-r--r-- | types.cpp | 143 | ||||
| -rw-r--r-- | types.h | 11 |
10 files changed, 134 insertions, 76 deletions
@@ -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 } @@ -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!" }; @@ -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[]; @@ -80,7 +80,7 @@ void Evaluator::add_builtin_routines() { ADD_BUILTIN_PROC("string<?", string_lt); ADD_BUILTIN_PROC("string<=?", string_le); 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); @@ -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; @@ -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); }; @@ -3,13 +3,15 @@ #include "parser.h" #include "eval.h" #include "exc.h" +#include "gc.h" #include <cstdio> #include <cstdlib> -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) @@ -2,6 +2,7 @@ #include "model.h" #include "exc.h" #include "consts.h" +#include "gc.h" #include <cmath> #include <cstdlib> @@ -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<RetAddr*>(*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<SymObj*> 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<SymObj*>(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<RetAddr*>(*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<SymObj*> 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<SymObj*>(TO_PAIR(ppar)->car), args->car); + } - if (ppar->is_sym_obj()) - _envt->add_binding(static_cast<SymObj*>(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<SymObj*>(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("#<Procedure>"); @@ -212,7 +215,17 @@ ReprCons *BuiltinProcObj::get_repr_cons() { return new ReprStr("#<Builtin Procedure: " + name + ">"); } -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("#<Environment>"); +} 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("#<Continuation>"); +} + +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 @@ -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 |