commit 03c7d83a8726ed4467240275bc8f9bd59246f7a7
parent 4576bbe9c056515b4791677f4a179140c0f4f4b0
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 29 Apr 2011 22:12:02 -0300
Added source code info to symbols. Changed marking scheme of symbols (TODO add assertions). Fixed table to compare symbols correctly.
Diffstat:
14 files changed, 147 insertions(+), 92 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -123,7 +123,8 @@ kgenv_mut.o: kgenv_mut.c kgenv_mut.h kghelpers.h kstate.h \
kenvironment.h kgcontrol.h
kgcombiners.o: kgcombiners.c kgenvironments.h kghelpers.h kstate.h \
klisp.h kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h \
- kenvironment.h kapplicative.h koperative.h kgpair_mut.h kgnumbers.h
+ kenvironment.h kapplicative.h koperative.h kgpair_mut.h kgnumbers.h \
+ kgenv_mut.h
kgcontinuations.o: kgcontinuations.c kgcontinuations.h kghelpers.h kstate.h \
klisp.h kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h \
kenvironment.h kapplicative.h koperative.h
diff --git a/src/kgc.c b/src/kgc.c
@@ -253,7 +253,6 @@ static int32_t propagatemark (klisp_State *K) {
}
case K_TSYMBOL: {
Symbol *s = cast(Symbol *, o);
- markvalue(K, s->mark);
markvalue(K, s->str);
return sizeof(Symbol);
}
@@ -404,7 +403,9 @@ static void freeobj (klisp_State *K, GCObject *o) {
case K_TSYMBOL:
/* symbols are in the string/symbol table */
/* The string will be freed before/after */
- K->strt.nuse--;
+ /* symbols with no source info are in the string/symbol table */
+ if (ttisnil(ktry_get_si(K, gc2sym(o))))
+ K->strt.nuse--;
klispM_free(K, (Symbol *)o);
break;
case K_TSTRING:
diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c
@@ -118,7 +118,7 @@ inline void unmark_maybe_symbol_list(klisp_State *K, TValue ls)
while(ttispair(ls) && kis_marked(ls)) {
TValue first = kcar(ls);
if (ttissymbol(first))
- kunmark(first);
+ kunmark_symbol(first);
kunmark(ls);
ls = kcdr(ls);
}
@@ -140,8 +140,8 @@ TValue check_copy_symbol_list(klisp_State *K, char *name, TValue obj)
/* even if there is a type error continue checking the structure */
TValue first = kcar(tail);
if (ttissymbol(first)) {
- repeated_errorp |= kis_marked(first);
- kmark(first);
+ repeated_errorp |= kis_symbol_marked(first);
+ kmark_symbol(first);
} else {
type_errorp = true;
}
diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h
@@ -38,8 +38,8 @@ inline void ptree_clear_all(klisp_State *K, TValue sym_ls)
{
while(!ttisnil(sym_ls)) {
TValue first = sym_ls;
- sym_ls = kget_mark(first);
- kunmark(first);
+ sym_ls = kget_symbol_mark(first);
+ kunmark_symbol(first);
}
while(!ks_sisempty(K)) {
@@ -129,16 +129,15 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
copy = top;
break;
case K_TSYMBOL: {
- if (kis_marked(top)) {
- /* TODO add symbol name */
+ if (kis_symbol_marked(top)) {
ptree_clear_all(K, sym_ls);
- klispE_throw_simple(K, "repeated symbol in ptree");
- /* avoid warning */
+ klispE_throw_simple_with_irritants(K, "repeated symbol "
+ "in ptree", 1, top);
return KNIL;
} else {
copy = top;
/* add it to the symbol list */
- kset_mark(top, sym_ls);
+ kset_symbol_mark(top, sym_ls);
sym_ls = top;
}
break;
@@ -219,14 +218,13 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
}
if (ttissymbol(penv)) {
- if (kis_marked(penv)) {
- /* TODO add symbol name */
+ if (kis_symbol_marked(penv)) {
ptree_clear_all(K, sym_ls);
- klispE_throw_simple(K, "same symbol in both ptree and "
- "environment parameter");
+ klispE_throw_simple_with_irritants(K, "same symbol in both ptree "
+ "and environment parameter",
+ 1, sym_ls);
}
} else if (!ttisignore(penv)) {
- /* TODO add symbol name */
ptree_clear_all(K, sym_ls);
klispE_throw_simple(K, "symbol or #ignore expected as "
"environment parmameter");
diff --git a/src/kground.c b/src/kground.c
@@ -53,9 +53,10 @@
** GC: All of these should be called when GC is deactivated on startup
*/
+/* TODO add si to the symbols */
#if KTRACK_SI
#define add_operative(K_, env_, n_, fn_, ...) \
- { symbol = ksymbol_new(K_, n_); \
+ { symbol = ksymbol_new(K_, n_, KNIL); \
value = kmake_operative(K_, fn_, __VA_ARGS__); \
TValue str = kstring_new_b_imm(K_, __FILE__); \
TValue si = kcons(K, str, kcons(K_, i2tv(__LINE__), \
@@ -64,7 +65,7 @@
kadd_binding(K_, env_, symbol, value); }
#define add_applicative(K_, env_, n_, fn_, ...) \
- { symbol = ksymbol_new(K_, n_); \
+ { symbol = ksymbol_new(K_, n_, KNIL); \
value = kmake_applicative(K_, fn_, __VA_ARGS__); \
TValue str = kstring_new_b_imm(K_, __FILE__); \
TValue si = kcons(K, str, kcons(K_, i2tv(__LINE__), \
@@ -74,7 +75,7 @@
kadd_binding(K_, env_, symbol, value); }
#else /* KTRACK_SI */
#define add_operative(K_, env_, n_, fn_, ...) \
- { symbol = ksymbol_new(K_, n_); \
+ { symbol = ksymbol_new(K_, n_, KNIL); \
value = kmake_operative(K_, fn_, __VA_ARGS__); \
kadd_binding(K_, env_, symbol, value); }
@@ -86,7 +87,7 @@
#define add_value(K_, env_, n_, v_) \
{ value = v_; \
- symbol = ksymbol_new(K_, n_); \
+ symbol = ksymbol_new(K_, n_, KNIL); \
kadd_binding(K_, env_, symbol, v_); }
/* for init_cont_names */
@@ -133,7 +134,7 @@ void kinit_cont_names(klisp_State *K)
add_cont_name(K, t, do_b_to_env, "bindings-to-env");
add_cont_name(K, t, do_match, "match-ptree");
add_cont_name(K, t, do_set_eval_obj, "set-eval-obj");
- add_cont_name(K, t, do_import, "import");
+ add_cont_name(K, t, do_import, "import-bindings");
add_cont_name(K, t, do_return_value, "return-value");
add_cont_name(K, t, do_unbind, "unbind-dynamic-var");
add_cont_name(K, t, do_filter, "filter-acyclic-part");
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -450,6 +450,7 @@ void string_to_symbol(klisp_State *K, TValue *xparams, TValue ptree,
UNUSED(xparams);
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
- TValue new_sym = ksymbol_new_check_i(K, str);
+ /* TODO si */
+ TValue new_sym = ksymbol_new_check_i(K, str, KNIL);
kapply_cc(K, new_sym);
}
diff --git a/src/kobject.h b/src/kobject.h
@@ -344,8 +344,7 @@ typedef struct __attribute__ ((__packed__)) {
} Pair;
typedef struct __attribute__ ((__packed__)) {
- CommonHeader;
- TValue mark; /* for cycle/sharing aware algorithms */
+ CommonHeader; /* symbols are marked via their strings */
TValue str; /* could use String * here, but for now... */
uint32_t hash; /* this is different from the str hash to
avoid having both the string and the symbol
@@ -628,8 +627,10 @@ const TValue kfree;
extern char *ktv_names[];
/* Macros to handle marks */
-/* NOTE: this only works in markable objects */
-#define kget_mark(p_) (tv2mgch(p_)->mark)
+/* TODO add assertions to check that symbols aren't marked with these */
+
+/* NOTE: this only works in markable objects, but not in symbols */
+#define kget_mark(p_) (tv2mgch(p_)->mark)
#ifdef KTRACK_MARKS
/* XXX: marking macros should take a klisp_State parameter and
@@ -656,6 +657,15 @@ int32_t kmark_count;
#define kis_marked(p_) (!kis_unmarked(p_))
#define kis_unmarked(p_) (tv_equal(kget_mark(p_), KFALSE))
+/* Symbols marking */
+/* NOTE: it's different because symbols mark their strings */
+#define kget_symbol_mark(s_) (kget_mark(tv2sym(s_)->str))
+#define kset_symbol_mark(s_, m_) (kget_mark(tv2sym(s_)->str) = (m_))
+#define kmark_symbol(s_) (kset_mark(tv2sym(s_)->str, KTRUE))
+#define kunmark_symbol(s_) (kset_mark(tv2sym(s_)->str, KFALSE))
+#define kis_symbol_marked(s_) (kis_marked(tv2sym(s_)->str))
+#define kis_symbol_unmarked(s_) (kis_unmarked(tv2sym(s_)->str))
+
/* Macros to access kflags & type in GCHeader */
/* TODO: 1 should always be reserved for mutability flag */
#define gch_get_type(o_) (obj2gch(o_)->tt)
diff --git a/src/krepl.c b/src/krepl.c
@@ -216,9 +216,11 @@ void kinit_repl(klisp_State *K)
/* update the ground environment with these two conts */
TValue symbol;
- symbol = ksymbol_new(K, "root-continuation");
- /* GC: symbol should already be in root */
+ /* TODO si */
+ symbol = ksymbol_new(K, "root-continuation", KNIL);
+ krooted_tvs_push(K, symbol);
kadd_binding(K, K->ground_env, symbol, root_cont);
+ krooted_tvs_pop(K);
#if KTRACK_SI
/* TODO: find a cleaner way of doing this..., maybe disable gc */
@@ -235,9 +237,11 @@ void kinit_repl(klisp_State *K)
krooted_tvs_pop(K);
#endif
- symbol = ksymbol_new(K, "error-continuation");
- /* GC: symbol should already be in root */
+ /* TODO si */
+ symbol = ksymbol_new(K, "error-continuation", KNIL);
+ krooted_tvs_push(K, symbol);
kadd_binding(K, K->ground_env, symbol, error_cont);
+ krooted_tvs_pop(K);
#if KTRACK_SI
str = kstring_new_b_imm(K, __FILE__);
diff --git a/src/kstate.c b/src/kstate.c
@@ -196,7 +196,8 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
kcons(K, i2tv(line_number), i2tv(0)));
kset_source_info(K, K->eval_op, si);
- TValue eval_name = ksymbol_new(K, "eval");
+ /* TODO: si */
+ TValue eval_name = ksymbol_new(K, "eval", KNIL);
ktry_set_name(K, K->eval_op, eval_name);
K->list_app = kmake_applicative(K, list, 0), line_number = __LINE__;
@@ -207,9 +208,11 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* ground environment has a hashtable for bindings */
K->ground_env = kmake_table_environment(K, KNIL);
+// K->ground_env = kmake_empty_environment(K);
/* MAYBE: fix it so we can remove module_params_sym from roots */
- K->module_params_sym = ksymbol_new(K, "module-parameters");
+ /* TODO si */
+ K->module_params_sym = ksymbol_new(K, "module-parameters", KNIL);
kinit_ground_env(K);
diff --git a/src/ksymbol.c b/src/ksymbol.c
@@ -15,14 +15,18 @@
#include "kmem.h"
#include "kgc.h"
+/* NOTE: symbols can have source info, they should be compared with
+ tv_sym_equal, NOT tv_equal */
+
+/* TEMP: for now only interned symbols are the ones that don't
+ have source info (like those created with string->symbol) */
TValue ksymbol_new_g(klisp_State *K, const char *buf, int32_t size,
- bool identifierp)
+ TValue si, bool identifierp)
{
- /* First look for it in the symbol table */
- GCObject *o;
+ /* First calculate the hash */
uint32_t h = size; /* seed */
size_t step = (size>>5)+1; /* if string is too long, don't hash all
- its chars */
+ its chars */
size_t size1;
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
h = h ^ ((h<<5)+(h>>2)+ ((unsigned char) buf[size1-1]));
@@ -30,76 +34,93 @@ TValue ksymbol_new_g(klisp_State *K, const char *buf, int32_t size,
h = ~h; /* symbol hash should be different from string hash
otherwise symbols and their respective immutable string
would always fall in the same bucket */
-
- for (o = K->strt.hash[lmod(h, K->strt.size)];
- o != NULL; o = o->gch.next) {
- String *ts = NULL;
- if (o->gch.tt == K_TSTRING) {
- continue;
- } else if (o->gch.tt == K_TSYMBOL) {
- ts = tv2str(((Symbol *) o)->str);
- } else {
- klisp_assert(0); /* only symbols and immutable strings */
- }
- if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
- /* symbol may be dead */
- if (isdead(K, o)) changewhite(o);
- return gc2sym(o);
- }
- }
+ /* look for it in the table only if it doesn't have source info */
+ if (ttisnil(si)) {
+ GCObject *o;
+ for (o = K->strt.hash[lmod(h, K->strt.size)];
+ o != NULL; o = o->gch.next) {
+ String *ts = NULL;
+ if (o->gch.tt == K_TSTRING) {
+ continue;
+ } else if (o->gch.tt == K_TSYMBOL) {
+ ts = tv2str(((Symbol *) o)->str);
+ } else {
+ klisp_assert(0); /* only symbols and immutable strings */
+ }
+ if (ts->size == size && (memcmp(buf, ts->b, size) == 0)) {
+ /* symbol may be dead */
+ if (isdead(K, o)) changewhite(o);
+ return gc2sym(o);
+ }
+ }
+ }
/* REFACTOR: move this to a new function */
/* Didn't find it, alloc new immutable string and save in symbol table,
note that the hash value remained in h */
TValue new_str = kstring_new_bs_imm(K, buf, size);
krooted_tvs_push(K, new_str);
Symbol *new_sym = klispM_new(K, Symbol);
- krooted_tvs_pop(K);
+ TValue ret_tv = gc2sym(new_sym);
+ krooted_tvs_pop(K);
- /* header + gc_fields */
- /* can't use klispC_link, because strings use the next pointer
- differently */
- new_sym->gct = klispC_white(K);
- new_sym->tt = K_TSYMBOL;
- new_sym->kflags = identifierp? K_FLAG_EXT_REP : 0;
- new_sym->si = NULL;
+ if (ttisnil(si)) {
+ /* header + gc_fields */
+ /* can't use klispC_link, because strings use the next pointer
+ differently */
+ new_sym->gct = klispC_white(K);
+ new_sym->tt = K_TSYMBOL;
+ new_sym->kflags = identifierp? K_FLAG_EXT_REP : 0;
+ new_sym->si = NULL;
- /* symbol specific fields */
- new_sym->mark = KFALSE;
- new_sym->str = new_str;
- new_sym->hash = h;
+ /* symbol specific fields */
+ new_sym->str = new_str;
+ new_sym->hash = h;
- /* add to the string/symbol table (and link it) */
- stringtable *tb;
- tb = &K->strt;
- h = lmod(h, tb->size);
- new_sym->next = tb->hash[h]; /* chain new entry */
- tb->hash[h] = (GCObject *)(new_sym);
- tb->nuse++;
- TValue ret_tv = gc2sym(new_sym);
- if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) {
- krooted_tvs_push(K, ret_tv); /* save in case of gc */
- klispS_resize(K, tb->size*2); /* too crowded */
- krooted_tvs_pop(K);
+ /* add to the string/symbol table (and link it) */
+ stringtable *tb;
+ tb = &K->strt;
+ h = lmod(h, tb->size);
+ new_sym->next = tb->hash[h]; /* chain new entry */
+ tb->hash[h] = (GCObject *)(new_sym);
+ tb->nuse++;
+ if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) {
+ krooted_tvs_push(K, ret_tv); /* save in case of gc */
+ klispS_resize(K, tb->size*2); /* too crowded */
+ krooted_tvs_pop(K);
+ }
+ } else { /* non nil source info */
+ /* link it with regular objects and save source info */
+ /* header + gc_fields */
+ klispC_link(K, (GCObject *) new_sym, K_TSYMBOL,
+ identifierp? K_FLAG_EXT_REP : 0);
+
+ /* symbol specific fields */
+ new_sym->str = new_str;
+ new_sym->hash = h;
+
+ krooted_tvs_push(K, ret_tv); /* not needed, but just in case */
+ kset_source_info(K, ret_tv, si);
+ krooted_tvs_pop(K);
}
return ret_tv;
}
/* for indentifiers */
-TValue ksymbol_new_i(klisp_State *K, const char *buf, int32_t size)
+TValue ksymbol_new_i(klisp_State *K, const char *buf, int32_t size, TValue si)
{
- return ksymbol_new_g(K, buf, size, true);
+ return ksymbol_new_g(K, buf, size, si, true);
}
/* for indentifiers with no size */
-TValue ksymbol_new(klisp_State *K, const char *buf)
+TValue ksymbol_new(klisp_State *K, const char *buf, TValue si)
{
int32_t size = (int32_t) strlen(buf);
- return ksymbol_new_g(K, buf, size, true);
+ return ksymbol_new_g(K, buf, size, si, true);
}
/* for string->symbol */
/* GC: assumes str is rooted */
-TValue ksymbol_new_check_i(klisp_State *K, TValue str)
+TValue ksymbol_new_check_i(klisp_State *K, TValue str, TValue si)
{
int32_t size = kstring_size(str);
char *buf = kstring_buf(str);
@@ -135,7 +156,7 @@ TValue ksymbol_new_check_i(klisp_State *K, TValue str)
size = kstring_size(str);
buf = kstring_buf(str);
- TValue new_sym = ksymbol_new_g(K, buf, size, identifierp);
+ TValue new_sym = ksymbol_new_g(K, buf, size, si, identifierp);
return new_sym;
}
diff --git a/src/ksymbol.h b/src/ksymbol.h
@@ -12,13 +12,18 @@
#include "kstring.h"
#include "kmem.h"
-/* TEMP: for now all symbols are interned */
+/* TEMP: for now all symbols with no source info are interned */
+
+/* NOTE: symbols can have source info, they should be compared with
+ tv_sym_equal, NOT tv_equal */
+
/* For identifiers */
-TValue ksymbol_new_i(klisp_State *K, const char *buf, int32_t size);
+TValue ksymbol_new_i(klisp_State *K, const char *buf, int32_t size,
+ TValue si);
/* For identifiers, simplified for unknown size */
-TValue ksymbol_new(klisp_State *K, const char *buf);
+TValue ksymbol_new(klisp_State *K, const char *buf, TValue si);
/* For general strings, copies str if not immutable */
-TValue ksymbol_new_check_i(klisp_State *K, TValue str);
+TValue ksymbol_new_check_i(klisp_State *K, TValue str, TValue si);
#define ksymbol_str(tv_) (tv2sym(tv_)->str)
#define ksymbol_buf(tv_) (kstring_buf(tv2sym(tv_)->str))
diff --git a/src/ktable.c b/src/ktable.c
@@ -503,8 +503,10 @@ const TValue *klispH_getstr (Table *t, String *key) {
*/
const TValue *klispH_getsym (Table *t, Symbol *key) {
Node *n = hashsym(t, key);
+ TValue tv_key = gc2sym(key);
do { /* check whether `key' is somewhere in the chain */
- if (ttissymbol(gkey(n)->this) && tv2sym(gkey(n)->this) == key)
+ if (ttissymbol(gkey(n)->this) &&
+ tv_sym_equal(gkey(n)->this, tv_key))
return &gval(n); /* that's it */
else n = gnext(n);
} while (n);
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -425,7 +425,11 @@ TValue ktok_read_maybe_signed_numeric(klisp_State *K)
if (ktok_check_delimiter(K)) {
ks_tbadd(K, ch);
ks_tbadd(K, '\0');
- TValue new_sym = ksymbol_new_i(K, ks_tbget_buffer(K), 1);
+ /* save the source info in the symbol */
+ TValue si = ktok_get_source_info(K);
+ krooted_tvs_push(K, si); /* will be popped by throw */
+ TValue new_sym = ksymbol_new_i(K, ks_tbget_buffer(K), 1, si);
+ krooted_tvs_pop(K); /* already in symbol */
krooted_tvs_push(K, new_sym);
ks_tbclear(K); /* this shouldn't cause gc, but just in case */
krooted_tvs_pop(K);
@@ -728,7 +732,10 @@ TValue ktok_read_identifier(klisp_State *K)
ktok_error(K, "Invalid char in identifier");
}
ks_tbadd(K, '\0');
- TValue new_sym = ksymbol_new_i(K, ks_tbget_buffer(K), i-1);
+ TValue si = ktok_get_source_info(K);
+ krooted_tvs_push(K, si); /* will be popped by throw */
+ TValue new_sym = ksymbol_new_i(K, ks_tbget_buffer(K), i-1, si);
+ krooted_tvs_pop(K); /* already in symbol */
krooted_tvs_push(K, new_sym);
ks_tbclear(K); /* this shouldn't cause gc, but just in case */
krooted_tvs_pop(K);
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -407,6 +407,7 @@ void kwrite_simple(klisp_State *K, TValue obj)
K->write_displayp = saved_displayp;
kw_printf(K, "]");
+ break;
}
default:
/* shouldn't happen */
