From c2522466d2fcb5273004f1989b89186cd68001d7 Mon Sep 17 00:00:00 2001
From: Teddy <ted.sybil@gmail.com>
Date: Wed, 14 Aug 2013 00:08:30 +0800
Subject: added gc setting built-ins

---
 builtin.cpp | 16 ++++++++++++++++
 builtin.h   |  3 +++
 eval.cpp    |  3 +++
 gc.cpp      | 11 ++++++++++-
 gc.h        |  5 ++++-
 test/q.scm  |  4 ++++
 6 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/builtin.cpp b/builtin.cpp
index b983167..2cd738a 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1515,6 +1515,22 @@ BUILTIN_PROC_DEF(vector_length) {
     return new IntNumObj(vect->get_size());
 }
 
+BUILTIN_PROC_DEF(gc_status) {
+    if (args != empty_list)
+        throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
+    return new IntNumObj(gc.get_remaining());
+}
+
+BUILTIN_PROC_DEF(set_gc_resolve_threshold) {
+    ARGS_EXACTLY_ONE;
+    CHECK_NUMBER(args->car);
+    CHECK_INT(static_cast<NumObj*>(args->car));
+    ssize_t s = static_cast<IntNumObj*>(args->car)->get_i();
+    if (s < 0)
+        throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
+    gc.set_resolve_threshold(size_t(s));
+    return new UnspecObj();
+}
 
 BUILTIN_PROC_DEF(display) {
     ARGS_EXACTLY_ONE;
diff --git a/builtin.h b/builtin.h
index 1a2e7a8..666b48e 100644
--- a/builtin.h
+++ b/builtin.h
@@ -245,4 +245,7 @@ BUILTIN_PROC_DEF(vector_set);
 BUILTIN_PROC_DEF(vector_ref);
 BUILTIN_PROC_DEF(vector_length);
 
+BUILTIN_PROC_DEF(gc_status);
+BUILTIN_PROC_DEF(set_gc_resolve_threshold);
+
 #endif
diff --git a/eval.cpp b/eval.cpp
index 9e0510f..06b66af 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -88,6 +88,9 @@ void Evaluator::add_builtin_routines() {
     ADD_BUILTIN_PROC("vector-set!", vector_set);
     ADD_BUILTIN_PROC("vector-ref", vector_ref);
     ADD_BUILTIN_PROC("vector-length", vector_length);
+
+    ADD_BUILTIN_PROC("gc-status", gc_status);
+    ADD_BUILTIN_PROC("set-gc-resolve-threshold!", set_gc_resolve_threshold);
 }
 
 Evaluator::Evaluator() {
diff --git a/gc.cpp b/gc.cpp
index 85486b6..775463f 100644
--- a/gc.cpp
+++ b/gc.cpp
@@ -14,6 +14,7 @@ static Container *cyc_list[GC_QUEUE_SIZE];
 GarbageCollector::GarbageCollector() {
     mapping.clear();
     pending_list = NULL;
+    resolve_threshold = GC_CYC_THRESHOLD;
 }
 
 GarbageCollector::PendingEntry::PendingEntry(
@@ -113,7 +114,7 @@ EvalObj *GarbageCollector::attach(EvalObj *ptr) {
 }
 
 void GarbageCollector::cycle_resolve() {
-    if (mapping.size() < GC_CYC_THRESHOLD)
+    if (mapping.size() < resolve_threshold)
         return; 
     EvalObjSet visited;
     Container **clptr = cyc_list;
@@ -152,3 +153,11 @@ void GarbageCollector::cycle_resolve() {
 #endif
     force();
 }
+
+size_t GarbageCollector::get_remaining() {
+    return mapping.size();
+}
+
+void GarbageCollector::set_resolve_threshold(size_t new_thres) {
+    resolve_threshold = new_thres;
+}
diff --git a/gc.h b/gc.h
index d116a18..eae0958 100644
--- a/gc.h
+++ b/gc.h
@@ -5,7 +5,7 @@
 #include <map>
 
 const int GC_QUEUE_SIZE = 262144;
-const size_t GC_CYC_THRESHOLD = 1000;
+const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 2;
 
 typedef std::map<EvalObj*, size_t> EvalObj2Int;
 typedef std::set<EvalObj*> EvalObjSet;
@@ -33,12 +33,15 @@ class GarbageCollector {
 
     EvalObj2Int mapping;
     PendingEntry *pending_list;
+    size_t resolve_threshold;
 
     public:
     GarbageCollector();
     void cycle_resolve();
     void force();
     void expose(EvalObj *ptr);
+    void set_resolve_threshold(size_t new_thres);
+    size_t get_remaining();
     EvalObj *attach(EvalObj *ptr);
 };
 
diff --git a/test/q.scm b/test/q.scm
index 36adcf8..c1915a9 100644
--- a/test/q.scm
+++ b/test/q.scm
@@ -73,3 +73,7 @@
 (define empty-bits '())
 (define res '())
 (define queen '())
+(set-gc-resolve-threshold! 0)   ; force cycle resolve
+(display "\n")
+(display (gc-status))
+
-- 
cgit v1.2.3