aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--builtin.cpp34
-rw-r--r--eval.cpp4
-rw-r--r--main.cpp8
-rw-r--r--parser.cpp1
-rw-r--r--types.cpp32
-rw-r--r--types.h2
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<RetAddr*>(*top_ptr)->addr;
Pair *pc = static_cast<Pair*>(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<RetAddr*>(*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<RetAddr*>(*top_ptr)->addr;
Pair *pc = static_cast<Pair*>(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 <cstdio>
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<OptObj*>(opt)->
@@ -189,6 +192,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
}
}
}
+ gc.expose(prog);
// static_cast because the previous while condition
return static_cast<EvalObj*>(*(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<RetAddr*>(*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();
Powered by cgit, Themed by Ted Yin.