basic gc

10 files changed, 134 insertions, 76 deletions

diff --git a/Makefile b/Makefile
index aeab6a0..acdab1a 100644
--- a/Makefile
+++ b/Makefile
@@ -1,8 +1,8 @@
-sonsi: main.o parser.o builtin.o model.o eval.o exc.o consts.o types.o
+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 -O2
+	g++ $< -c -g -pg -DGMP_SUPPORT -Wall -DGC_DEBUG
 
 clean:
 	rm -f *.o
@@ -13,3 +13,6 @@ db:
 
 cdb:
 	cgdb sonsi
+
+run:
+	./sonsi
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
 }
 
diff --git a/consts.cpp b/consts.cpp
index a04d5c7..fd835a4 100644
--- a/consts.cpp
+++ b/consts.cpp
@@ -19,5 +19,6 @@ const char *ERR_MSG[] = {
     "Queue overflowed: the expected expansion is too long!",
     "%s stack overflowed!",
     "Numeric overflow!",
-    "Value out of range"
+    "Value out of range",
+    "GC overflow!"
 };
diff --git a/consts.h b/consts.h
index b24e951..10cd951 100644
--- a/consts.h
+++ b/consts.h
@@ -20,7 +20,8 @@ enum ErrCode {
     RUN_ERR_QUEUE_OVERFLOW,
     RUN_ERR_STACK_OVERFLOW,
     RUN_ERR_NUMERIC_OVERFLOW,
-    RUN_ERR_VALUE_OUT_OF_RANGE
+    RUN_ERR_VALUE_OUT_OF_RANGE,
+    RUN_ERR_GC_OVERFLOW
 };
 
 extern const char *ERR_MSG[];
