aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile2
-rw-r--r--builtin.cpp32
-rw-r--r--eval.cpp27
-rw-r--r--gc.h2
-rw-r--r--model.h11
-rw-r--r--types.cpp20
-rw-r--r--types.h1
7 files changed, 57 insertions, 38 deletions
diff --git a/Makefile b/Makefile
index 2558d7b..6b867c3 100644
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
CXX = g++ -DGMP_SUPPORT
BUILD_DIR = build
-all: gc_debug
+all: release
debug: CXX += -DGC_INFO -g -pg
gc_debug: CXX += -DGC_INFO -DGC_DEBUG -g -pg
release: CXX += -O2
diff --git a/builtin.cpp b/builtin.cpp
index 6b34d1c..49519e8 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -49,7 +49,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next; // Move to the next instruction
}
@@ -84,7 +84,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(unspec_obj);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -176,7 +176,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt,
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(new ProcObj(body, lenvt, params));
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next; // Move to the next instruction
}
@@ -253,7 +253,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt,
lenvt->add_binding(id, obj);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(unspec_obj);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -301,7 +301,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt,
if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(unspec_obj);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -319,7 +319,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt,
Pair *pc = static_cast<Pair*>(ret_addr->car);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -340,7 +340,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
gc.expose(cont->state); // Exec done
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next; // Move to the next instruction
}
@@ -371,7 +371,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(new BoolObj(true));
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -391,7 +391,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(ret);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -409,7 +409,7 @@ Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(ret);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -430,7 +430,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(new BoolObj(false));
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -450,7 +450,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(ret);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -468,7 +468,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(ret);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next;
}
@@ -539,7 +539,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
prom->feed_mem(mem);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(mem);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(_args);
return ret_addr->next; // Move to the next instruction
}
@@ -553,7 +553,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(mem);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(_args);
return ret_addr->next;
}
@@ -584,7 +584,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
Pair *pc = static_cast<Pair*>(ret_addr->car);
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car));
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next; // Move to the next instruction
}
diff --git a/eval.cpp b/eval.cpp
index fd301e7..704b07b 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -117,27 +117,26 @@ inline bool make_exec(Pair *ptr) {
return ptr->cdr == empty_list;
}
-inline void push(Pair * &pc, EvalObj ** &top_ptr, Environment * &envt, Continuation * &cont) {
-// if (pc->car == NULL)
- // puts("oops");
+inline void push(Pair * &pc, EvalObj ** &top_ptr,
+ Environment * &envt, Continuation * &cont) {
if (pc->car->is_simple_obj()) // Not an opt invocation
{
*top_ptr++ = gc.attach(envt->get_obj(pc->car)); // Objectify the symbol
pc = pc->next; // Move to the next instruction
-// if (pc == empty_list)
-// puts("oops");
}
else // Operational Invocation
{
if (pc->car == empty_list)
throw NormalError(SYN_ERR_EMPTY_COMB);
- gc.expose(cont);
- cont = new Continuation(envt, pc, cont);
- gc.attach(cont);
-
- *top_ptr++ = gc.attach(cont);
-
+ if (!cont->tail) // a normal invocation
+ {
+ gc.expose(cont);
+ cont = new Continuation(envt, pc, cont);
+ gc.attach(cont);
+ *top_ptr++ = gc.attach(cont);
+ }
+ else cont->tail = false;
if (!make_exec(TO_PAIR(pc->car)))
throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS);
@@ -150,7 +149,9 @@ inline void push(Pair * &pc, EvalObj ** &top_ptr, Environment * &envt, Continuat
EvalObj *Evaluator::run_expr(Pair *prog) {
EvalObj **top_ptr = eval_stack;
Pair *pc = prog;
- Continuation *cont = NULL;
+ Continuation *bcont = new Continuation(NULL, NULL, NULL), // dummy cont
+ *cont = bcont;
+ gc.attach(cont);
#ifdef GC_DEBUG
fprintf(stderr, "Start the evaluation...\n");
#endif
@@ -158,7 +159,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
push(pc, top_ptr, envt, cont);
gc.attach(prog);
- while (cont)
+ while (cont != bcont)
{
if (top_ptr == eval_stack + EVAL_STACK_SIZE)
throw TokenError("Evaluation", RUN_ERR_STACK_OVERFLOW);
diff --git a/gc.h b/gc.h
index 78d26ae..2a0aac6 100644
--- a/gc.h
+++ b/gc.h
@@ -4,7 +4,7 @@
#include "model.h"
#include <map>
-const int GC_QUEUE_SIZE = 64 * 1024 * 1024;
+const int GC_QUEUE_SIZE = 262144;
const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 1;
typedef std::set<EvalObj*> EvalObjSet;
diff --git a/model.h b/model.h
index 8d272f8..964d68b 100644
--- a/model.h
+++ b/model.h
@@ -21,16 +21,25 @@ const int CLS_CONTAINER = 1 << 20;
#define TO_PAIR(ptr) \
(static_cast<Pair*>(ptr))
-#define EXIT_CURRENT_CONT(lenvt, cont) \
+#define EXIT_CURRENT_ENVT(lenvt) \
do { \
gc.expose(lenvt); \
lenvt = cont->envt; \
gc.attach(lenvt); \
+ } while (0)
+#define EXIT_CURRENT_CONT(cont) \
+ do { \
gc.expose(cont); \
cont = cont->prev_cont; \
gc.attach(cont); \
} while (0)
+#define EXIT_CURRENT_EXEC(lenvt, cont) \
+ do { \
+ EXIT_CURRENT_ENVT(lenvt); \
+ EXIT_CURRENT_CONT(cont); \
+ } while (0)
+
/** @class FrameObj
* Objects that can be held in the evaluation stack
*/
diff --git a/types.cpp b/types.cpp
index 1aafca5..672fead 100644
--- a/types.cpp
+++ b/types.cpp
@@ -88,17 +88,25 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
{
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car);
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont); // exit cont and envt
gc.expose(_args);
return ret_addr->next;
}
else
{
- gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+ if (!nexp->is_simple_obj() && nexp->cdr == empty_list) // tail recursion opt
+ {
+ cont->tail = true;
+ cont->state = NULL;
+ }
+ else
+ {
+ gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+ cont->state = nexp;
+ }
top_ptr++;
- cont->state = nexp;
gc.expose(_args);
- return cont->state;
+ return nexp;
}
}
else
@@ -302,7 +310,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
Pair *ret_addr = cont->pc;
gc.expose(*top_ptr);
*top_ptr++ = gc.attach(handler(TO_PAIR(args->cdr), name));
- EXIT_CURRENT_CONT(lenvt, cont);
+ EXIT_CURRENT_EXEC(lenvt, cont);
gc.expose(args);
return ret_addr->next; // Move to the next instruction
}
@@ -398,7 +406,7 @@ Environment *Environment::get_prev() {
}
Continuation::Continuation(Environment *_envt, Pair *_pc, Continuation *_prev_cont ) :
- Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL) {
+ Container(), prev_cont(_prev_cont), envt(_envt), pc(_pc), state(NULL), tail(false) {
gc.attach(prev_cont);
gc.attach(envt);
}
diff --git a/types.h b/types.h
index 846d86a..1c122a4 100644
--- a/types.h
+++ b/types.h
@@ -385,6 +385,7 @@ class Continuation : public Container {/*{{{*/
Environment *envt; /**< The saved envt */
Pair *pc; /**< The saved pc */
Pair *state; /**< The state of this compound */
+ bool tail; /**< If the proper tail opt is on */
/** Create a continuation */
Continuation(Environment *envt, Pair *pc, Continuation *prev_cont);
Powered by cgit, Themed by Ted Yin.