aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp16
-rw-r--r--builtin.h3
-rw-r--r--eval.cpp3
-rw-r--r--gc.cpp11
-rw-r--r--gc.h5
-rw-r--r--test/q.scm4
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))
+