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