From 4d3ed205fc2b86180f81fea388e488f5fa96cef9 Mon Sep 17 00:00:00 2001 From: Teddy Date: Mon, 12 Aug 2013 19:37:57 +0800 Subject: basic gc --- builtin.cpp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'builtin.cpp') 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 } -- 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 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) (limited to 'builtin.cpp') 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 } -- 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 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 11 deletions(-) (limited to 'builtin.cpp') 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 -- 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(-) (limited to 'builtin.cpp') 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 --- builtin.cpp | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) (limited to 'builtin.cpp') 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 } -- cgit v1.2.3 From bac19b8e0e820ef748439891f6bbd46aabb4fcf7 Mon Sep 17 00:00:00 2001 From: Teddy Date: Tue, 13 Aug 2013 14:34:15 +0800 Subject: in-place arithmetic opt & fix gc bug in `eval` --- builtin.cpp | 210 ++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 155 insertions(+), 55 deletions(-) (limited to 'builtin.cpp') diff --git a/builtin.cpp b/builtin.cpp index dc1c5c9..7a4a78a 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -333,6 +333,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, Pair *ret_addr = ret_info->addr; if (ret_info->state) { + gc.expose(ret_info->state); // Exec done delete *top_ptr; *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car); gc.expose(args); @@ -343,6 +344,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &envt, gc.attach(static_cast(*(++top_ptr))); top_ptr++; ret_info->state = TO_PAIR(args->cdr); + gc.attach(ret_info->state); // Or it will be released ret_info->state->next = NULL; gc.expose(args); return ret_info->state; @@ -620,7 +622,7 @@ BUILTIN_PROC_DEF(pair_cdr) { BUILTIN_PROC_DEF(make_list) { - return args; + return gc.attach(args); // Or it will be GCed } BUILTIN_PROC_DEF(num_add) { @@ -632,11 +634,16 @@ BUILTIN_PROC_DEF(num_add) { throw TokenError("a number", RUN_ERR_WRONG_TYPE); opr = static_cast(args->car); NumObj *_res = res; - if (_res->level < opr->level) - opr = _res->convert(opr); + if (res->level < opr->level) + { + res->add(opr = res->convert(opr)); + delete opr; + } else - _res = opr->convert(_res); - res = _res->add(opr); + { + (res = opr->convert(res))->add(opr); + delete _res; + } } return res; } @@ -647,12 +654,15 @@ BUILTIN_PROC_DEF(num_sub) { throw TokenError("a number", RUN_ERR_WRONG_TYPE); NumObj *res = static_cast(args->car), *opr; + res = res->clone(); args = TO_PAIR(args->cdr); if (args == empty_list) { - IntNumObj _zero(0); - NumObj *zero = res->convert(&_zero); - return zero->sub(res); + IntNumObj *_zero = new IntNumObj(0); + NumObj *zero = res->convert(_zero); + if (zero != _zero) delete _zero; + zero->sub(res); + return zero; } for (; args != empty_list; args = TO_PAIR(args->cdr)) { @@ -661,16 +671,20 @@ BUILTIN_PROC_DEF(num_sub) { opr = static_cast(args->car); // upper type conversion NumObj *_res = res; - if (_res->level < opr->level) - opr = _res->convert(opr); + if (res->level < opr->level) + { + res->sub(opr = res->convert(opr)); + delete opr; + } else - _res = opr->convert(_res); - res = _res->sub(opr); + { + (res = opr->convert(res))->sub(opr); + delete _res; + } } return res; } - BUILTIN_PROC_DEF(num_mul) { // ARGS_AT_LEAST_ONE; NumObj *res = new IntNumObj(1), *opr; // the most accurate type @@ -680,11 +694,16 @@ BUILTIN_PROC_DEF(num_mul) { throw TokenError("a number", RUN_ERR_WRONG_TYPE); opr = static_cast(args->car); NumObj *_res = res; - if (_res->level < opr->level) - opr = _res->convert(opr); + if (res->level < opr->level) + { + res->mul(opr = res->convert(opr)); + delete opr; + } else - _res = opr->convert(_res); - res = _res->mul(opr); + { + (res = opr->convert(res))->mul(opr); + delete _res; + } } return res; } @@ -693,13 +712,20 @@ BUILTIN_PROC_DEF(num_div) { ARGS_AT_LEAST_ONE; if (!args->car->is_num_obj()) throw TokenError("a number", RUN_ERR_WRONG_TYPE); + NumObj *res = static_cast(args->car), *opr; + if (res->level > NUM_LVL_RAT) + res = new RatNumObj(static_cast(res)->val); + else res = res->clone(); + args = TO_PAIR(args->cdr); if (args == empty_list) { - IntNumObj _one(1); - NumObj *one = res->convert(&_one); - return one->div(res); + IntNumObj *_one = new IntNumObj(1); + NumObj *one = res->convert(_one); + if (one != _one) delete _one; + one->div(res); + return one; } for (; args != empty_list; args = TO_PAIR(args->cdr)) { @@ -708,15 +734,21 @@ BUILTIN_PROC_DEF(num_div) { opr = static_cast(args->car); // upper type conversion NumObj *_res = res; - if (_res->level < opr->level) - opr = _res->convert(opr); + if (res->level < opr->level) + { + res->div(opr = res->convert(opr)); + delete opr; + } else - _res = opr->convert(_res); - res = _res->div(opr); + { + (res = opr->convert(res))->div(opr); + delete _res; + } } return res; } + BUILTIN_PROC_DEF(num_le) { if (args == empty_list) return new BoolObj(true); @@ -733,16 +765,28 @@ BUILTIN_PROC_DEF(num_le) { opr = static_cast(args->car); // upper type conversion if (last->level < opr->level) - opr = last->convert(opr); + { + if (!last->le(opr = last->convert(opr))) + { + delete opr; + return new BoolObj(false); + } + else delete opr; + } else - last = opr->convert(last); - if (!last->le(opr)) - return new BoolObj(false); + { + if (!(last = opr->convert(last))->le(opr)) + { + delete last; + return new BoolObj(false); + } + else delete last; + } } return new BoolObj(true); } -BUILTIN_PROC_DEF(num_ge) { +BUILTIN_PROC_DEF(num_lt) { if (args == empty_list) return new BoolObj(true); // zero arguments @@ -758,17 +802,28 @@ BUILTIN_PROC_DEF(num_ge) { opr = static_cast(args->car); // upper type conversion if (last->level < opr->level) - opr = last->convert(opr); + { + if (!last->lt(opr = last->convert(opr))) + { + delete opr; + return new BoolObj(false); + } + else delete opr; + } else - last = opr->convert(last); - if (!last->ge(opr)) - return new BoolObj(false); + { + if (!(last = opr->convert(last))->lt(opr)) + { + delete last; + return new BoolObj(false); + } + else delete last; + } } return new BoolObj(true); } - -BUILTIN_PROC_DEF(num_lt) { +BUILTIN_PROC_DEF(num_ge) { if (args == empty_list) return new BoolObj(true); // zero arguments @@ -784,11 +839,23 @@ BUILTIN_PROC_DEF(num_lt) { opr = static_cast(args->car); // upper type conversion if (last->level < opr->level) - opr = last->convert(opr); + { + if (!last->ge(opr = last->convert(opr))) + { + delete opr; + return new BoolObj(false); + } + else delete opr; + } else - last = opr->convert(last); - if (!last->lt(opr)) - return new BoolObj(false); + { + if (!(last = opr->convert(last))->ge(opr)) + { + delete last; + return new BoolObj(false); + } + else delete last; + } } return new BoolObj(true); } @@ -809,11 +876,23 @@ BUILTIN_PROC_DEF(num_gt) { opr = static_cast(args->car); // upper type conversion if (last->level < opr->level) - opr = last->convert(opr); + { + if (!last->gt(opr = last->convert(opr))) + { + delete opr; + return new BoolObj(false); + } + else delete opr; + } else - last = opr->convert(last); - if (!last->gt(opr)) - return new BoolObj(false); + { + if (!(last = opr->convert(last))->gt(opr)) + { + delete last; + return new BoolObj(false); + } + else delete last; + } } return new BoolObj(true); } @@ -834,15 +913,28 @@ BUILTIN_PROC_DEF(num_eq) { opr = static_cast(args->car); // upper type conversion if (last->level < opr->level) - opr = last->convert(opr); + { + if (!last->eq(opr = last->convert(opr))) + { + delete opr; + return new BoolObj(false); + } + else delete opr; + } else - last = opr->convert(last); - if (!last->eq(opr)) - return new BoolObj(false); + { + if (!(last = opr->convert(last))->eq(opr)) + { + delete last; + return new BoolObj(false); + } + else delete last; + } } return new BoolObj(true); } + BUILTIN_PROC_DEF(bool_not) { ARGS_EXACTLY_ONE; return new BoolObj(!args->car->is_true()); @@ -1206,7 +1298,9 @@ BUILTIN_PROC_DEF(is_integer) { BUILTIN_PROC_DEF(num_abs) { ARGS_EXACTLY_ONE; CHECK_NUMBER(args->car); - return static_cast(args->car)->abs(); + NumObj* num = static_cast(args->car)->clone(); + num->abs(); + return num; } BUILTIN_PROC_DEF(num_mod) { @@ -1217,7 +1311,9 @@ BUILTIN_PROC_DEF(num_mod) { NumObj* b = static_cast(TO_PAIR(args->cdr)->car); CHECK_INT(a); CHECK_INT(b); - return static_cast(a)->mod(b); + NumObj* res = a->clone(); + static_cast(res)->mod(b); + return res; } BUILTIN_PROC_DEF(num_rem) { @@ -1228,7 +1324,9 @@ BUILTIN_PROC_DEF(num_rem) { NumObj* b = static_cast(TO_PAIR(args->cdr)->car); CHECK_INT(a); CHECK_INT(b); - return static_cast(a)->rem(b); + NumObj* res = a->clone(); + static_cast(res)->rem(b); + return res; } BUILTIN_PROC_DEF(num_quo) { @@ -1239,12 +1337,14 @@ BUILTIN_PROC_DEF(num_quo) { NumObj* b = static_cast(TO_PAIR(args->cdr)->car); CHECK_INT(a); CHECK_INT(b); - return static_cast(a)->quo(b); + NumObj* res = a->clone(); + static_cast(res)->div(b); + return res; } BUILTIN_PROC_DEF(num_gcd) { // ARGS_AT_LEAST_ONE; - NumObj *res = new IntNumObj(0); + IntNumObj *res = new IntNumObj(0); IntNumObj *opr; for (;args != empty_list; args = TO_PAIR(args->cdr)) { @@ -1252,14 +1352,14 @@ BUILTIN_PROC_DEF(num_gcd) { CHECK_INT(static_cast(args->car)); opr = static_cast(args->car); - res = opr->gcd(res); + res->gcd(opr); } return res; } BUILTIN_PROC_DEF(num_lcm) { // ARGS_AT_LEAST_ONE; - NumObj *res = new IntNumObj(1); + IntNumObj *res = new IntNumObj(1); IntNumObj *opr; for (;args != empty_list; args = TO_PAIR(args->cdr)) { @@ -1267,7 +1367,7 @@ BUILTIN_PROC_DEF(num_lcm) { CHECK_INT(static_cast(args->car)); opr = static_cast(args->car); - res = opr->lcm(res); + res->lcm(opr); } return res; } -- cgit v1.2.3