commit 4630eb4a52d62f77e5355203443ac9543b2f9643
parent 4603438d9197a2f4b2cfcc7785ac271721a58c67
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 29 Apr 2011 15:33:46 -0300
Changed si mechanism. Now it is tracked in previous padding section of Object header. The table is gone. BUG Pending, GC fails with an assertion marking in tests.
Diffstat:
6 files changed, 57 insertions(+), 56 deletions(-)
diff --git a/src/keval.c b/src/keval.c
@@ -144,8 +144,9 @@ 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, 3,
- kcdr(obj), env, obj);
+ TValue new_cont =
+ kmake_continuation(K, kget_cc(K), combine_cfn, 3, kcdr(obj),
+ env, ktry_get_si(K, obj));
kset_cc(K, new_cont);
ktail_eval(K, kcar(obj), env);
break;
diff --git a/src/kgc.c b/src/kgc.c
@@ -235,6 +235,10 @@ static int32_t propagatemark (klisp_State *K) {
K->gray = o->gch.gclist;
klisp_assert(isgray(o));
gray2black(o);
+ /* all types have si pointers */
+ if (o->gch.si != NULL) {
+ markobject(K, o->gch.si);
+ }
uint8_t type = o->gch.tt;
switch (type) {
@@ -552,7 +556,6 @@ static void markroot (klisp_State *K) {
/* TEMP: this is quite awfull, think of other way to do this */
/* MAYBE: some of these could be FIXED */
markvalue(K, K->name_table);
- markvalue(K, K->si_table);
markvalue(K, K->curr_cont);
markvalue(K, K->next_obj);
markvalue(K, K->next_value);
@@ -765,6 +768,7 @@ void klispC_link (klisp_State *K, GCObject *o, uint8_t tt, uint8_t kflags) {
o->gch.gct = klispC_white(K);
o->gch.tt = tt;
o->gch.kflags = kflags;
+ o->gch.si = NULL;
/* NOTE that o->gch.gclist doesn't need to be setted */
}
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -61,7 +61,6 @@ void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue si = kget_csi(K);
if (!ttisnil(si)) {
krooted_tvs_push(K, new_op);
- gcvalue(new_op)->gch.kflags |= K_FLAG_HAS_SI;
kset_source_info(K, new_op, si);
krooted_tvs_pop(K);
}
@@ -129,7 +128,6 @@ void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
TValue si = kget_csi(K);
if (!ttisnil(si)) {
krooted_tvs_push(K, new_app);
- gcvalue(new_app)->gch.kflags |= K_FLAG_HAS_SI;
kset_source_info(K, new_app, si);
krooted_tvs_pop(K);
}
@@ -149,7 +147,6 @@ void unwrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* 5.3.1 $vau */
/* DONE: above, together with 4.10.4 */
-
/* 5.3.2 $lambda */
void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
@@ -171,9 +168,9 @@ void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
/* save as source code info the info from the expression whose evaluation
got us here */
TValue si = kget_csi(K);
+
if (!ttisnil(si)) {
krooted_tvs_push(K, new_app);
- gcvalue(new_app)->gch.kflags |= K_FLAG_HAS_SI;
kset_source_info(K, new_app, si);
krooted_tvs_pop(K);
}
diff --git a/src/kobject.h b/src/kobject.h
@@ -45,7 +45,7 @@ typedef union GCObject GCObject;
** included in other objects)
*/
#define CommonHeader GCObject *next; uint8_t tt; uint8_t kflags; \
- uint16_t gct; uint32_t padding; GCObject *gclist;
+ uint16_t gct; GCObject *si; GCObject *gclist;
/* NOTE: the gc flags are called marked in lua, but we reserve that them
for marks used in cycle traversal. The field kflags is also missing
@@ -62,11 +62,7 @@ typedef union GCObject GCObject;
** state struct. Likewise, during the tracing phase, gray objects are linked
** by means of the gclist pointer. Technically this is necessary only for
** objects that have references, but in klisp all objects except strings
-** have them so it is easier to just put it here. Re the use of the padding,
-** this is necessary (TODO add 32-bit check) in 32 bits because of the packed
-** attribute. Otherwise, all TValues would be misaligned. All of this,
-** assuming the compiler complies with it, but if not the padding doesn't
-** hurt.
+** have them so it is easier to just put it here.
*/
/*
@@ -683,9 +679,9 @@ 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 khas_si(o_) ((iscollectable(o_) && \
+ (tv_get_kflags(o_)) & K_FLAG_HAS_SI))
#define K_FLAG_IMMUTABLE 0x10
diff --git a/src/kstate.c b/src/kstate.c
@@ -132,15 +132,12 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->strt.hash = NULL;
klispS_resize(K, MINSTRTABSIZE);
- /* initialize name & source code info tables */
+ /* initialize name info table */
/* needs weak keys, otherwise every named object would
be fixed! */
K->name_table = klispH_new(K, 0, MINNAMETABSIZE,
K_FLAG_WEAK_KEYS);
- K->si_table = klispH_new(K, 0, MINSITABSIZE,
- K_FLAG_WEAK_KEYS);
-
/* Empty string */
/* MAYBE: fix it so we can remove empty_string from roots */
K->empty_string = kstring_new_b_imm(K, "");
@@ -555,30 +552,3 @@ 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
@@ -47,7 +47,6 @@ typedef struct stringtable {
struct klisp_State {
stringtable strt; /* hash table for immutable strings & symbols */
TValue name_table; /* hash tables for naming objects */
- TValue si_table; /* hash tables for source code info */
TValue curr_cont;
/*
@@ -61,7 +60,8 @@ 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 */
+ /* TODO replace with GCObject *next_si */
+ TValue next_si; /* the source code info for this call */
TValue eval_op; /* the operative for evaluation */
TValue list_app; /* the applicative for list evaluation */
@@ -353,12 +353,40 @@ typedef void (*klisp_Ofunc) (klisp_State *K, TValue *ud, TValue ptree,
** 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
+inline TValue kget_source_info(klisp_State *K, TValue obj)
+{
+ UNUSED(K);
+ klisp_assert(khas_si(obj));
+ GCObject *si = gcvalue(obj)->gch.si;
+ klisp_assert(si != NULL);
+ return gc2pair(si);
+}
+
+inline void kset_source_info(klisp_State *K, TValue obj, TValue si)
+{
+ UNUSED(K);
+ klisp_assert(kcan_have_si(obj));
+ klisp_assert(ttisnil(si) || ttispair(si));
+ if (ttisnil(si)) {
+ gcvalue(obj)->gch.si = NULL;
+ gcvalue(obj)->gch.kflags &= ~(K_FLAG_HAS_SI);
+ } else {
+ gcvalue(obj)->gch.si = gcvalue(si);
+ gcvalue(obj)->gch.kflags |= K_FLAG_HAS_SI;
+ }
+}
-#define kget_csi_obj(K_) (K_->next_si)
+inline TValue ktry_get_si(klisp_State *K, TValue obj)
+{
+ UNUSED(K);
+ return (khas_si(obj))? gc2pair(gcvalue(obj)->gch.si) : KNIL;
+}
+
+inline TValue kget_csi(klisp_State *K)
+{
+ return K->next_si;
+}
+#endif
/*
** Functions to manipulate the current continuation and calling
@@ -387,7 +415,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;
+ K->next_si = ktry_get_si(K, K->next_obj);
}
#define kapply_cc(K_, val_) klispS_apply_cc((K_), (val_)); return
@@ -435,12 +463,17 @@ inline void klispS_tail_call_si(klisp_State *K, TValue top, TValue ptree,
{ 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_call(K_, op_, p_, e_) \
+ { klisp_State *K__ = (K_); \
+ TValue op__ = (op_); \
+ (ktail_call_si(K__, op__, p_, e_, ktry_get_si(K__, op__))); } \
#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; }
+ klispS_tail_call_si(K__, K__->eval_op, p__, (e_), \
+ ktry_get_si(K__, p__)); \
+ return; }
/* helper for continuation->applicative & kcall_cont */
void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
