commit d968518a33393a2b0bf8230757b2fa7f7a821bff
parent f9a01fcf11ef99b15ccbf93a8e18cf3f892f9a72
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 21 Apr 2011 20:02:07 -0300
Added #if / #endif around code saving or getting names & source code info (TODO in kwrite.c). Added some simple tracking of source code location to eval.
Diffstat:
12 files changed, 106 insertions(+), 43 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -53,18 +53,18 @@ kstring.o: kstring.c kstring.h kobject.h kstate.h kmem.h klisp.h kgc.h
ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstring.h kstate.h kmem.h \
klisp.h kgc.h
kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h \
- kport.h ktable.h
+ kport.h ktable.h klispconf.h
kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
- klisp.h kport.h kinteger.h ktable.h
+ klisp.h kport.h kinteger.h ktable.h klispconf.h
kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
kenvironment.h kpair.h keval.h koperative.h kground.h \
krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h \
- kstring.h kinteger.h kgc.h klimits.h ktable.h
+ kstring.h kinteger.h kgc.h klimits.h ktable.h klispconf.h
kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h kstate.h kgc.h klispconf.h
kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h kpair.h
kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
kenvironment.o: kenvironment.c kenvironment.h kpair.h kobject.h kerror.h \
- kmem.h kstate.h klisp.h kgc.h ktable.h
+ kmem.h kstate.h klisp.h kgc.h ktable.h klispconf.h
kcontinuation.o: kcontinuation.c kcontinuation.h kmem.h kstate.h kobject.h \
klisp.h kgc.h
koperative.o: koperative.c koperative.h kmem.h kstate.h kobject.h \
@@ -80,7 +80,7 @@ kport.o: kport.c kport.h kmem.h kstate.h kobject.h klisp.h kerror.h kstring.h \
ktable.o: ktable.c ktable.h kobject.h kstate.h kmem.h klisp.h kgc.h \
kapplicative.h kgeqp.h kstring.h
keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
- kpair.h kerror.h klisp.h
+ kpair.h kerror.h klisp.h klispconf.h
krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
kread.h kwrite.h kenvironment.h ksymbol.h
kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -109,6 +109,7 @@ TValue kfind_local_binding(klisp_State *K, TValue bindings, TValue sym)
#define kenv_parents(kst_, env_) (tv2env(env_)->parents)
#define kenv_bindings(kst_, env_) (tv2env(env_)->bindings)
+#if KTRACK_NAMES
/* GC: Assumes that obj & sym are rooted. */
void try_set_name(klisp_State *K, TValue obj, TValue sym)
{
@@ -122,6 +123,7 @@ void try_set_name(klisp_State *K, TValue obj, TValue sym)
*node = sym;
}
}
+#endif
/* GC: Assumes that env, sym & val are rooted. */
void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val)
@@ -129,8 +131,10 @@ void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val)
klisp_assert(ttisenvironment(env));
klisp_assert(ttissymbol(sym));
+#if KTRACK_NAMES
try_set_name(K, val, sym);
-
+#endif
+
TValue bindings = kenv_bindings(K, env);
if (ttistable(bindings)) {
TValue *cell = klispH_setsym(K, tv2table(bindings), tv2sym(sym));
diff --git a/src/keval.c b/src/keval.c
@@ -94,9 +94,11 @@ void combine_cfn(klisp_State *K, TValue *xparams, TValue obj)
/*
** xparams[0]: operand list
** xparams[1]: dynamic environment
+ ** xparams[2]: original_obj_with_si
*/
TValue operands = xparams[0];
TValue env = xparams[1];
+ TValue si = xparams[2];
switch(ttype(obj)) {
case K_TAPPLICATIVE: {
@@ -105,19 +107,19 @@ void combine_cfn(klisp_State *K, TValue *xparams, TValue obj)
/* NOTE: the while is needed because it may be multiply wrapped */
while(ttisapplicative(obj))
obj = tv2app(obj)->underlying;
- ktail_call(K, obj, operands, env);
+ ktail_call_si(K, obj, operands, env, si);
} else if (ttispair(operands)) {
/* make a copy of the operands (for storing arguments) */
TValue tail;
TValue arg_ls = make_arg_ls(K, operands, &tail);
krooted_tvs_push(K, arg_ls);
- TValue comb_cont = kmake_continuation(K, kget_cc(K), &combine_cfn,
- 2, arg_ls, env);
+ TValue comb_cont = kmake_continuation(K, kget_cc(K), combine_cfn,
+ 3, arg_ls, env, si);
krooted_tvs_pop(K); /* already in cont */
krooted_tvs_push(K, comb_cont);
TValue els_cont =
- kmake_continuation(K, comb_cont, &eval_ls_cfn, 4, arg_ls, env,
+ kmake_continuation(K, comb_cont, eval_ls_cfn, 4, arg_ls, env,
tail, tv2app(obj)->underlying);
kset_cc(K, els_cont);
krooted_tvs_pop(K);
@@ -128,7 +130,7 @@ void combine_cfn(klisp_State *K, TValue *xparams, TValue obj)
}
}
case K_TOPERATIVE:
- ktail_call(K, obj, operands, env);
+ ktail_call_si(K, obj, operands, env, si);
default:
klispE_throw(K, "Not a combiner in combiner position");
return;
@@ -142,8 +144,8 @@ void keval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
switch(ttype(obj)) {
case K_TPAIR: {
- TValue new_cont =
- kmake_continuation(K, kget_cc(K), &combine_cfn, 2, kcdr(obj), env);
+ TValue new_cont = kmake_continuation(K, kget_cc(K), combine_cfn, 3,
+ kcdr(obj), env, obj);
kset_cc(K, new_cont);
ktail_eval(K, kcar(obj), env);
break;
diff --git a/src/kgc.c b/src/kgc.c
@@ -536,6 +536,7 @@ static void markroot (klisp_State *K) {
markvalue(K, K->next_obj);
markvalue(K, K->next_value);
markvalue(K, K->next_env);
+ markvalue(K, K->next_si);
/* NOTE: next_x_params is protected by next_obj */
markvalue(K, K->eval_op);
markvalue(K, K->list_app);
diff --git a/src/kgports.c b/src/kgports.c
@@ -81,6 +81,7 @@ void with_file(klisp_State *K, TValue *xparams, TValue ptree,
krooted_tvs_pop(K);
/* even if we call with denv, do_bind calls comb in an empty env */
+ /* XXX: what to pass for source info?? */
ktail_call(K, op, args, denv);
}
diff --git a/src/klispconf.h b/src/klispconf.h
@@ -22,6 +22,8 @@
#define KTRACK_MARKS true
*/
+/* TODO use this defines */
+#define KTRACK_NAMES true
#define KTRACK_SI true
/* These are unused for now, but will be once incremental collection is
diff --git a/src/kobject.h b/src/kobject.h
@@ -646,6 +646,8 @@ int32_t kmark_count;
#define K_FLAG_HAS_SI 0x20
+/* for now only used in assertions to avoid problems */
+#define kcan_have_si(o_) (iscollectable(o_))
#define khas_si(o_) ((tv_get_kflags(o_)) & K_FLAG_HAS_SI)
#define K_FLAG_IMMUTABLE 0x10
diff --git a/src/kread.c b/src/kread.c
@@ -53,25 +53,6 @@ typedef enum {
/*
-** Source code tracking
-** MAYBE: add source code tracking to symbols
-*/
-TValue kget_source_info(klisp_State *K, TValue pair)
-{
- const TValue *node = klispH_get(tv2table(K->si_table), pair);
- return (node == &kfree)? KNIL : *node;
-}
-
-/* GC: Assumes pair and si are rooted */
-void kset_source_info(klisp_State *K, TValue pair, TValue si)
-{
- gcvalue(pair)->gch.kflags |= K_FLAG_HAS_SI;
- TValue *node = klispH_set(K, tv2table(K->si_table), pair);
- *node = si;
-}
-
-
-/*
** Error management
*/
void kread_error(klisp_State *K, char *str)
@@ -197,9 +178,10 @@ TValue kread_fsm(klisp_State *K)
*/
TValue si = ktok_get_source_info(K);
krooted_tvs_push(K, si);
+ #if KTRACK_SI
kset_source_info(K, np, si);
+ #endif
krooted_tvs_pop(K);
-
/* update the shared def to point to the new list */
/* NOTE: this is necessary for self referencing lists */
/* NOTE: the shared def was already checked for errors */
@@ -231,7 +213,11 @@ TValue kread_fsm(klisp_State *K)
pop_data(K);
obj = KNIL;
+ #if KTRACK_SI
obj_si = kget_source_info(K, fp_with_old_si);
+ #else
+ UNUSED(fp_with_old_si);
+ #endif
read_next_token = false;
break;
}
@@ -416,10 +402,16 @@ TValue kread_fsm(klisp_State *K)
/* NOTE: the old one will be returned when list is complete */
/* GC: the way things are done here fp is rooted at all
times */
+ #if KTRACK_SI
TValue fp_old_si = kget_source_info(K, fp);
+ #else
+ TValue fp_old_si = KNIL;
+ #endif
krooted_tvs_push(K, fp);
krooted_tvs_push(K, fp_old_si);
+ #if KTRACK_SI
kset_source_info(K, fp, obj_si);
+ #endif
kset_car_unsafe(K, fp, obj);
/* continue reading objects of list */
@@ -441,7 +433,9 @@ TValue kread_fsm(klisp_State *K)
/* GC: np is rooted by push_data */
TValue np = kcons_g(K, K->read_mconsp, obj, KNIL);
krooted_tvs_push(K, np);
+ #if KTRACK_SI
kset_source_info(K, np, obj_si);
+ #endif
kset_cdr_unsafe(K, get_data(K), np);
/* replace last pair of the (still incomplete) read next obj */
pop_data(K);
diff --git a/src/krepl.c b/src/krepl.c
@@ -61,7 +61,7 @@ void eval_cfn(klisp_State *K, TValue *xparams, TValue obj)
kset_cc(K, K->root_cont);
kapply_cc(K, KINERT);
} else {
- ktail_call(K, K->eval_op, obj, denv);
+ ktail_eval(K, obj, denv);
}
}
diff --git a/src/kstate.c b/src/kstate.c
@@ -68,6 +68,7 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->next_value = KINERT;
K->next_env = KNIL;
K->next_xparams = NULL;
+ K->next_si = KNIL;
/* these will be properly initialized later */
K->eval_op = KINERT;
@@ -446,6 +447,7 @@ void do_interception(klisp_State *K, TValue *xparams, TValue obj)
2, kcdr(ls), dst_cont);
kset_cc(K, new_cont);
krooted_tvs_pop(K);
+ /* XXX: what to pass as si? */
ktail_call(K, op, ptree, denv);
}
}
@@ -537,3 +539,30 @@ void klisp_close (klisp_State *K)
/* NOTE: this needs to be done "by hand" */
(*(K->frealloc))(K->ud, K, state_size(), 0);
}
+
+#if KTRACK_SI
+/*
+** Source code tracking
+** MAYBE: add source code tracking to symbols
+*/
+TValue kget_source_info(klisp_State *K, TValue obj)
+{
+ const TValue *node = klispH_get(tv2table(K->si_table), obj);
+ return (node == &kfree)? KNIL : *node;
+}
+
+/* GC: Assumes obj and si are rooted */
+void kset_source_info(klisp_State *K, TValue obj, TValue si)
+{
+ klisp_assert(kcan_have_si(obj));
+ gcvalue(obj)->gch.kflags |= K_FLAG_HAS_SI;
+ TValue *node = klispH_set(K, tv2table(K->si_table), obj);
+ *node = si;
+}
+
+TValue kget_csi(klisp_State *K)
+{
+ return (kcan_have_si(K->next_si))? kget_source_info(K, K->next_si) : KNIL;
+}
+
+#endif /* KTRACK_SI */
diff --git a/src/kstate.h b/src/kstate.h
@@ -62,6 +62,7 @@ struct klisp_State {
TValue next_value; /* the value to be passed to the next function */
TValue next_env; /* either NIL or an environment for next operative */
TValue *next_xparams;
+ TValue next_si; /* The object with the source code info for this call */
TValue eval_op; /* the operative for evaluation */
TValue list_app; /* the applicative for list evaluation */
@@ -241,7 +242,6 @@ inline bool ks_sisempty(klisp_State *K)
/*
** Tokenizer char buffer functions
*/
-
void ks_tbshrink(klisp_State *K, int32_t new_top);
void ks_tbgrow(klisp_State *K, int32_t new_top);
@@ -350,13 +350,29 @@ typedef void (*klisp_Ofunc) (klisp_State *K, TValue *ud, TValue ptree,
#define kstate_car(p_) (tv2pair(p_)->car)
#define kstate_cdr(p_) (tv2pair(p_)->cdr)
+
+/*
+** Source code tracking
+** MAYBE: add source code tracking to symbols
+*/
+#if KTRACK_SI
+TValue kget_source_info(klisp_State *K, TValue pair);
+void kset_source_info(klisp_State *K, TValue pair, TValue si);
+TValue kget_csi(klisp_State *K);
+#endif
+
+#define kget_csi_obj(K_) (K_->next_si)
+
/*
** Functions to manipulate the current continuation and calling
** operatives
*/
inline void klispS_apply_cc(klisp_State *K, TValue val)
{
+ /* TODO write barriers */
+
/* various assert to check the freeing of gc protection methods */
+ /* TODO add marks assertions */
klisp_assert(K->rooted_tvs_top == 0);
klisp_assert(K->rooted_vars_top == 0);
klisp_assert(ttispair(K->dummy_pair1) &&
@@ -374,6 +390,7 @@ inline void klispS_apply_cc(klisp_State *K, TValue val)
K->next_env = KNIL;
K->next_xparams = cont->extra;
K->curr_cont = cont->parent;
+ K->next_si = K->next_obj;
}
#define kapply_cc(K_, val_) klispS_apply_cc((K_), (val_)); return
@@ -392,9 +409,11 @@ inline void klispS_set_cc(klisp_State *K, TValue new_cont)
#define kset_cc(K_, c_) (klispS_set_cc(K_, c_))
-inline void klispS_tail_call(klisp_State *K, TValue top, TValue ptree,
- TValue env)
+inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
+ TValue env, TValue si)
{
+ /* TODO write barriers */
+
/* various assert to check the freeing of gc protection methods */
klisp_assert(K->rooted_tvs_top == 0);
klisp_assert(K->rooted_vars_top == 0);
@@ -405,21 +424,26 @@ inline void klispS_tail_call(klisp_State *K, TValue top, TValue ptree,
klisp_assert(ttispair(K->dummy_pair3) &&
ttisnil(kstate_cdr(K->dummy_pair3)));
- K->next_obj = top; /* save it from GC */
+ K->next_obj = top;
Operative *op = tv2op(top);
K->next_func = op->fn;
K->next_value = ptree;
/* NOTE: this is what differentiates a tail call from a return */
K->next_env = env;
K->next_xparams = op->extra;
+ K->next_si = si;
}
-#define ktail_call(K_, op_, p_, e_) \
- { klispS_tail_call((K_), (op_), (p_), (e_)); return; }
+#define ktail_call_si(K_, op_, p_, e_, si_) \
+ { klispS_tail_call_si((K_), (op_), (p_), (e_), (si_)); return; }
+
+/* if no source info is needed */
+#define ktail_call(K_, op_, p_, e_) (ktail_call_si(K_, op_, p_, e_, KNIL))
-#define ktail_eval(K_, p_, e_) \
- { klisp_State *K__ = (K_); \
- klispS_tail_call(K__, K__->eval_op, (p_), (e_)); return; }
+#define ktail_eval(K_, p_, e_) \
+ { klisp_State *K__ = (K_); \
+ TValue p__ = (p_); \
+ klispS_tail_call_si(K__, K__->eval_op, p__, (e_), p__); return; }
/* helper for continuation->applicative & kcall_cont */
void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -194,9 +194,13 @@ TValue kget_name(klisp_State *K, TValue obj)
klisp_assert(node != &kfree);
return *node;
}
+
+
/*
** Writes all values except strings and pairs
*/
+
+/* TODO add #if #endif for track names */
void kwrite_simple(klisp_State *K, TValue obj)
{
switch(ttype(obj)) {