diff --git a/eval.cpp b/eval.cpp
index 2deb38c..2f5921d 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -80,7 +80,7 @@ void Evaluator::add_builtin_routines() {
     ADD_BUILTIN_PROC("string<?", string_lt);
     ADD_BUILTIN_PROC("string<=?", string_le);
     ADD_BUILTIN_PROC("string>?", string_gt);
-    ADD_BUILTIN_PROC("string<=?", string_ge);
+    ADD_BUILTIN_PROC("string>=?", string_ge);
     ADD_BUILTIN_PROC("string=?", string_eq);
 
     ADD_BUILTIN_PROC("make-vector", make_vector);
diff --git a/gc.cpp b/gc.cpp
index 4a3dd89..a5fdc48 100644
--- a/gc.cpp
+++ b/gc.cpp
@@ -9,15 +9,21 @@ typedef unsigned long long ull;
 
 static EvalObj *gcq[GC_QUEUE_SIZE];
 
+GarbageCollector::GarbageCollector() {
+    mapping.clear();
+    pend_cnt = 0;
+    pending_list = NULL;
+}
+
 GarbageCollector::PendingEntry::PendingEntry(
         EvalObj *_obj, PendingEntry *_next) : obj(_obj), next(_next) {}
 
 
-void GarbageCollector::expose(EvalObj *ptr) {
+void GarbageCollector::expose(EvalObj *ptr, bool delay) {
     bool flag = mapping.count(ptr);
     if (flag)
     {
-        if (!--mapping[ptr])
+        if (!--mapping[ptr] && !delay)
         {
 #ifdef GC_DEBUG
             fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr);
@@ -80,4 +86,3 @@ EvalObj *GarbageCollector::attach(EvalObj *ptr) {
     return ptr; // passing through
 }
 
-GarbageCollector gc;
diff --git a/gc.h b/gc.h
index 417462f..c017156 100644
--- a/gc.h
+++ b/gc.h
@@ -21,8 +21,9 @@ class GarbageCollector {
     PendingEntry *pending_list;
 
     public:
+    GarbageCollector();
     void force();
-    void expose(EvalObj *ptr);
+    void expose(EvalObj *ptr, bool delay = false);
     EvalObj *attach(EvalObj *ptr);
 };
 
diff --git a/main.cpp b/main.cpp
index 78515a6..a193b68 100644
--- a/main.cpp
+++ b/main.cpp
@@ -3,13 +3,15 @@
 #include "parser.h"
 #include "eval.h"
 #include "exc.h"
+#include "gc.h"
 
 #include <cstdio>
 #include <cstdlib>
 
-Tokenizor *tk = new Tokenizor();
-ASTGenerator *ast = new ASTGenerator();
-Evaluator *eval = new Evaluator();
+GarbageCollector gc;
+Tokenizor tk;
+ASTGenerator ast;
+Evaluator eval;
 
 void load_file(const char *fname) {
     FILE *f = fopen(fname, "r");
@@ -18,14 +20,14 @@ void load_file(const char *fname) {
         printf("Can not open file: %s\n", fname);
         exit(0);
     }
-    tk->set_stream(f);
+    tk.set_stream(f);
     while (1)
     {
         try
         {
-            Pair *tree = ast->absorb(tk);
+            Pair *tree = ast.absorb(&tk);
             if (!tree) break;
-            eval->run_expr(tree);
+            eval.run_expr(tree);
         }
         catch (GeneralError &e)
         {
@@ -79,15 +81,15 @@ int main(int argc, char **argv) {
     }
 
     int rcnt = 0;
-    tk->set_stream(stdin);  // interactive mode
+    tk.set_stream(stdin);  // interactive mode
     while (1)
     {
         fprintf(stderr, "Sonsi> ");
         try
         {
-            Pair *tree = ast->absorb(tk);
+            Pair *tree = ast.absorb(&tk);
             if (!tree) break;
-            string output = eval->run_expr(tree)->ext_repr();
+            string output = eval.run_expr(tree)->ext_repr();
             fprintf(stderr, "Ret> $%d = %s\n", rcnt++, output.c_str());
         }
         catch (GeneralError &e)
diff --git a/types.cpp b/types.cpp
index c782433..e3a7542 100644
--- a/types.cpp
+++ b/types.cpp
@@ -2,6 +2,7 @@
 #include "model.h"
 #include "exc.h"
 #include "consts.h"
+#include "gc.h"
 
 #include <cmath>
 #include <cstdlib>
@@ -41,41 +42,43 @@ SymObj::SymObj(const string &str) :
 
 OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {}
 
-ProcObj::ProcObj(Pair *_body,
-        Environment *_envt,
-        EvalObj *_params) :
-    OptObj(), body(_body), params(_params), envt(_envt) {}
-
-    Pair *ProcObj::call(Pair *args, Environment * &genvt,
-            Continuation * &cont, FrameObj ** &top_ptr) {
-        // Create a new continuation
-        // static_cast see `call` invocation in eval.cpp
-        Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
-        Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
-        // Create local env and recall the closure
-        Environment *_envt = new Environment(envt);
-        // static_cast<SymObj*> because the params is already checked
-        EvalObj *ppar, *nptr;
-        for (ppar = params;
-                ppar->is_pair_obj();
-                ppar = TO_PAIR(ppar)->cdr)
-        {
-            if ((nptr = args->cdr) != empty_list)
-                args = TO_PAIR(nptr);
-            else break;
-            _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
-        }
+ProcObj::ProcObj(Pair *_body, Environment *_envt, EvalObj *_params) : 
+    OptObj(), body(_body), params(_params), envt(_envt) {
+    gc.attach(body); 
+    gc.attach(params);
+    gc.attach(envt);
+}
+
+Pair *ProcObj::call(Pair *args, Environment * &genvt,
+        Continuation * &cont, FrameObj ** &top_ptr) {
+    // Create a new continuation
+    // static_cast see `call` invocation in eval.cpp
+    Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+    Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
+    // Create local env and recall the closure
+    Environment *_envt = new Environment(envt);
+    // static_cast<SymObj*> because the params is already checked
+    EvalObj *ppar, *nptr;
+    for (ppar = params;
+            ppar->is_pair_obj();
+            ppar = TO_PAIR(ppar)->cdr)
+    {
+        if ((nptr = args->cdr) != empty_list)
+            args = TO_PAIR(nptr);
+        else break;
+        _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
+    }
 
-        if (ppar->is_sym_obj())
-            _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
-        else if (args->cdr != empty_list || ppar != empty_list)
-            throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
+    if (ppar->is_sym_obj())
+        _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
+    else if (args->cdr != empty_list || ppar != empty_list)
+        throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
 
-        genvt = _envt;
-        cont = _cont;
-        *top_ptr++ = new RetAddr(NULL);   // Mark the entrance of a cont
-        return body;                    // Move pc to the proc entry point
-    }
+    genvt = _envt;
+    cont = _cont;
+    *top_ptr++ = new RetAddr(NULL);   // Mark the entrance of a cont
+    return body;                    // Move pc to the proc entry point
+}
 
 ReprCons *ProcObj::get_repr_cons() {
     return new ReprStr("#<Procedure>");
@@ -212,7 +215,17 @@ ReprCons *BuiltinProcObj::get_repr_cons() {
     return new ReprStr("#<Builtin Procedure: " + name + ">");
 }
 
-Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {}
+Environment::Environment(Environment *_prev_envt) : prev_envt(_prev_envt) {
+    gc.attach(prev_envt);
+}
+
+Environment::~Environment() {
+    gc.expose(prev_envt);
+}
+
+ReprCons *Environment::get_repr_cons() {
+    return new ReprStr("#<Environment>");
+}
 
 bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) {
     bool found = false;
@@ -224,7 +237,10 @@ bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) {
             bool has_key = ptr->binding.count(name);
             if (has_key) 
             {
-                ptr->binding[name] = eval_obj;
+                EvalObj * &ref = ptr->binding[name];
+                gc.expose(ref);
+                ref = eval_obj;
+                gc.attach(ref);
                 found = true;
                 break;
             }
@@ -233,7 +249,18 @@ bool Environment::add_binding(SymObj *sym_obj, EvalObj *eval_obj, bool def) {
     }
     else 
     {
-        binding[name] = eval_obj;
+        if (!binding.count(name))
+        {
+            binding[name] = eval_obj;
+            gc.attach(eval_obj);
+        }
+        else
+        {
+            EvalObj * &ref = binding[name];
+            gc.expose(ref);
+            ref = eval_obj;
+            gc.attach(ref);
+        }
         return true;
     }
 }
@@ -253,17 +280,27 @@ EvalObj *Environment::get_obj(EvalObj *obj) {
 }
 
 Continuation::Continuation(Environment *_envt, Pair *_pc,
-        Continuation *_prev_cont,
-        Pair *_proc_body) :
-    prev_cont(_prev_cont), envt(_envt), pc(_pc),
-    proc_body(_proc_body) {}
-
-    ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {}
-    ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
-    EvalObj *ReprStr::next(const string &prev) {
-        throw NormalError(INT_ERR);
+        Continuation *_prev_cont, Pair *_proc_body) :
+    prev_cont(_prev_cont), envt(_envt), pc(_pc), proc_body(_proc_body) {
+        gc.attach(prev_cont);
+        gc.attach(envt);
     }
 
+Continuation::~Continuation() {
+    gc.expose(prev_cont);
+    gc.expose(envt);
+}
+
+ReprCons *Continuation::get_repr_cons() {
+    return new ReprStr("#<Continuation>");
+}
+
+ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {}
+ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
+EvalObj *ReprStr::next(const string &prev) {
+    throw NormalError(INT_ERR);
+}
+
 PairReprCons::PairReprCons(Pair *_ptr, EvalObj *_ori) :
     ReprCons(false, _ori), state(0), ptr(_ptr) {}
 
@@ -324,8 +361,8 @@ VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) :
 PromObj::PromObj(EvalObj *exp) : 
     EvalObj(CLS_SIM_OBJ | CLS_PROM_OBJ), 
     entry(new Pair(exp, empty_list)), mem(NULL) {
-    entry->next = NULL;
-}
+        entry->next = NULL;
+    }
 
 Pair *PromObj::get_entry() { return entry; }
 
@@ -421,13 +458,13 @@ CompNumObj::CompNumObj(double _real, double _imag) :
 #ifndef GMP_SUPPORT
                 real = int_ptr->val;
 #else
-                real = int_ptr->val.get_d();
+            real = int_ptr->val.get_d();
 #endif
             else if ((rat_ptr = RatNumObj::from_string(real_str)))
 #ifndef GMP_SUPPORT
                 real = rat_ptr->a / double(rat_ptr->b);
 #else
-                real = rat_ptr->val.get_d();
+            real = rat_ptr->val.get_d();
 #endif
             else if ((real_ptr = RealNumObj::from_string(real_str)))
                 real = real_ptr->real;
@@ -440,13 +477,13 @@ CompNumObj::CompNumObj(double _real, double _imag) :
 #ifndef GMP_SUPPORT
                 imag = int_ptr->val;
 #else
-                imag = int_ptr->val.get_d();
+            imag = int_ptr->val.get_d();
 #endif
             else if ((rat_ptr = RatNumObj::from_string(imag_str)))
 #ifndef GMP_SUPPORT
                 imag = rat_ptr->a / double(rat_ptr->b);
 #else
-                imag = rat_ptr->val.get_d();
+            imag = rat_ptr->val.get_d();
 #endif
             else if ((real_ptr = RealNumObj::from_string(imag_str)))
                 imag = real_ptr->real;
@@ -661,8 +698,8 @@ RatNumObj *RatNumObj::from_string(string repr) {
 #else
 RatNumObj::RatNumObj(mpq_class _val) :
     ExactNumObj(NUM_LVL_RAT), val(_val) {
-    val.canonicalize();
-}
+        val.canonicalize();
+    }
 
 RatNumObj *RatNumObj::from_string(string repr) {
     try
diff --git a/types.h b/types.h
index 11776ab..e6a541c 100644
--- a/types.h
+++ b/types.h
@@ -25,6 +25,9 @@ const int CLS_CHAR_OBJ = 1 << 6;
 const int CLS_STR_OBJ = 1 << 7;
 const int CLS_VECT_OBJ = 1 << 8;
 
+const int CLS_CONT_OBJ = 1 << 9;
+const int CLS_ENVT_OBJ = 1 << 10;
+
 static const int NUM_LVL_COMP = 0;
 static const int NUM_LVL_REAL = 1;
 static const int NUM_LVL_RAT = 2;
@@ -323,7 +326,7 @@ class PromObj: public EvalObj {/*{{{*/
 /** @class Environment
  * The environment of current evaluation, i.e. the local variable binding
  */
-class Environment {/*{{{*/
+class Environment : public EvalObj{/*{{{*/
     private:
         Environment *prev_envt; /**< Pointer to the upper-level environment */
         Str2EvalObj binding;    /**< Store all pairs of identifier and its
@@ -333,6 +336,7 @@ class Environment {/*{{{*/
          * @param prev_envt the outer environment
          */
         Environment(Environment *prev_envt);
+        ~Environment();
         /** Add a binding entry which binds sym_obj to eval_obj
          * @param def true to force the assignment
          * @return when def is set to false, this return value is true iff. the
@@ -344,6 +348,7 @@ class Environment {/*{{{*/
          * @param obj the object as request
          * */
         EvalObj *get_obj(EvalObj *obj);
+        ReprCons *get_repr_cons();
 };/*}}}*/
 
 /** @class Continuation
@@ -351,7 +356,7 @@ class Environment {/*{{{*/
  * being made (Behave like a stack frame in C). When the call has accomplished,
  * the system will restore all the registers according to the continuation.
  */
-class Continuation {/*{{{*/
+class Continuation : public EvalObj {/*{{{*/
     public:
         /** Linking the previous continuation on the chain */
         Continuation *prev_cont;
@@ -365,6 +370,8 @@ class Continuation {/*{{{*/
         /** Create a continuation */
         Continuation(Environment *envt, Pair *pc, Continuation *prev_cont,
                 Pair *proc_body);
+        ~Continuation();
+        ReprCons *get_repr_cons();
 };/*}}}*/
 
 /** @class InexactNumObj