summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog117
-rw-r--r--combi.c22
-rw-r--r--debug.c6
-rw-r--r--eval.c89
-rw-r--r--eval.h2
-rw-r--r--filter.c26
-rw-r--r--gc.c19
-rw-r--r--gc.h4
-rw-r--r--hash.c111
-rw-r--r--hash.h6
-rw-r--r--lib.c273
-rw-r--r--lib.h79
-rw-r--r--match.c20
-rw-r--r--parser.y12
-rw-r--r--rand.h2
-rw-r--r--stream.c14
-rw-r--r--stream.h12
-rw-r--r--syslog.c8
-rw-r--r--unwind.c2
19 files changed, 476 insertions, 348 deletions
diff --git a/ChangeLog b/ChangeLog
index 1bf6cf19..e71c05c6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,122 @@
2014-03-29 Kaz Kylheku <kaz@kylheku.com>
+ Change to how locations are passed around, for the sake of generational
+ GC. The issue being solved here is the accuracy of the gc_set function.
+ The existing impelmentation is too conservative. It has no generation
+ information about the memory location being stored, and so it assumes
+ the worst: that it is a location in the middle of a gen 1 object.
+ This is sub-optimal, creating unacceptable pressure against the
+ checkobj array and, worse, as a consequence causing unreachable gen 0
+ objects to be tenured into gen 1.
+
+ To solve this problem, we replace "val *" pointers with a structure
+ of type "loc" which keeps track of the object too, which lets us
+ discover the generation.
+
+ I tried another approach: using just a pointer with a bitfield
+ indicating the generation. This turned out to have a serious issue:
+ such a bitfield goes stale when the object is moved to a different
+ generation. The object holding the memory location is in gen 1, but the
+ annotated pointer still indicates gen 0. The gc_set function then
+ makes the wrong decision, and premature reclamation takes place.
+
+ * combi.c (perm_init_common, comb_gen_fun_common,
+ rcomb_gen_fun_common, rcomb_list_gen_fun): Update to new interfaces
+ for managing mutation.
+
+ * debug.c (debug): Update to new interfaces for managing mutation.
+ Avoid loc variable name.
+
+ * eval.c (env_fbind, env_fbind): Update to new interfaces
+ for managing mutation.
+ (lookup_var_l, dwim_loc): Return loc type and update to new interfaces.
+ (apply_frob_args, op_modplace, op_dohash, transform_op, mapcarv,
+ mappendv, repeat_infinite_func, repeat_times_func): Update to new
+ interfaces for managing mutation.
+
+ * eval.h (lookup_var_l): Declaration updated.
+
+ * filter.c (trie_add, trie_compress, trie_compress_intrinsic,
+ * build_filter, built_filter_from_list, filter_init): Update to new
+ * interfaces.
+
+ * gc.c (gc_set): Rewritten to use loc type which provides the exact
+ generation. We do not need the in_malloc_range hack any more, since
+ we have the backpointer to the object.
+ (gc_push): Take loc rather than raw pointer.
+
+ * gc.h (gc_set, gc_push): Declarations updated.
+
+ * hash.c (struct hash): The acons* functions use loc instead
+ of val * now.
+ (hash_equal_op, copy_hash, gethash_c, inhash, gethash_n, pushhash,
+ remhash, set_hash_userdata, hash_next, group_by, hash_keys,
+ hash_values, hash_pairs, hash_uni, hash_isec, hash_update,
+ hash_update_1): Updated to new interfaces for managing mutation.
+ (hash_grow): Needs hash table argument to call the new form of set.
+ (hash_process_weak): We need to use valptr to recover the val *
+ from the loc that we receive from some functions now.
+
+ * hash.h (gethash_c, gethash_f): Declarations updated.
+ (gethash_l): Inline function's prototype changes.
+
+ * lib.c (rplaca, rplacd, car_l, cdr_l, listref_l, tail, lastcons, last,
+ ltail, list_collect, list_collect_nconc, list_collect_append, nreverse,
+ lazy_appendv_func, lazy_appendv): Update to new interfaces.
+ (malloc_low_bound, malloc_high_bound): Static variables removed.
+ (adjust_bounds): Static function removed.
+ (chk_malloc, chk_malloc_gc_more, chk_calloc, chk_realloc):
+ Calls to adjust_bounds removed.
+ (in_malloc_range): Function removed.
+ (get_plist_f, string_extend, length_str, replace_str, make_sym,
+ delete_package, intern, rehome_sym, get_user_package,
+ get_system_package, get_keyword_package, func_get_env, vec_set_length,
+ vecref, vecref_l, vec_push, simple_lazy_stream_func, lazy_stream_func,
+ lazy_str, lazy_str_force, lazy_str_force_upto, acons_new, acons_new_c,
+ aconsql_new, aconsql_new_c, alist_nremove, alist_nremove1, merge,
+ sort_list, refset, obj_init): Update to new interfaces.
+
+ * lib.h (loc): New typedef.
+ (gc_set): Interface change.
+ (mkloc_fun): New inline function.
+ (mkloc, mkcloc, nulloc, nullocp, deref, valptr): New macros
+ (set): Interface change: takes loc as first argument,
+ rather than lvalue expression.
+ (mpush): Interface change: second argument is loc, rather
+ than lvalue.
+ (keyword_package, user_package, system_package, gensym_counter): Use
+ deref rather than dereference operator.
+ (in_malloc_range): Declaration removed.
+ (car_l, cdr_l, listref_l, tail, lastcons, ltail, getplist_f,
+ get_user_package, get_system_pckage, get_keyword_package,
+ vecref_l, acons_new_c, aconsql_new_c): Declarations updated.
+ (list_collect_decl): Updated to follow new interfaces.
+
+ * match.c (dest_set, h_coll, v_gather, v_collect, v_cat, v_output,
+ v_filter): Updated to follow new interfaces.
+
+ * parser.y (expand_meta, rlset): Updated to follow new interfaces.
+
+ * rand.h (random_state): Use deref.
+
+ * stream.c (string_in_get_line, string_in_get_char,
+ string_in_unget_char, strlist_out_put_string, strlist_out_put_char):
+ Updated to follow new interfaces.
+
+ * stream.h (std_input, std_output, std_debug, std_error,
+ std_null): Use deref macro.
+ (lookup_var_l): Declaration updated.
+
+ * syslog.c (syslog_put_string, syslog_put_char, syslog_put_byte,
+ syslog_set_prop): Updated to follow new interfaces.
+
+ * unwind.c (uw_register_subtype): Updated to follow
+ new interfaces.
+
+2014-03-29 Kaz Kylheku <kaz@kylheku.com>
+
+ Generational GC tweaks.
+
* gc.c (make_obj): If we have room in the freshobj array,
but are out of objects, then call more. Without this,
we don't take proper advantage of this nursing area.
diff --git a/combi.c b/combi.c
index 24061b2a..740aedd0 100644
--- a/combi.c
+++ b/combi.c
@@ -105,10 +105,10 @@ static val perm_init_common(val p, val k_null)
} else {
val state = vector(three, nil);
val c = vector(k, zero);
- set(*vecref_l(state, zero), p);
- set(*vecref_l(state, one), k);
- set(*vecref_l(state, two), c);
- *vecref_l(c, negone) = negone;
+ set(vecref_l(state, zero), p);
+ set(vecref_l(state, one), k);
+ set(vecref_l(state, two), c);
+ deref(vecref_l(c, negone)) = negone;
return state;
}
}
@@ -355,7 +355,7 @@ static void comb_gen_fun_common(val state)
val curr = first(iter);
val curr_rest = rest(curr);
if (curr_rest != prev && consp(curr_rest)) {
- set(*car_l(iter), curr_rest);
+ set(car_l(iter), curr_rest);
return;
} else if (rest(iter)) {
val next = second(iter);
@@ -363,11 +363,11 @@ static void comb_gen_fun_common(val state)
val next_rest_rest = rest(next_rest);
prev = curr;
if (next_rest != curr && consp(next_rest_rest))
- prev = set(*car_l(iter), next_rest_rest);
- }
+ prev = set(car_l(iter), next_rest_rest);
+ }
}
- *car_l(state) = nil;
+ deref(car_l(state)) = nil;
}
static val comb_list_gen_fun(val state)
@@ -516,16 +516,16 @@ static void rcomb_gen_fun_common(val state)
if (consp(curr_rest)) {
val jter;
for (jter = state; jter != next; jter = cdr(jter))
- set(*car_l(jter), curr_rest);
+ set(car_l(jter), curr_rest);
return;
} else if (next) {
val next = second(iter);
if (curr != next)
- set(*car_l(iter), rest(next));
+ set(car_l(iter), rest(next));
}
}
- *car_l(state) = nil;
+ deref(car_l(state)) = nil;
}
static val rcomb_list_gen_fun(val state)
diff --git a/debug.c b/debug.c
index 96a97580..42464113 100644
--- a/debug.c
+++ b/debug.c
@@ -89,15 +89,15 @@ static void show_bindings(val env, val stream)
val debug(val form, val bindings, val data, val line, val pos, val base)
{
uses_or2;
- val loc = source_loc(form);
- cons_bind (lineno, file, loc);
+ val rl = source_loc(form);
+ cons_bind (lineno, file, rl);
if (consp(data))
data = car(data);
else if (data == t)
data = nil;
- if (!step_mode && !memqual(loc, breakpoints)
+ if (!step_mode && !memqual(rl, breakpoints)
&& (debug_depth > next_depth))
{
return nil;
diff --git a/eval.c b/eval.c
index e97432cc..9d490a5a 100644
--- a/eval.c
+++ b/eval.c
@@ -116,7 +116,7 @@ val env_fbind(val env, val sym, val fun)
{
val cell;
type_check(env, ENV);
- cell = acons_new_c(sym, 0, &env->e.fbindings);
+ cell = acons_new_c(sym, nulloc, mkloc(env->e.fbindings, env));
rplacd(cell, fun);
return cell;
}
@@ -125,7 +125,7 @@ val env_vbind(val env, val sym, val obj)
{
val cell;
type_check(env, ENV);
- cell = acons_new_c(sym, 0, &env->e.vbindings);
+ cell = acons_new_c(sym, nulloc, mkloc(env->e.vbindings, env));
rplacd(cell, obj);
return cell;
}
@@ -191,7 +191,7 @@ static val lookup_sym_lisp1(val env, val sym)
return or2(gethash(top_vb, sym), gethash(top_fb, sym));
}
-val *lookup_var_l(val env, val sym)
+loc lookup_var_l(val env, val sym)
{
if (env) {
type_check(env, ENV);
@@ -211,7 +211,7 @@ val *lookup_var_l(val env, val sym)
{
val binding = gethash(top_vb, sym);
- return (binding) ? cdr_l(binding) : 0;
+ return (binding) ? cdr_l(binding) : nulloc;
}
}
@@ -642,9 +642,9 @@ val apply(val fun, val arglist, val ctx_form)
static val apply_frob_args(val args)
{
- val *plast = lastcons(args);
- if (plast) {
- *plast = car(*plast);
+ loc plast = lastcons(args);
+ if (!nullocp(plast)) {
+ deref(plast) = car(deref(plast));
return args;
} else {
return car(args);
@@ -1469,7 +1469,7 @@ static val op_tree_bind(val form, val env)
static val op_modplace(val form, val env);
-static val *dwim_loc(val form, val env, val op, val newform, val *retval)
+static loc dwim_loc(val form, val env, val op, val newform, val *retval)
{
val obj = eval_lisp1(second(form), env, form);
val args = eval_args_lisp1(rest(rest(form)), env, form);
@@ -1497,7 +1497,7 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
obj, index, nao);
}
- return 0;
+ return nulloc;
} else {
uses_or2;
@@ -1522,7 +1522,7 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
eval_error(form, lit("[~s ~s]: only set, inc, dec and del can be "
"used for string indices"), obj, index, nao);
}
- return 0;
+ return nulloc;
}
}
case SYM:
@@ -1549,12 +1549,12 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
eval_error(form, lit("[~s ~s]: ranges allow only set and del operators"),
obj, index, nao);
}
- return 0;
+ return nulloc;
} else {
if (op == del_s) {
*retval = vecref(obj, index);
replace_vec(obj, nil, index, plus(index, one));
- return 0;
+ return nulloc;
}
return vecref_l(obj, index);
}
@@ -1572,7 +1572,7 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
if (op == del_s) {
*retval = vecref(obj, index);
replace_list(obj, nil, index, plus(index, one));
- return 0;
+ return nulloc;
}
return listref_l(obj, index);
} else if (consp(index)) {
@@ -1596,7 +1596,7 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
eval_error(form, lit("[~s ~s]: ranges allow only set and del operators"),
obj, index, nao);
}
- return 0;
+ return nulloc;
} else {
eval_error(form, lit("[~s ~s]: index must be integer, or pair"),
cell, index, nao);
@@ -1605,7 +1605,8 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
case COBJ:
{
if (hashp(obj)) {
- val new_p, *loc;
+ val new_p;
+ loc place;
if (lt(length(args), one))
eval_error(form, lit("[~s ...]: hash indexing needs at least one arg"),
obj, nao);
@@ -1613,20 +1614,20 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval)
if (op == del_s) {
*retval = gethash(obj, first(args));
remhash(obj, first(args));
- return 0;
+ return nulloc;
}
- loc = gethash_l(obj, first(args), &new_p);
+ place = gethash_l(obj, first(args), mkcloc(new_p));
if (new_p)
- set(*loc, second(args));
- return loc;
+ set(place, second(args));
+ return place;
}
}
default:
eval_error(form, lit("object ~s not supported by [] notation"), obj, nao);
}
- return 0;
+ return nulloc;
}
static val op_modplace(val form, val env)
@@ -1637,7 +1638,7 @@ static val op_modplace(val form, val env)
val third_arg_p = rest(rest(form));
val newform = if3(car(third_arg_p), third(form), nil);
val newval = nil;
- val *loc = 0;
+ loc ptr = nulloc;
if (op == push_s) {
val tmp = place;
@@ -1651,16 +1652,16 @@ static val op_modplace(val form, val env)
if (symbolp(place)) {
if (!bindable(place))
eval_error(form, lit("~s: ~s is not a bindable symbol"), op, place, nao);
- loc = lookup_var_l(env, place);
- if (!loc)
+ ptr = lookup_var_l(env, place);
+ if (nullocp(ptr))
eval_error(form, lit("unbound variable ~s"), place, nao);
} else if (consp(place)) {
/* TODO: dispatch these with hash table. */
val sym = car(place);
if (sym == dwim_s) {
val ret = nil;
- loc = dwim_loc(place, env, op, newform, &ret);
- if (loc == 0)
+ ptr = dwim_loc(place, env, op, newform, &ret);
+ if (nullocp(ptr))
return ret;
} else if (sym == gethash_s) {
val hash = eval(second(place), env, form);
@@ -1671,19 +1672,19 @@ static val op_modplace(val form, val env)
remhash(hash, key);
return ret;
}
- loc = gethash_l(hash, key, &new_p);
+ ptr = gethash_l(hash, key, mkcloc(new_p));
if (new_p)
- set(*loc, eval(fourth(place), env, form));
+ set(ptr, eval(fourth(place), env, form));
} else if (sym == car_s) {
val cons = eval(second(place), env, form);
- loc = car_l(cons);
+ ptr = car_l(cons);
} else if (sym == cdr_s) {
val cons = eval(second(place), env, form);
- loc = cdr_l(cons);
+ ptr = cdr_l(cons);
} else if (sym == vecref_s) {
val vec = eval(second(place), env, form);
val ind = eval(third(place), env, form);
- loc = vecref_l(vec, ind);
+ ptr = vecref_l(vec, ind);
} else {
eval_error(form, lit("~s: ~s is not a recognized place form"),
op, place, nao);
@@ -1692,27 +1693,27 @@ static val op_modplace(val form, val env)
eval_error(form, lit("~s: ~s is not a place"), op, place, nao);
}
- if (!loc)
+ if (nullocp(ptr))
eval_error(form, lit("~s: place ~s doesn't exist"), op, place, nao);
if (op == set_s) {
if (!third_arg_p)
eval_error(form, lit("~s: missing argument"), op, nao);
- return set(*loc, eval(newform, env, form));
+ return set(ptr, eval(newform, env, form));
} else if (op == inc_s) {
val inc = or2(eval(newform, env, form), one);
- return set(*loc, plus(*loc, inc));
+ return set(ptr, plus(deref(ptr), inc));
} else if (op == dec_s) {
val inc = or2(eval(newform, env, form), one);
- return set(*loc, minus(*loc, inc));
+ return set(ptr, minus(deref(ptr), inc));
} else if (op == push_s) {
- return mpush(newval, *loc);
+ return mpush(newval, ptr);
} else if (op == pop_s) {
if (third_arg_p)
eval_error(form, lit("~s: superfluous argument"), op, nao);
- return pop(loc);
+ return pop(valptr(ptr));
} else if (op == flip_s) {
- return *loc = null(*loc);
+ return deref(ptr) = null(deref(ptr));
} else if (op == del_s) {
eval_error(form, lit("~s: cannot delete ~a"), op, place, nao);
}
@@ -1768,8 +1769,8 @@ static val op_dohash(val form, val env)
and also deleting them such that these variables end up
with the only reference. But in that case, those objects
will be noted in the GC's check list. */
- *cdr_l(keyvar) = car(cell);
- *cdr_l(valvar) = cdr(cell);
+ deref(cdr_l(keyvar)) = car(cell);
+ deref(cdr_l(valvar)) = cdr(cell);
eval_progn(body, new_env, form);
}
@@ -2295,7 +2296,7 @@ static val transform_op(val forms, val syms, val rg)
if (integerp(vararg)) {
val newsyms = syms;
val new_p;
- val cell = acons_new_c(vararg, &new_p, &newsyms);
+ val cell = acons_new_c(vararg, mkcloc(new_p), mkcloc(newsyms));
val sym = if3(new_p, rplacd(cell, gensym(format_op_arg(vararg))),
cdr(cell));
cons_bind (outsyms, outforms, transform_op(re, newsyms, rg));
@@ -2682,7 +2683,7 @@ val mapcarv(val fun, val list_of_lists)
if (!list)
return make_like(out, list_orig);
atail = list_collect(atail, car(list));
- *car_l(iter) = cdr(list);
+ deref(car_l(iter)) = cdr(list);
}
otail = list_collect(otail, apply(fun, args, nil));
@@ -2708,7 +2709,7 @@ static val mappendv(val fun, val list_of_lists)
if (!list)
return make_like(out, list_orig);
atail = list_collect(atail, car(list));
- *car_l(iter) = cdr(list);
+ deref(car_l(iter)) = cdr(list);
}
otail = list_collect_append(otail, apply(fun, args, nil));
@@ -2899,7 +2900,7 @@ static val repeat_infinite_func(val env, val lcons)
{
if (!car(env))
rplaca(env, cdr(env));
- rplaca(lcons, pop(car_l(env)));
+ rplaca(lcons, pop(valptr(car_l(env))));
rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
return nil;
}
@@ -2914,7 +2915,7 @@ static val repeat_times_func(val env, val lcons)
rplacd(list_count, count = minus(count, one));
}
- rplaca(lcons, pop(car_l(env)));
+ rplaca(lcons, pop(valptr(car_l(env))));
if (!car(env) && count == one) {
rplacd(lcons, nil);
diff --git a/eval.h b/eval.h
index a46d2a9a..25aa6bc5 100644
--- a/eval.h
+++ b/eval.h
@@ -33,7 +33,7 @@ val make_env(val fbindings, val vbindings, val up_env);
val env_fbind(val env, val sym, val fun);
val env_vbind(val env, val sym, val obj);
val lookup_var(val env, val sym);
-val *lookup_var_l(val env, val sym);
+loc lookup_var_l(val env, val sym);
val lookup_fun(val env, val sym);
val interp_fun(val env, val fun, val args);
void reg_var(val sym, val val);
diff --git a/filter.c b/filter.c
index 4ac65f17..646c4d28 100644
--- a/filter.c
+++ b/filter.c
@@ -62,10 +62,10 @@ static val trie_add(val trie, val key, val value)
for (node = trie, i = zero; lt(i, len); i = plus(i, one)) {
val ch = chr_str(key, i);
val newnode_p;
- val *loc = gethash_l(node, ch, &newnode_p);
+ loc place = gethash_l(node, ch, mkcloc(newnode_p));
if (newnode_p)
- set(*loc, make_hash(nil, nil, nil));
- node = *loc;
+ set(place, make_hash(nil, nil, nil));
+ node = deref(place);
}
set_hash_userdata(node, value);
@@ -84,21 +84,21 @@ static val trie_add(val trie, val key, val value)
* character, and whose CDR is the transition.
*/
-static void trie_compress(val *ptrie)
+static void trie_compress(loc ptrie)
{
- val trie = *ptrie;
+ val trie = deref(ptrie);
if (hashp(trie)) {
val count = hash_count(trie);
val value = get_hash_userdata(trie);
if (zerop(count)) {
- set(*ptrie, value);
+ set(ptrie, value);
} else if (count == one && nilp(value)) {
val iter = hash_begin(trie);
val cell = hash_next(iter);
- set(*ptrie, cons(car(cell), cdr(cell)));
- trie_compress(cdr_l(*ptrie));
+ set(ptrie, cons(car(cell), cdr(cell)));
+ trie_compress(cdr_l(deref(ptrie)));
} else {
val cell, iter = hash_begin(trie);
@@ -107,12 +107,12 @@ static void trie_compress(val *ptrie)
}
} else if (consp(trie)) {
trie_compress(cdr_l(trie));
- }
+ }
}
static val trie_compress_intrinsic(val ptrie)
{
- trie_compress(&ptrie);
+ trie_compress(mkcloc(ptrie));
return ptrie;
}
@@ -184,7 +184,7 @@ static val build_filter(struct filter_pair *pair, val compress_p)
trie_add(trie, static_str(pair[i].key), static_str(pair[i].value));
if (compress_p)
- trie_compress(&trie);
+ trie_compress(mkcloc(trie));
return trie;
}
@@ -198,7 +198,7 @@ static val build_filter_from_list(val list)
mapcar(curry_123_2(func_n3(trie_add), trie, first(tuple)), rest(tuple));
}
- trie_compress(&trie);
+ trie_compress(mkcloc(trie));
return trie;
}
@@ -706,7 +706,7 @@ void filter_init(void)
{
val trie = build_filter(from_html_table, nil);
trie_add(trie, lit("&#"), func_n1(html_numeric_handler));
- trie_compress(&trie);
+ trie_compress(mkcloc(trie));
sethash(filters, from_html_k, trie);
}
sethash(filters, upcase_k, func_n1(upcase_str));
diff --git a/gc.c b/gc.c
index 2c11d678..1f84cf2c 100644
--- a/gc.c
+++ b/gc.c
@@ -623,17 +623,20 @@ int gc_is_reachable(val obj)
#if CONFIG_GEN_GC
-val gc_set(val *ptr, val obj)
+val gc_set(loc lo, val obj)
{
- if (!full_gc) {
- if (checkobj_idx >= CHECKOBJ_VEC_SIZE) {
- gc();
- /* obj can't be in gen 0 because there are no baby objects after gc */
- } else if (in_malloc_range((mem_t *) ptr) && is_ptr(obj) && obj->t.gen == 0) {
+ val *ptr = valptr(lo);
+
+ if (lo.obj && is_ptr(obj) && lo.obj->t.gen == 1 && obj->t.gen == 0 && !full_gc) {
+ if (checkobj_idx < CHECKOBJ_VEC_SIZE) {
obj->t.gen = -1;
checkobj[checkobj_idx++] = obj;
+ } else {
+ gc();
+ /* obj can't be in gen 0 because there are no baby objects after gc */
}
}
+
*ptr = obj;
return obj;
}
@@ -654,9 +657,9 @@ val gc_mutated(val obj)
}
-val gc_push(val obj, val *plist)
+val gc_push(val obj, loc plist)
{
- return gc_set(plist, cons(obj, *plist));
+ return gc_set(plist, cons(obj, deref(plist)));
}
#endif
diff --git a/gc.h b/gc.h
index 345cdadb..c3efbe6a 100644
--- a/gc.h
+++ b/gc.h
@@ -35,8 +35,8 @@ void gc_mark(val);
int gc_is_reachable(val);
#if CONFIG_GEN_GC
-val gc_set(val *, val);
-val gc_push(val, val *);
+val gc_set(loc, val);
+val gc_push(val, loc);
val gc_mutated(val);
#endif
diff --git a/hash.c b/hash.c
index c5fdf335..f4692d56 100644
--- a/hash.c
+++ b/hash.c
@@ -57,7 +57,7 @@ struct hash {
cnum (*hash_fun)(val);
val (*equal_fun)(val, val);
val (*assoc_fun)(val key, val list);
- val (*acons_new_c_fun)(val key, val *new_p, val *list);
+ val (*acons_new_c_fun)(val key, loc new_p, loc list);
};
struct hash_iter {
@@ -270,12 +270,12 @@ static val hash_equal_op(val left, val right)
} else if (found) {
val loc = memq(found, pending);
pending = nappend2(ldiff(pending, loc), cdr(loc));
- set(*cdr_l(loc), free_conses);
+ set(cdr_l(loc), free_conses);
free_conses = loc;
} else {
ncons = or2(pop(&free_conses), cons(nil, nil));
- set(*car_l(ncons), lcell);
- set(*cdr_l(ncons), pending);
+ set(car_l(ncons), lcell);
+ set(cdr_l(ncons), pending);
pending = ncons;
}
@@ -289,12 +289,12 @@ static val hash_equal_op(val left, val right)
} else if (found) {
val loc = memq(found, pending);
pending = nappend2(ldiff(pending, loc), cdr(loc));
- set(*cdr_l(loc), free_conses);
+ set(cdr_l(loc), free_conses);
free_conses = loc;
} else {
ncons = or2(pop(&free_conses), cons(nil, nil));
- set(*car_l(ncons), rcell);
- set(*cdr_l(ncons), pending);
+ set(car_l(ncons), rcell);
+ set(cdr_l(ncons), pending);
pending = ncons;
}
}
@@ -422,7 +422,7 @@ static struct cobj_ops hash_ops = {
hash_hash_op,
};
-static void hash_grow(struct hash *h)
+static void hash_grow(struct hash *h, val hash)
{
cnum i;
cnum new_modulus = 2 * h->modulus;
@@ -437,16 +437,17 @@ static void hash_grow(struct hash *h)
val entry = car(conses);
val next = cdr(conses);
val key = car(entry);
- val *pchain = vecref_l(new_table,
- num_fast(h->hash_fun(key) % new_modulus));
- set(*cdr_l(conses), *pchain);
- *pchain = conses;
+ loc pchain = vecref_l(new_table,
+ num_fast(h->hash_fun(key) % new_modulus));
+ set(cdr_l(conses), deref(pchain));
+ set(pchain, conses);
conses = next;
}
}
h->modulus = new_modulus;
- set(h->table, new_table);
+ h->table = new_table;
+ set(mkloc(h->table, hash), new_table);
}
val make_hash(val weak_keys, val weak_vals, val equal_based)
@@ -518,19 +519,19 @@ val copy_hash(val existing)
h->acons_new_c_fun = ex->acons_new_c_fun;
for (iter = zero; lt(iter, mod); iter = plus(iter, one))
- set(*vecref_l(h->table, iter), copy_alist(vecref(ex->table, iter)));
+ set(vecref_l(h->table, iter), copy_alist(vecref(ex->table, iter)));
return hash;
}
-val gethash_c(val hash, val key, val *new_p)
+val gethash_c(val hash, val key, loc new_p)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
- val *pchain = vecref_l(h->table, num_fast(h->hash_fun(key) % h->modulus));
- val old = *pchain;
+ loc pchain = vecref_l(h->table, num_fast(h->hash_fun(key) % h->modulus));
+ val old = deref(pchain);
val cell = h->acons_new_c_fun(key, new_p, pchain);
- if (old != *pchain && ++h->count > 2 * h->modulus)
- hash_grow(h);
+ if (old != deref(pchain) && ++h->count > 2 * h->modulus)
+ hash_grow(h, hash);
return cell;
}
@@ -547,10 +548,10 @@ val inhash(val hash, val key, val init)
val cell;
if (missingp(init)) {
- gethash_f(hash, key, &cell);
+ gethash_f(hash, key, mkcloc(cell));
} else {
val new_p;
- cell = gethash_c(hash, key, &new_p);
+ cell = gethash_c(hash, key, mkcloc(new_p));
if (new_p)
rplacd(cell, init);
}
@@ -558,12 +559,12 @@ val inhash(val hash, val key, val init)
return cell;
}
-val gethash_f(val hash, val key, val *found)
+val gethash_f(val hash, val key, loc found)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
val chain = vecref(h->table, num_fast(h->hash_fun(key) % h->modulus));
- set(*found, h->assoc_fun(key, chain));
- return cdr(*found);
+ set(found, h->assoc_fun(key, chain));
+ return cdr(deref(found));
}
val gethash_n(val hash, val key, val notfound_val)
@@ -577,26 +578,26 @@ val gethash_n(val hash, val key, val notfound_val)
val sethash(val hash, val key, val value)
{
val new_p;
- rplacd(gethash_c(hash, key, &new_p), value);
+ rplacd(gethash_c(hash, key, mkcloc(new_p)), value);
return new_p;
}
val pushhash(val hash, val key, val value)
{
val new_p;
- mpush(value, *gethash_l(hash, key, &new_p));
+ mpush(value, gethash_l(hash, key, mkcloc(new_p)));
return new_p;
}
val remhash(val hash, val key)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
- val *pchain = vecref_l(h->table, num_fast(h->hash_fun(key) % h->modulus));
- val existing = h->assoc_fun(key, *pchain);
+ loc pchain = vecref_l(h->table, num_fast(h->hash_fun(key) % h->modulus));
+ val existing = h->assoc_fun(key, deref(pchain));
if (existing) {
- val loc = memq(existing, *pchain);
- set(*pchain, nappend2(ldiff(*pchain, loc), cdr(loc)));
+ val cell = memq(existing, deref(pchain));
+ set(pchain, nappend2(ldiff(deref(pchain), cell), cdr(cell)));
h->count--;
bug_unless (h->count >= 0);
}
@@ -620,7 +621,7 @@ val set_hash_userdata(val hash, val data)
{
struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
val olddata = h->userdata;
- set(h->userdata, data);
+ set(mkloc(h->userdata, hash), data);
return olddata;
}
@@ -669,7 +670,7 @@ val hash_next(val iter)
while (nilp(hi->cons)) {
if (++hi->chain >= h->modulus)
return nil;
- set(hi->cons, vecref(h->table, num_fast(hi->chain)));
+ set(mkloc(hi->cons, iter), vecref(h->table, num_fast(hi->chain)));
}
return car(hi->cons);
}
@@ -720,7 +721,7 @@ void hash_process_weak(void)
that are garbage. */
for (i = 0; i < h->modulus; i++) {
val ind = num_fast(i);
- val *pchain = vecref_l(h->table, ind);
+ val *pchain = valptr(vecref_l(h->table, ind));
val *iter;
for (iter = pchain; !gc_is_reachable(*iter); ) {
@@ -732,7 +733,7 @@ void hash_process_weak(void)
breakpt();
#endif
} else {
- iter = cdr_l(*iter);
+ iter = valptr(cdr_l(*iter));
}
}
}
@@ -744,7 +745,7 @@ void hash_process_weak(void)
that are garbage. */
for (i = 0; i < h->modulus; i++) {
val ind = num_fast(i);
- val *pchain = vecref_l(h->table, ind);
+ val *pchain = valptr(vecref_l(h->table, ind));
val *iter;
for (iter = pchain; !gc_is_reachable(*iter); ) {
@@ -756,7 +757,7 @@ void hash_process_weak(void)
breakpt();
#endif
} else {
- iter = cdr_l(*iter);
+ iter = valptr(cdr_l(*iter));
}
}
}
@@ -768,7 +769,7 @@ void hash_process_weak(void)
or values that are garbage. */
for (i = 0; i < h->modulus; i++) {
val ind = num_fast(i);
- val *pchain = vecref_l(h->table, ind);
+ val *pchain = valptr(vecref_l(h->table, ind));
val *iter;
for (iter = pchain; !gc_is_reachable(*iter); ) {
@@ -784,7 +785,7 @@ void hash_process_weak(void)
breakpt();
#endif
} else {
- iter = cdr_l(*iter);
+ iter = valptr(cdr_l(*iter));
}
}
}
@@ -851,7 +852,7 @@ val group_by(val func, val seq, val hashv_args)
static val hash_keys_lazy(val iter, val lcons)
{
val cell = hash_next(iter);
- set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, car(cell))));
+ set(mkloc(lcons->lc.cdr, lcons), if2(cell, make_half_lazy_cons(lcons->lc.func, car(cell))));
return nil;
}
@@ -867,7 +868,7 @@ val hash_keys(val hash)
static val hash_values_lazy(val iter, val lcons)
{
val cell = hash_next(iter);
- set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, cdr(cell))));
+ set(mkloc(lcons->lc.cdr, lcons), if2(cell, make_half_lazy_cons(lcons->lc.func, cdr(cell))));
return nil;
}
@@ -883,10 +884,10 @@ val hash_values(val hash)
static val hash_pairs_lazy(val iter, val lcons)
{
val cell = hash_next(iter);
- set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func,
- cons(car(cell),
- cons(cdr(cell),
- nil)))));
+ set(mkloc(lcons->lc.cdr, lcons), if2(cell, make_half_lazy_cons(lcons->lc.func,
+ cons(car(cell),
+ cons(cdr(cell),
+ nil)))));
return nil;
}
@@ -903,7 +904,7 @@ val hash_pairs(val hash)
static val hash_alist_lazy(val iter, val lcons)
{
val cell = hash_next(iter);
- set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, cell)));
+ set(mkloc(lcons->lc.cdr, lcons), if2(cell, make_half_lazy_cons(lcons->lc.func, cell)));
return nil;
}
@@ -942,8 +943,8 @@ val hash_uni(val hash1, val hash2, val join_func)
if (missingp(join_func)) {
sethash(hout, car(entry), cdr(entry));
} else {
- val *loc = gethash_l(hout, car(entry), 0);
- set(*loc, funcall2(join_func, cdr(entry), *loc));
+ loc ptr = gethash_l(hout, car(entry), nulloc);
+ set(ptr, funcall2(join_func, cdr(entry), deref(ptr)));
}
}
@@ -991,7 +992,7 @@ val hash_isec(val hash1, val hash2, val join_func)
entry = hash_next(hiter))
{
val found;
- val data2 = gethash_f(hash2, car(entry), &found);
+ val data2 = gethash_f(hash2, car(entry), mkcloc(found));
if (found) {
if (missingp(join_func))
sethash(hout, car(entry), cdr(entry));
@@ -1009,8 +1010,8 @@ val hash_update(val hash, val fun)
val iter = hash_begin(hash);
val cell;
while ((cell = hash_next(iter)) != nil) {
- val *loc = cdr_l(cell);
- set(*loc, funcall1(fun, *loc));
+ loc ptr = cdr_l(cell);
+ set(ptr, funcall1(fun, deref(ptr)));
}
return hash;
}
@@ -1019,18 +1020,18 @@ val hash_update_1(val hash, val key, val fun, val init)
{
if (missingp(init)) {
val cons;
- val data = gethash_f(hash, key, &cons);
+ val data = gethash_f(hash, key, mkcloc(cons));
if (cons)
rplacd(cons, funcall1(fun, data));
return data;
} else {
val new_p;
- val *place = gethash_l(hash, key, &new_p);
+ loc place = gethash_l(hash, key, mkcloc(new_p));
if (new_p)
- set(*place, funcall1(fun, init));
+ set(place, funcall1(fun, init));
else
- set(*place, funcall1(fun, *place));
- return *place;
+ set(place, funcall1(fun, deref(place)));
+ return deref(place);
}
}
diff --git a/hash.h b/hash.h
index e90fccd4..3d581e3e 100644
--- a/hash.h
+++ b/hash.h
@@ -29,11 +29,11 @@ extern val weak_keys_k, weak_vals_k, equal_based_k;
val make_hash(val weak_keys, val weak_vals, val equal_based);
val make_similar_hash(val existing);
val copy_hash(val existing);
-val gethash_c(val hash, val key, val *new_p);
+val gethash_c(val hash, val key, loc new_p);
val gethash(val hash, val key);
val inhash(val hash, val key, val init);
val gethash_n(val hash, val key, val notfound_val);
-val gethash_f(val hash, val key, val *found);
+val gethash_f(val hash, val key, loc found);
val sethash(val hash, val key, val value);
val pushhash(val hash, val key, val value);
val remhash(val hash, val key);
@@ -61,7 +61,7 @@ val hash_update_1(val hash, val key, val fun, val init);
void hash_process_weak(void);
-INLINE val *gethash_l(val hash, val key, val *new_p)
+INLINE loc gethash_l(val hash, val key, loc new_p)
{
return cdr_l(gethash_c(hash, key, new_p));
}
diff --git a/lib.c b/lib.c
index 03760ef0..e3390559 100644
--- a/lib.c
+++ b/lib.c
@@ -252,9 +252,9 @@ val rplaca(val cons, val new_car)
{
switch (type(cons)) {
case CONS:
- return set(cons->c.car, new_car);
+ return set(mkloc(cons->c.car, cons), new_car);
case LCONS:
- return set(cons->lc.car, new_car);
+ return set(mkloc(cons->lc.car, cons), new_car);
default:
type_mismatch(lit("~s is not a cons"), cons, nao);
}
@@ -265,41 +265,41 @@ val rplacd(val cons, val new_cdr)
{
switch (type(cons)) {
case CONS:
- return set(cons->c.cdr, new_cdr);
+ return set(mkloc(cons->c.cdr, cons), new_cdr);
case LCONS:
- return set(cons->lc.cdr, new_cdr);
+ return set(mkloc(cons->lc.cdr, cons), new_cdr);
default:
type_mismatch(lit("~s is not a cons"), cons, nao);
}
}
-val *car_l(val cons)
+loc car_l(val cons)
{
switch (type(cons)) {
case CONS:
- return &cons->c.car;
+ return mkloc(cons->c.car, cons);
case LCONS:
if (cons->lc.func) {
funcall1(cons->lc.func, cons);
cons->lc.func = nil;
}
- return &cons->lc.car;
+ return mkloc(cons->lc.car, cons);
default:
type_mismatch(lit("~s is not a cons"), cons, nao);
}
}
-val *cdr_l(val cons)
+loc cdr_l(val cons)
{
switch (type(cons)) {
case CONS:
- return &cons->c.cdr;
+ return mkloc(cons->c.cdr, cons);
case LCONS:
if (cons->lc.func) {
funcall1(cons->lc.func, cons);
cons->lc.func = nil;
}
- return &cons->lc.cdr;
+ return mkloc(cons->lc.cdr, cons);
default:
type_mismatch(lit("~s is not a cons"), cons, nao);
}
@@ -379,7 +379,7 @@ val listref(val list, val ind)
return car(list);
}
-val *listref_l(val list, val ind)
+loc listref_l(val list, val ind)
{
val olist = list;
val oind = ind;
@@ -396,16 +396,16 @@ val *listref_l(val list, val ind)
olist, oind, nao);
}
-val *tail(val cons)
+loc tail(val cons)
{
while (cdr(cons))
cons = cdr(cons);
return cdr_l(cons);
}
-val *lastcons(val list)
+loc lastcons(val list)
{
- val *ret = 0;
+ loc ret = nulloc;
while (consp(cdr(list))) {
ret = cdr_l(list);
list = cdr(list);
@@ -415,14 +415,14 @@ val *lastcons(val list)
val last(val list)
{
- val *p = lastcons(list);
- return p ? *p : list;
+ loc p = lastcons(list);
+ return nullocp(p) ? deref(p) : list;
}
-val *ltail(val *cons)
+loc ltail(loc cons)
{
- while (cdr(*cons))
- cons = cdr_l(*cons);
+ while (cdr(deref(cons)))
+ cons = cdr_l(deref(cons));
return cons;
}
@@ -514,78 +514,78 @@ val tolist(val seq)
}
}
-val *list_collect(val *ptail, val obj)
+loc list_collect(loc ptail, val obj)
{
- switch (type(*ptail)) {
+ switch (type(deref(ptail))) {
case NIL:
- set(*ptail, cons(obj, nil));
+ set(ptail, cons(obj, nil));
return ptail;
case CONS:
case LCONS:
- ptail = tail(*ptail);
- set(*ptail, cons(obj, nil));
+ ptail = tail(deref(ptail));
+ set(ptail, cons(obj, nil));
return ptail;
case VEC:
- replace_vec(*ptail, cons(obj, nil), t, t);
+ replace_vec(deref(ptail), cons(obj, nil), t, t);
return ptail;
case STR:
case LIT:
case LSTR:
- replace_str(*ptail, cons(obj, nil), t, t);
+ replace_str(deref(ptail), cons(obj, nil), t, t);
return ptail;
default:
- uw_throwf(error_s, lit("cannot append ~s to ~s"), obj, *ptail, nao);
+ uw_throwf(error_s, lit("cannot append ~s to ~s"), obj, deref(ptail), nao);
}
}
-val *list_collect_nconc(val *ptail, val obj)
+loc list_collect_nconc(loc ptail, val obj)
{
- switch (type(*ptail)) {
+ switch (type(deref(ptail))) {
case NIL:
- set(*ptail, obj);
+ set(ptail, obj);
return ptail;
case CONS:
case LCONS:
- ptail = tail(*ptail);
- set(*ptail, obj);
+ ptail = tail(deref(ptail));
+ set(ptail, obj);
return ptail;
case VEC:
- replace_vec(*ptail, obj, t, t);
+ replace_vec(deref(ptail), obj, t, t);
return ptail;
case STR:
case LIT:
case LSTR:
- replace_str(*ptail, obj, t, t);
+ replace_str(deref(ptail), obj, t, t);
return ptail;
default:
- uw_throwf(error_s, lit("cannot nconc ~s to ~s"), obj, *ptail, nao);
+ uw_throwf(error_s, lit("cannot nconc ~s to ~s"), obj, deref(ptail), nao);
}
}
-val *list_collect_append(val *ptail, val obj)
+loc list_collect_append(loc ptail, val obj)
{
- switch (type(*ptail)) {
+ switch (type(deref(ptail))) {
case NIL:
- set(*ptail, obj);
+ set(ptail, obj);
return ptail;
case CONS:
case LCONS:
- set(*ptail, copy_list(*ptail));
- ptail = tail(*ptail);
- set(*ptail, obj);
+ set(ptail, copy_list(deref(ptail)));
+ ptail = tail(deref(ptail));
+ set(ptail, obj);
return ptail;
case VEC:
- set(*ptail, copy_vec(*ptail));
- replace_vec(*ptail, obj, t, t);
+ set(ptail, copy_vec(deref(ptail)));
+ replace_vec(deref(ptail), obj, t, t);
return ptail;
case STR:
case LIT:
case LSTR:
- set(*ptail, copy_str(*ptail));
- replace_str(*ptail, obj, t, t);
+ set(ptail, copy_str(deref(ptail)));
+ replace_str(deref(ptail), obj, t, t);
return ptail;
default:
- uw_throwf(error_s, lit("cannot append ~s to ~s"), obj, *ptail, nao);
+ uw_throwf(error_s, lit("cannot append ~s to ~s"), obj, deref(ptail), nao);
}
}
@@ -595,7 +595,7 @@ val nreverse(val in)
while (in) {
val temp = cdr(in);
- set(*cdr_l(in), rev);
+ set(cdr_l(in), rev);
rev = in;
in = temp;
}
@@ -780,9 +780,9 @@ static val lazy_appendv_func(val env, val lcons)
rplacd(env, lists);
{
- val *ptail = ltail(&nonempty);
- rplaca(env, car(*ptail));
- set(*ptail, make_lazy_cons(lcons_fun(lcons)));
+ loc ptail = ltail(mkcloc(nonempty));
+ rplaca(env, car(deref(ptail)));
+ set(ptail, make_lazy_cons(lcons_fun(lcons)));
rplacd(lcons, nonempty);
}
return nil;
@@ -802,9 +802,9 @@ val lazy_appendv(val lists)
return nonempty;
{
- val *ptail = ltail(&nonempty);
- set(*ptail, make_lazy_cons(func_f1(cons(car(*ptail), lists),
- lazy_appendv_func)));
+ loc ptail = ltail(mkcloc(nonempty));
+ set(ptail, make_lazy_cons(func_f1(cons(car(deref(ptail)), lists),
+ lazy_appendv_func)));
return nonempty;
}
}
@@ -1292,18 +1292,8 @@ val equal(val left, val right)
internal_error("unhandled case in equal function");
}
-static mem_t *malloc_low_bound, *malloc_high_bound;
-
alloc_bytes_t malloc_bytes;
-static void adjust_bounds(mem_t *ptr, size_t size)
-{
- if (ptr < malloc_low_bound)
- malloc_low_bound = ptr;
- else if (ptr + size > malloc_high_bound)
- malloc_high_bound = ptr + size;
-}
-
mem_t *chk_malloc(size_t size)
{
mem_t *ptr = (mem_t *) malloc(size);
@@ -1312,7 +1302,6 @@ mem_t *chk_malloc(size_t size)
if (size && ptr == 0)
ptr = (mem_t *) oom_realloc(0, size);
- adjust_bounds(ptr, size);
malloc_bytes += size;
return ptr;
}
@@ -1323,7 +1312,6 @@ mem_t *chk_malloc_gc_more(size_t size)
assert (!async_sig_enabled);
if (size && ptr == 0)
ptr = (mem_t *) oom_realloc(0, size);
- adjust_bounds(ptr, size);
return ptr;
}
@@ -1338,7 +1326,6 @@ mem_t *chk_calloc(size_t n, size_t size)
ptr = (mem_t *) oom_realloc(0, total);
memset(ptr, 0, total);
}
- adjust_bounds(ptr, size);
malloc_bytes += total;
return ptr;
}
@@ -1351,16 +1338,10 @@ mem_t *chk_realloc(mem_t *old, size_t size)
if (size != 0 && newptr == 0)
newptr = oom_realloc(old, size);
- adjust_bounds(newptr, size);
malloc_bytes += size;
return newptr;
}
-int in_malloc_range(mem_t *ptr)
-{
- return ptr >= malloc_low_bound && ptr < malloc_high_bound;
-}
-
wchar_t *chk_strdup(const wchar_t *str)
{
size_t nchar = wcslen(str) + 1;
@@ -1477,17 +1458,17 @@ val getplist(val list, val key)
return nil;
}
-val getplist_f(val list, val key, val *found)
+val getplist_f(val list, val key, loc found)
{
for (; list; list = cdr(cdr(list))) {
val ind = first(list);
if (ind == key) {
- *found = t;
+ deref(found) = t;
return second(list);
}
}
- *found = nil;
+ deref(found) = nil;
return nil;
}
@@ -1881,8 +1862,8 @@ val string_extend(val str, val tail)
str->st.str = (wchar_t *) chk_realloc((mem_t *) str->st.str,
alloc * sizeof *str->st.str);
- set(str->st.alloc, num(alloc));
- set(str->st.len, plus(str->st.len, needed));
+ set(mkloc(str->st.alloc, str), num(alloc));
+ set(mkloc(str->st.len, str), plus(str->st.len, needed));
if (stringp(tail)) {
wmemcpy(str->st.str + len, c_str(tail), c_num(needed) + 1);
@@ -1925,8 +1906,8 @@ val length_str(val str)
}
if (!str->st.len) {
- set(str->st.len, num(wcslen(str->st.str)));
- set(str->st.alloc, plus(str->st.len, one));
+ set(mkloc(str->st.len, str), num(wcslen(str->st.str)));
+ set(mkloc(str->st.alloc, str), plus(str->st.len, one));
}
return str->st.len;
}
@@ -2191,7 +2172,7 @@ val replace_str(val str_in, val items, val from, val to)
wmemmove(str_in->st.str + t - c_num(len_diff),
str_in->st.str + t, (l - t) + 1);
- set(str_in->st.len, minus(len, len_diff));
+ set(mkloc(str_in->st.len, str_in), minus(len, len_diff));
to = plus(from, len_it);
} else if (lt(len_rep, len_it)) {
val len_diff = minus(len_it, len_rep);
@@ -2732,9 +2713,9 @@ val make_sym(val name)
val gensym(val prefix)
{
prefix = default_arg(prefix, lit("g"));
- val *gs_loc = &gensym_counter;
+ loc gs_loc = lookup_var_l(nil, gensym_counter_s);
val name = format(nil, lit("~a~,04a"), prefix,
- set(*gs_loc, plus(*gs_loc, one)), nao);
+ set(gs_loc, plus(deref(gs_loc), one)), nao);
return make_sym(name);
}
@@ -2781,7 +2762,7 @@ val delete_package(val package)
val intern(val str, val package)
{
val new_p;
- val *place;
+ loc place;
if (null_or_missing_p(package)) {
package = user_package;
@@ -2794,14 +2775,14 @@ val intern(val str, val package)
type_check (package, PKG);
- place = gethash_l(package->pk.symhash, str, &new_p);
+ place = gethash_l(package->pk.symhash, str, mkcloc(new_p));
if (!new_p) {
- return *place;
+ return deref(place);
} else {
val newsym = make_sym(str);
newsym->s.package = package;
- return set(*place, newsym);
+ return set(place, newsym);
}
}
@@ -2824,7 +2805,7 @@ val rehome_sym(val sym, val package)
if (sym->s.package)
remhash(sym->s.package->pk.symhash, symbol_name(sym));
- set(sym->s.package, package);
+ set(mkloc(sym->s.package, sym), package);
sethash(package->pk.symhash, symbol_name(sym), sym);
return sym;
}
@@ -2845,24 +2826,24 @@ val keywordp(val sym)
return (symbolp(sym) && symbol_package(sym) == keyword_package) ? t : nil;
}
-val *get_user_package(void)
+loc get_user_package(void)
{
if (nilp(user_package_s))
- return &user_package_var;
+ return mkcloc(user_package_var);
return lookup_var_l(nil, user_package_s);
}
-val *get_system_package(void)
+loc get_system_package(void)
{
if (nilp(system_package_s))
- return &system_package_var;
+ return mkcloc(system_package_var);
return lookup_var_l(nil, system_package_s);
}
-val *get_keyword_package(void)
+loc get_keyword_package(void)
{
if (nilp(keyword_package_s))
- return &keyword_package_var;
+ return mkcloc(keyword_package_var);
return lookup_var_l(nil, keyword_package_s);
}
@@ -3270,7 +3251,7 @@ val func_get_env(val fun)
val func_set_env(val fun, val env)
{
type_check(fun, FUN);
- set(fun->f.env, env);
+ set(mkloc(fun->f.env, fun), env);
return env;
}
@@ -3932,7 +3913,7 @@ val vec_set_length(val vec, val length)
val *newvec = (val *) chk_realloc((mem_t *) (vec->v.vec - 2),
(new_alloc + 2) * sizeof *newvec);
vec->v.vec = newvec + 2;
- set(vec->v.vec[vec_alloc], num(new_alloc));
+ set(mkloc(vec->v.vec[vec_alloc], vec), num(new_alloc));
#if HAVE_VALGRIND
vec->v.vec_true_start = newvec;
#endif
@@ -3944,7 +3925,7 @@ val vec_set_length(val vec, val length)
vec->v.vec[i] = nil;
}
- set(vec->v.vec[vec_length], length);
+ set(mkloc(vec->v.vec[vec_length], vec), length);
}
return vec;
@@ -3962,7 +3943,7 @@ val vecref(val vec, val ind)
return vec->v.vec[index];
}
-val *vecref_l(val vec, val ind)
+loc vecref_l(val vec, val ind)
{
cnum index = c_num(ind);
cnum len = c_num(length_vec(vec));
@@ -3971,14 +3952,14 @@ val *vecref_l(val vec, val ind)
if (index < 0 || index >= len)
uw_throwf(error_s, lit("vecref: ~s is out of range for vector ~s"),
ind, vec, nao);
- return vec->v.vec + index;
+ return mkloc(vec->v.vec[index], vec);
}
val vec_push(val vec, val item)
{
val length = length_vec(vec);
vec_set_length(vec, plus(length, one));
- set(*vecref_l(vec, length), item);
+ set(vecref_l(vec, length), item);
return length;
}
@@ -4199,8 +4180,8 @@ toobig:
static val simple_lazy_stream_func(val stream, val lcons)
{
- if (set(lcons->lc.car, get_line(stream)) != nil)
- set(lcons->lc.cdr, make_lazy_cons(lcons->lc.func));
+ if (set(mkloc(lcons->lc.car, lcons), get_line(stream)) != nil)
+ set(mkloc(lcons->lc.cdr, lcons), make_lazy_cons(lcons->lc.func));
else
lcons->lc.cdr = nil;
@@ -4225,8 +4206,8 @@ static val lazy_stream_func(val env, val lcons)
val stream = car(env);
val prefetched_line = cdr(env);
- set(lcons->lc.car, prefetched_line);
- set(lcons->lc.cdr, lazy_stream_cont(stream, lcons->lc.func, env));
+ set(mkloc(lcons->lc.car, lcons), prefetched_line);
+ set(mkloc(lcons->lc.cdr, lcons), lazy_stream_cont(stream, lcons->lc.func, env));
return prefetched_line;
}
@@ -4263,12 +4244,12 @@ val lazy_str(val lst, val term, val limit)
obj->ls.prefix = null_string;
obj->ls.list = nil;
} else {
- set(obj->ls.prefix, cat_str(list(first(lst), term, nao), nil));
- set(obj->ls.list, rest(lst));
+ set(mkloc(obj->ls.prefix, obj), cat_str(list(first(lst), term, nao), nil));
+ set(mkloc(obj->ls.list, obj), rest(lst));
limit = if2(limit, minus(limit, one));
}
- set(obj->ls.opts, cons(term, limit));
+ set(mkloc(obj->ls.opts, obj), cons(term, limit));
return obj;
}
@@ -4282,13 +4263,13 @@ val lazy_str_force(val lstr)
while ((!lim || gt(lim, zero)) && lstr->ls.list) {
val next = pop(&lstr->ls.list);
val term = car(lstr->ls.opts);
- set(lstr->ls.prefix, cat_str(list(lstr->ls.prefix, next, term, nao), nil));
+ set(mkloc(lstr->ls.prefix, lstr), cat_str(list(lstr->ls.prefix, next, term, nao), nil));
if (lim)
lim = minus(lim, one);
}
if (lim)
- set(*cdr_l(lstr->ls.opts), lim);
+ set(cdr_l(lstr->ls.opts), lim);
return lstr->ls.prefix;
}
@@ -4305,13 +4286,13 @@ val lazy_str_force_upto(val lstr, val index)
{
val next = pop(&lstr->ls.list);
val term = car(lstr->ls.opts);
- set(lstr->ls.prefix, cat_str(list(lstr->ls.prefix, next, term, nao), nil));
+ set(mkloc(lstr->ls.prefix, lstr), cat_str(list(lstr->ls.prefix, next, term, nao), nil));
if (lim)
lim = minus(lim, one);
}
if (lim)
- set(*cdr_l(lstr->ls.opts), lim);
+ set(cdr_l(lstr->ls.opts), lim);
return lt(index, length_str(lstr->ls.prefix));
}
@@ -4505,26 +4486,26 @@ val acons_new(val key, val value, val list)
val existing = assoc(key, list);
if (existing) {
- set(*cdr_l(existing), value);
+ set(cdr_l(existing), value);
return list;
} else {
return cons(cons(key, value), list);
}
}
-val acons_new_c(val key, val *new_p, val *list)
+val acons_new_c(val key, loc new_p, loc list)
{
- val existing = assoc(key, *list);
+ val existing = assoc(key, deref(list));
if (existing) {
- if (new_p)
- *new_p = nil;
+ if (!nullocp(new_p))
+ deref(new_p) = nil;
return existing;
} else {
val nc = cons(key, nil);
- set(*list, cons(nc, *list));
- if (new_p)
- *new_p = t;
+ set(list, cons(nc, deref(list)));
+ if (!nullocp(new_p))
+ deref(new_p) = t;
return nc;
}
}
@@ -4534,26 +4515,26 @@ val aconsql_new(val key, val value, val list)
val existing = assql(key, list);
if (existing) {
- set(*cdr_l(existing), value);
+ set(cdr_l(existing), value);
return list;
} else {
return cons(cons(key, value), list);
}
}
-val aconsql_new_c(val key, val *new_p, val *list)
+val aconsql_new_c(val key, loc new_p, loc list)
{
- val existing = assql(key, *list);
+ val existing = assql(key, deref(list));
if (existing) {
- if (new_p)
- *new_p = nil;
+ if (!nullocp(new_p))
+ deref(new_p) = nil;
return existing;
} else {
val nc = cons(key, nil);
- set(*list, cons(nc, *list));
- if (new_p)
- *new_p = t;
+ set(list, cons(nc, deref(list)));
+ if (!nullocp(new_p))
+ deref(new_p) = t;
return nc;
}
}
@@ -4576,13 +4557,13 @@ val alist_remove1(val list, val key)
val alist_nremove(val list, val keys)
{
- val *plist = &list;
+ loc plist = mkcloc(list);
- while (*plist) {
- if (memqual(car(car(*plist)), keys))
- *plist = cdr(*plist);
+ while (deref(plist)) {
+ if (memqual(car(car(deref(plist))), keys))
+ deref(plist) = cdr(deref(plist));
else
- plist = cdr_l(*plist);
+ plist = cdr_l(deref(plist));
}
return list;
@@ -4590,13 +4571,13 @@ val alist_nremove(val list, val keys)
val alist_nremove1(val list, val key)
{
- val *plist = &list;
+ loc plist = mkcloc(list);
- while (*plist) {
- if (equal(car(car(*plist)), key))
- *plist = cdr(*plist);
+ while (deref(plist)) {
+ if (equal(car(car(deref(plist))), key))
+ deref(plist) = cdr(deref(plist));
else
- plist = cdr_l(*plist);
+ plist = cdr_l(deref(plist));
}
return list;
@@ -4655,12 +4636,12 @@ val merge(val list1, val list2, val lessfun, val keyfun)
if (funcall2(lessfun, el1, el2)) {
val next = cdr(list1);
- *cdr_l(list1) = nil;
+ deref(cdr_l(list1)) = nil;
ptail = list_collect_nconc(ptail, list1);
list1 = next;
} else {
val next = cdr(list2);
- *cdr_l(list2) = nil;
+ deref(cdr_l(list2)) = nil;
ptail = list_collect_nconc(ptail, list2);
list2 = next;
}
@@ -4691,8 +4672,8 @@ static val sort_list(val list, val lessfun, val keyfun)
may contain mixtures of old and new objects, and
so we could be reversing a newer->older pointer
relationship. */
- set(*cdr_l(cons2), list);
- *cdr_l(list) = nil;
+ set(cdr_l(cons2), list);
+ deref(cdr_l(list)) = nil;
return cons2;
}
}
@@ -4706,7 +4687,7 @@ static val sort_list(val list, val lessfun, val keyfun)
; /* empty */
list2 = cdr(bisect);
- *cdr_l(bisect) = nil;
+ deref(cdr_l(bisect)) = nil;
return merge(sort_list(list, lessfun, keyfun),
sort_list(list2, lessfun, keyfun),
@@ -5042,12 +5023,12 @@ val refset(val seq, val ind, val newval)
case NIL:
case CONS:
case LCONS:
- return set(*listref_l(seq, ind), newval);
+ return set(listref_l(seq, ind), newval);
case LIT:
case STR:
return chr_str_set(seq, ind, newval);
case VEC:
- return set(*vecref_l(seq, ind), newval);
+ return set(vecref_l(seq, ind), newval);
default:
type_mismatch(lit("ref: ~s is not a sequence"), cons, nao);
}
@@ -5169,12 +5150,12 @@ static void obj_init(void)
/* nil can't be interned because it's not a SYM object;
it works as a symbol because the nil case is handled by
symbol-manipulating function. */
- rplacd(gethash_c(user_package->pk.symhash, nil_string, 0), nil);
+ rplacd(gethash_c(user_package->pk.symhash, nil_string, nulloc), nil);
/* t can't be interned, because intern needs t in order to do its job. */
t = rplacd(gethash_c(user_package->pk.symhash,
- lit("t"), 0), make_sym(lit("t")));
- set(t->s.package, user_package);
+ lit("t"), nulloc), make_sym(lit("t")));
+ set(mkloc(t->s.package, t), user_package);
null_s = intern(lit("null"), user_package);
cons_s = intern(lit("cons"), user_package);
diff --git a/lib.h b/lib.h
index cf7f3413..3724b6f9 100644
--- a/lib.h
+++ b/lib.h
@@ -237,14 +237,39 @@ union obj {
};
#if CONFIG_GEN_GC
-val gc_set(val *, val);
-#define set(place, val) (gc_set(&(place), val))
+typedef struct {
+ val *ptr;
+ val obj;
+} loc;
+
+val gc_set(loc, val);
+
+INLINE loc mkloc_fun(val *ptr, val obj)
+{
+ loc l = { ptr, obj };
+ return l;
+}
+
+#define mkloc(expr, fun) mkloc_fun(&(expr), fun)
+#define mkcloc(expr) mkloc_fun(&(expr), 0)
+#define nulloc mkloc_fun(0, 0)
+#define nullocp(lo) (!(lo).ptr)
+#define deref(lo) (*(lo).ptr)
+#define valptr(lo) ((lo).ptr)
+#define set(lo, val) (gc_set(lo, val))
#define mut(obj) (gc_mutated(obj));
-#define mpush(val, place) (gc_push(val, &(place)))
+#define mpush(val, lo) (gc_push(val, lo))
#else
-#define set(place, val) ((place) = (val))
+typedef val *loc;
+#define mkloc(expr, obj) (&(expr))
+#define mkcloc(expr) (&(expr))
+#define nulloc ((loc) 0)
+#define nullocp(lo) (!(lo))
+#define deref(lo) (*(lo))
+#define valptr(lo) (lo)
+#define set(lo, val) (*(lo) = (val))
#define mut(obj) ((void) (obj))
-#define mpush(val, place) (push(val, &(place)))
+#define mpush(val, lo) (push(val, lo))
#endif
INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; }
@@ -316,9 +341,9 @@ INLINE val chr(wchar_t ch)
#define lit(strlit) lit_noex(strlit)
-#define keyword_package (*get_keyword_package())
-#define user_package (*get_user_package())
-#define system_package (*get_system_package())
+#define keyword_package (deref(get_keyword_package()))
+#define user_package (deref(get_user_package()))
+#define system_package (deref(get_system_package()))
extern val system_package_var, keyword_package_var, user_package_var;
extern val keyword_package_s, system_package_s, user_package_s;
@@ -344,7 +369,7 @@ extern val numeric_error_s, range_error_s;
extern val query_error_s, file_error_s, process_error_s;
extern val gensym_counter_s;
-#define gensym_counter (*lookup_var_l(nil, gensym_counter_s))
+#define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s)))
extern val nothrow_k, args_k, colon_k, auto_k;
@@ -378,8 +403,8 @@ val car(val cons);
val cdr(val cons);
val rplaca(val cons, val new_car);
val rplacd(val cons, val new_car);
-val *car_l(val cons);
-val *cdr_l(val cons);
+loc car_l(val cons);
+loc cdr_l(val cons);
val first(val cons);
val rest(val cons);
val second(val cons);
@@ -390,11 +415,11 @@ val sixth(val cons);
val conses(val list);
val lazy_conses(val list);
val listref(val list, val ind);
-val *listref_l(val list, val ind);
-val *tail(val cons);
-val *lastcons(val list);
+loc listref_l(val list, val ind);
+loc tail(val cons);
+loc lastcons(val list);
val last(val list);
-val *ltail(val *cons);
+loc ltail(loc cons);
val pop(val *plist);
val upop(val *plist, val *pundo);
val push(val v, val *plist);
@@ -440,7 +465,6 @@ mem_t *chk_malloc(size_t size);
mem_t *chk_malloc_gc_more(size_t size);
mem_t *chk_calloc(size_t n, size_t size);
mem_t *chk_realloc(mem_t *, size_t size);
-int in_malloc_range(mem_t *);
wchar_t *chk_strdup(const wchar_t *str);
val cons(val car, val cdr);
val make_lazy_cons(val func);
@@ -453,7 +477,7 @@ val listp(val obj);
val proper_listp(val obj);
val length_list(val list);
val getplist(val list, val key);
-val getplist_f(val list, val key, val *found);
+val getplist_f(val list, val key, loc found);
val proper_plist_to_alist(val list);
val improper_plist_to_alist(val list, val boolean_keys);
val num(cnum val);
@@ -590,9 +614,9 @@ val symbolp(val sym);
val symbol_name(val sym);
val symbol_package(val sym);
val keywordp(val sym);
-val *get_user_package(void);
-val *get_system_package(void);
-val *get_keyword_package(void);
+loc get_user_package(void);
+loc get_system_package(void);
+loc get_keyword_package(void);
val func_f0(val, val (*fun)(val env));
val func_f1(val, val (*fun)(val env, val));
val func_f2(val, val (*fun)(val env, val, val));
@@ -661,7 +685,7 @@ val vector(val length, val initval);
val vectorp(val vec);
val vec_set_length(val vec, val fill);
val vecref(val vec, val ind);
-val *vecref_l(val vec, val ind);
+loc vecref_l(val vec, val ind);
val vec_push(val vec, val item);
val length_vec(val vec);
val size_vec(val vec);
@@ -689,9 +713,9 @@ val assoc(val key, val list);
val assql(val key, val list);
val acons(val car, val cdr, val list);
val acons_new(val key, val value, val list);
-val acons_new_c(val key, val *new_p, val *list);
+val acons_new_c(val key, loc new_p, loc list);
val aconsql_new(val key, val value, val list);
-val aconsql_new_c(val key, val *new_p, val *list);
+val aconsql_new_c(val key, loc new_p, loc list);
val alist_remove(val list, val keys);
val alist_remove1(val list, val key);
val alist_nremove(val list, val keys);
@@ -787,11 +811,12 @@ INLINE val default_bool_arg(val arg)
}
#define list_collect_decl(OUT, PTAIL) \
- val OUT = nil, *PTAIL = &OUT
+ val OUT = nil; \
+ loc PTAIL = mkcloc(OUT)
-val *list_collect(val *pptail, val obj);
-val *list_collect_nconc(val *pptail, val obj);
-val *list_collect_append(val *pptail, val obj);
+loc list_collect(loc pptail, val obj);
+loc list_collect_nconc(loc pptail, val obj);
+loc list_collect_append(loc pptail, val obj);
#define cons_bind(CAR, CDR, CONS) \
obj_t *c_o_n_s ## CAR ## CDR = CONS; \
diff --git a/match.c b/match.c
index ae37a56d..25b7c4db 100644
--- a/match.c
+++ b/match.c
@@ -252,7 +252,7 @@ static val dest_set(val spec, val bindings, val pattern, val value)
sem_error(spec, lit("~s cannot be used as a variable"), pattern, nao);
if (!existing)
sem_error(spec, lit("cannot set unbound variable ~s"), pattern, nao);
- set(*cdr_l(existing), value);
+ set(cdr_l(existing), value);
} else if (consp(pattern)) {
if (first(pattern) == var_s) {
uw_throwf(query_error_s,
@@ -751,7 +751,7 @@ static val h_coll(match_line_ctx *c)
val maxtimes = txeval(elem, getplist(args, maxtimes_k), c->bindings);
val chars = txeval(elem, getplist(args, chars_k), c->bindings);
val have_vars;
- val vars = getplist_f(args, vars_k, &have_vars);
+ val vars = getplist_f(args, vars_k, mkcloc(have_vars));
cnum cmax = fixnump(gap) ? c_num(gap) : (fixnump(max) ? c_num(max) : 0);
cnum cmin = fixnump(gap) ? c_num(gap) : (fixnump(min) ? c_num(min) : 0);
cnum mincounter = cmin, maxcounter = 0;
@@ -2586,7 +2586,7 @@ static val v_gather(match_files_ctx *c)
match_files(mf_spec(*c, nested_spec)));
if (!success) {
- *cdr_l(iter) = nil;
+ deref(cdr_l(iter)) = nil;
ptail = list_collect_nconc(ptail, iter);
} else if (success == t) {
c->bindings = new_bindings;
@@ -2689,7 +2689,7 @@ static val v_collect(match_files_ctx *c)
val maxtimes = txeval(specline, getplist(args, maxtimes_k), c->bindings);
val lines = txeval(specline, getplist(args, lines_k), c->bindings);
val have_vars;
- volatile val vars = getplist_f(args, vars_k, &have_vars);
+ volatile val vars = getplist_f(args, vars_k, mkcloc(have_vars));
cnum cmax = fixnump(gap) ? c_num(gap) : (fixnump(max) ? c_num(max) : 0);
cnum cmin = fixnump(gap) ? c_num(gap) : (fixnump(min) ? c_num(min) : 0);
cnum mincounter = cmin, maxcounter = 0;
@@ -2816,7 +2816,7 @@ static val v_collect(match_files_ctx *c)
c->data = new_data;
c->data_lineno = new_line;
- *car_l(success) = nil;
+ deref(car_l(success)) = nil;
} else {
debuglf(specline, lit("collect consumed entire file"), nao);
c->data = nil;
@@ -2897,7 +2897,7 @@ static val v_flatten(match_files_ctx *c)
val existing = assoc(sym, c->bindings);
if (existing)
- set(*cdr_l(existing), flatten(cdr(existing)));
+ set(cdr_l(existing), flatten(cdr(existing)));
}
}
@@ -3056,7 +3056,7 @@ static val v_cat(match_files_ctx *c)
if (existing) {
val sep = if3(sep_form, txeval(specline, sep_form, c->bindings),
lit(" "));
- set(*cdr_l(existing), cat_str(flatten(cdr(existing)), sep));
+ set(cdr_l(existing), cat_str(flatten(cdr(existing)), sep));
} else {
sem_error(specline, lit("cat: unbound variable ~s"), sym, nao);
}
@@ -3145,9 +3145,9 @@ static val v_output(match_files_ctx *c)
if (existing) {
if (append) {
- set(*cdr_l(existing), append2(flatten(cdr(existing)), list_out));
+ set(cdr_l(existing), append2(flatten(cdr(existing)), list_out));
} else {
- set(*cdr_l(existing), list_out);
+ set(cdr_l(existing), list_out);
}
} else {
c->bindings = acons(into_var, list_out, c->bindings);
@@ -3462,7 +3462,7 @@ static val v_filter(match_files_ctx *c)
if (!existing)
sem_error(specline, lit("filter: variable ~a is unbound"), var, nao);
- set(*cdr_l(existing), filter_string_tree(filter, cdr(existing)));
+ set(cdr_l(existing), filter_string_tree(filter, cdr(existing)));
}
uw_env_end;
diff --git a/parser.y b/parser.y
index 2909944f..951427c1 100644
--- a/parser.y
+++ b/parser.y
@@ -1221,8 +1221,8 @@ static val expand_meta(val form, val menv)
list_collect_decl (out, ptail);
for (; consp(form); form = cdr(form)) {
- val *nptail = list_collect(ptail, expand_meta(car(form), menv));
- rlcp(*ptail, form);
+ loc nptail = list_collect(ptail, expand_meta(car(form), menv));
+ rlcp(deref(ptail), form);
ptail = nptail;
}
@@ -1234,10 +1234,10 @@ static val expand_meta(val form, val menv)
val rlset(val form, val info)
{
- val cell = gethash_c(form_to_ln_hash, form, 0);
- val *place = cdr_l(cell);
- if (nilp(*place))
- set(*place, info);
+ val cell = gethash_c(form_to_ln_hash, form, nulloc);
+ loc place = cdr_l(cell);
+ if (nilp(deref(place)))
+ set(place, info);
return form;
}
diff --git a/rand.h b/rand.h
index 8ceae113..615e60eb 100644
--- a/rand.h
+++ b/rand.h
@@ -24,7 +24,7 @@
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
*/
-#define random_state (*lookup_var_l(nil, random_state_s))
+#define random_state (deref(lookup_var_l(nil, random_state_s)))
extern val random_state_s;
val make_random_state(val seed);
val random_state_p(val obj);
diff --git a/stream.c b/stream.c
index 64ac01d3..7122b6ff 100644
--- a/stream.c
+++ b/stream.c
@@ -744,7 +744,7 @@ static val string_in_get_line(val stream)
if (lt(pos, length_str(string))) {
val nlpos = find_char(string, pos, chr('\n'));
val result = sub_str(string, pos, nlpos);
- set(*cdr_l(pair), nlpos ? plus(nlpos, one) : length_str(string));
+ set(cdr_l(pair), nlpos ? plus(nlpos, one) : length_str(string));
return result;
}
@@ -758,7 +758,7 @@ static val string_in_get_char(val stream)
val pos = cdr(pair);
if (lt(pos, length_str(string))) {
- set(*cdr_l(pair), plus(pos, one));
+ set(cdr_l(pair), plus(pos, one));
return chr_str(string, pos);
}
@@ -782,7 +782,7 @@ static val string_in_unget_char(val stream, val ch)
lit("unget-char: ~s doesn't match the character that was read"),
nao);
- set(*cdr_l(pair), plus(pos, one));
+ set(cdr_l(pair), plus(pos, one));
return ch;
}
@@ -1033,8 +1033,8 @@ static val strlist_out_put_string(val stream, val str)
strstream = make_string_output_stream();
}
- set(*car_l(cell), lines);
- set(*cdr_l(cell), strstream);
+ set(car_l(cell), lines);
+ set(cdr_l(cell), strstream);
return t;
}
@@ -1051,8 +1051,8 @@ static val strlist_out_put_char(val stream, val ch)
put_char(ch, strstream);
}
- set(*car_l(cell), lines);
- set(*cdr_l(cell), strstream);
+ set(car_l(cell), lines);
+ set(cdr_l(cell), strstream);
return t;
}
diff --git a/stream.h b/stream.h
index 388f9cc4..7a5911e6 100644
--- a/stream.h
+++ b/stream.h
@@ -47,12 +47,12 @@ struct strm_ops {
val (*set_prop)(val, val ind, val);
};
-#define std_input (*lookup_var_l(nil, stdin_s))
-#define std_output (*lookup_var_l(nil, stdout_s))
-#define std_debug (*lookup_var_l(nil, stddebug_s))
-#define std_error (*lookup_var_l(nil, stderr_s))
-#define std_null (*lookup_var_l(nil, stdnull_s))
-val *lookup_var_l(val env, val sym);
+#define std_input (deref(lookup_var_l(nil, stdin_s)))
+#define std_output (deref(lookup_var_l(nil, stdout_s)))
+#define std_debug (deref(lookup_var_l(nil, stddebug_s)))
+#define std_error (deref(lookup_var_l(nil, stderr_s)))
+#define std_null (deref(lookup_var_l(nil, stdnull_s)))
+loc lookup_var_l(val env, val sym);
extern val output_produced;
diff --git a/syslog.c b/syslog.c
index 3d8670ce..f45f29cb 100644
--- a/syslog.c
+++ b/syslog.c
@@ -141,7 +141,7 @@ static val syslog_put_string(val stream, val str)
strstream = make_string_output_stream();
}
- set(*cdr_l(cell), strstream);
+ set(cdr_l(cell), strstream);
return t;
}
@@ -157,7 +157,7 @@ static val syslog_put_char(val stream, val ch)
put_char(ch, strstream);
}
- set(*cdr_l(cell), strstream);
+ set(cdr_l(cell), strstream);
return t;
}
@@ -173,7 +173,7 @@ static val syslog_put_byte(val stream, int ch)
put_byte(num(ch), strstream);
}
- set(*cdr_l(cell), strstream);
+ set(cdr_l(cell), strstream);
return t;
}
@@ -192,7 +192,7 @@ static val syslog_set_prop(val stream, val ind, val prop)
{
if (ind == prio_k) {
val cell = (val) stream->co.handle;
- set(*car_l(cell), prop);
+ set(car_l(cell), prop);
return t;
}
return nil;
diff --git a/unwind.c b/unwind.c
index 8c2fb676..3b4f674e 100644
--- a/unwind.c
+++ b/unwind.c
@@ -404,7 +404,7 @@ val uw_register_subtype(val sub, val sup)
/* Make sub an immediate subtype of sup.
If sub already registered, we just repoint it. */
if (sub_entry) {
- set(*cdr_l(sub_entry), sup_entry);
+ set(cdr_l(sub_entry), sup_entry);
} else {
sub_entry = cons(sub, sup_entry);
exception_subtypes = cons(sub_entry, exception_subtypes);
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-10 15:54:48 +0000