commit 9b4983c0ff03dfb6f205462c2a6f10581fdde7b8
parent 206e48f43dab4ae854a6d3024b42923e707466bf
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 20 Apr 2011 10:40:38 -0300
Added assertions to kpair and added new set_car/cdr_unsafe for setting potentially immutable pairs (like in read and copy-es-immutable).
Diffstat:
7 files changed, 64 insertions(+), 18 deletions(-)
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -500,7 +500,7 @@ void do_map_cycle(klisp_State *K, TValue *xparams, TValue obj)
/* 5.9.1 map */
void map(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
- (void) xparams;
+ UNUSED(xparams);
bind_al1tp(K, "map", ptree, "applicative", ttisapplicative, app, lss);
diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h
@@ -190,7 +190,8 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
/* only car was checked (not yet copied) */
if (kis_mutable(top)) {
TValue copied_pair = kget_mark(top);
- kset_car(copied_pair, copy);
+ /* copied_pair may be immutable */
+ kset_car_unsafe(K, copied_pair, copy);
}
/* put the copied pair again, continue with the cdr */
ks_tbpush(K, ST_CDR);
@@ -205,7 +206,8 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree,
kunmark(top);
if (kis_mutable(top)) {
- kset_cdr(copied_pair, copy);
+ /* copied_pair may be immutable */
+ kset_cdr_unsafe(K, copied_pair, copy);
}
copy = copied_pair;
}
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -125,7 +125,8 @@ TValue copy_es_immutable_h(klisp_State *K, char *name, TValue obj,
} else { /* last action was a pop */
TValue new_pair = kget_mark(top);
if (state == ST_CAR) {
- kset_car(new_pair, copy);
+ /* new_pair may be immutable */
+ kset_car_unsafe(K, new_pair, copy);
/* leave the pair on the stack, continue with the cdr */
ks_spush(K, top);
ks_tbpush(K, ST_CDR);
@@ -133,7 +134,8 @@ TValue copy_es_immutable_h(klisp_State *K, char *name, TValue obj,
ks_spush(K, kcdr(top));
ks_tbpush(K, ST_PUSH);
} else {
- kset_cdr(new_pair, copy);
+ /* new_pair may be immutable */
+ kset_cdr_unsafe(K, new_pair, copy);
copy = new_pair;
}
}
diff --git a/src/kgports.c b/src/kgports.c
@@ -394,7 +394,7 @@ TValue read_all_expr(klisp_State *K, TValue port)
return kcutoff_dummy1(K);
} else {
TValue new_pair = kimm_cons(K, obj, KNIL);
- kset_cdr(tail, new_pair);
+ kset_cdr_unsafe(K, tail, new_pair);
tail = new_pair;
}
}
diff --git a/src/kpair.c b/src/kpair.c
@@ -47,7 +47,7 @@ TValue klist_g(klisp_State *K, bool m, int32_t n, ...)
for (int i = 0; i < n; i++) {
TValue next_car = va_arg(argp, TValue);
TValue np = kcons_g(K, m, next_car, KNIL);
- kset_cdr(tail, np);
+ kset_cdr_unsafe(K, tail, np);
tail = np;
}
va_end(argp);
diff --git a/src/kpair.h b/src/kpair.h
@@ -10,10 +10,27 @@
#include "kobject.h"
#include "kstate.h"
#include "klimits.h"
+#include "kgc.h"
-/* TODO: add type assertions */
-#define kcar(p_) (tv2pair(p_)->car)
-#define kcdr(p_) (tv2pair(p_)->cdr)
+/* can't be inlined... */
+bool kpairp(TValue obj);
+
+inline bool kmutable_pairp(TValue obj)
+{
+ return ttispair(obj) && kis_mutable(obj);
+}
+
+inline TValue kcar(TValue p)
+{
+ klisp_assert(kpairp(p));
+ return tv2pair(p)->car;
+}
+
+inline TValue kcdr(TValue p)
+{
+ klisp_assert(kpairp(p));
+ return tv2pair(p)->cdr;
+}
#define kcaar(p_) (kcar(kcar(p_)))
#define kcadr(p_) (kcar(kcdr(p_)))
@@ -48,8 +65,35 @@
#define kcddddr(p_) (kcdr(kcdr(kcdr(kcdr(p_)))))
/* these will also work with immutable pairs */
-#define kset_car(p_, v_) (kcar(p_) = (v_))
-#define kset_cdr(p_, v_) (kcdr(p_) = (v_))
+inline void kset_car(TValue p, TValue v)
+{
+ klisp_assert(kmutable_pairp(p));
+ tv2pair(p)->car = v;
+}
+
+inline void kset_cdr(TValue p, TValue v)
+{
+ klisp_assert(kmutable_pairp(p));
+ tv2pair(p)->cdr = v;
+}
+
+/* These two are the same but can write immutable pairs,
+ use with care */
+inline void kset_car_unsafe(klisp_State *K, TValue p, TValue v)
+{
+ klisp_assert(kpairp(p));
+ UNUSED(K);
+/* klispC_barrier(K, gcvalue(p), v); */
+ tv2pair(p)->car = v;
+}
+
+inline void kset_cdr_unsafe(klisp_State *K, TValue p, TValue v)
+{
+ klisp_assert(kpairp(p));
+ UNUSED(K);
+/* klispC_barrier(K, gcvalue(p), v); */
+ tv2pair(p)->cdr = v;
+}
/* GC: assumes car & cdr are rooted */
TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr);
@@ -66,8 +110,6 @@ TValue klist_g(klisp_State *K, bool m, int32_t n, ...);
#define kget_source_info(p_) (UNUSED(p_), KNIL)
#define kset_source_info(K_, p_, si_) (UNUSED(K_), UNUSED(p_), UNUSED(si_))
-bool kpairp(TValue obj);
-
inline TValue kget_dummy1(klisp_State *K)
{
klisp_assert(ttispair(K->dummy_pair1) && ttisnil(kcdr(K->dummy_pair1)));
diff --git a/src/kread.c b/src/kread.c
@@ -110,7 +110,7 @@ void try_shared_def(klisp_State *K, TValue def_token, TValue value)
TValue new_tok = kcons(K, kcdr(def_token), value);
krooted_tvs_push(K, new_tok);
- K->shared_dict = kcons(K, new_tok, K->shared_dict); /* value is protected by cons */
+ K->shared_dict = kcons(K, new_tok, K->shared_dict);
krooted_tvs_pop(K);
return;
}
@@ -392,7 +392,7 @@ TValue kread_fsm(klisp_State *K)
times */
TValue fp_old_si = kget_source_info(fp);
kset_source_info(K, fp, obj_si);
- kset_car(fp, obj);
+ kset_car_unsafe(K, fp, obj);
/* continue reading objects of list */
/* save first & last pair of the (still incomplete) list */
@@ -412,7 +412,7 @@ TValue kread_fsm(klisp_State *K)
TValue np = kcons_g(K, K->read_mconsp, obj, KNIL);
krooted_tvs_push(K, np);
kset_source_info(K, np, obj_si);
- kset_cdr(get_data(K), np);
+ kset_cdr_unsafe(K, get_data(K), np);
/* replace last pair of the (still incomplete) read next obj */
pop_data(K);
push_data(K, np);
@@ -425,7 +425,7 @@ TValue kread_fsm(klisp_State *K)
/* only change the state, keep the pair data to simplify
the close paren code (same as for ST_MIDDLE_LIST) */
pop_state(K);
- kset_cdr(get_data(K), obj);
+ kset_cdr_unsafe(K, get_data(K), obj);
push_state(K, ST_PAST_LAST_ILIST);
read_next_token = true;
break;
