gc can now work

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);
 }