aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp34
-rw-r--r--eval.cpp10
-rw-r--r--gc.cpp20
-rw-r--r--main.cpp10
-rw-r--r--types.cpp18
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<RetAddr*>(*top_ptr)->addr;
Pair *pc = static_cast<Pair*>(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<RetAddr*>(*top_ptr)->addr;
Pair *pc = static_cast<Pair*>(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 <cstdio>
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<SymObj*> 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<EvalObj*>(*(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<RetAddr*>(*top_ptr)->addr;
- gc.expose(static_cast<EvalObj*>(*(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);
}