diff options
| -rw-r--r-- | ChangeLog | 52 | ||||
| -rwxr-xr-x | configure | 6 | ||||
| -rw-r--r-- | eval.c | 24 | ||||
| -rw-r--r-- | filter.c | 6 | ||||
| -rw-r--r-- | gc.c | 50 | ||||
| -rw-r--r-- | gc.h | 8 | ||||
| -rw-r--r-- | hash.c | 10 | ||||
| -rw-r--r-- | lib.c | 20 | ||||
| -rw-r--r-- | lib.h | 51 | ||||
| -rw-r--r-- | match.c | 12 | ||||
| -rw-r--r-- | stream.c | 12 | ||||
| -rw-r--r-- | unwind.c | 2 |
12 files changed, 195 insertions, 58 deletions
@@ -1,5 +1,57 @@ 2012-04-02 Kaz Kylheku <kaz@kylheku.com> + * configure: Support a gen-gc configuration variable which + causes CONFIG_GEN_GC to be defined as 1 in config.h. + + * eval.c (op_defvar, dwim_loc, op_modplace, transform_op): Handle + mutating assignments via set macro. + (op_dohash): Inform gc about mutated variables. TODO here. + + * filter.c (trie_add, trie_compress): Handle mutating assignments + via set macro. + + * gc.c (BACKPTR_VEC_SIZE, FULL_GC_INTERVAL): New preprocessor symbols. + (backptr, backptr_idx, partial_gc_count, full): New static variables. + (make_obj): Initialize generation to zero. + (gc): Added logic for deciding between full and partial gc. + (gc_set, gc_mutated): New functions. + + * gc.h (gc_set, gc_mutated): Declared. + + * hash.c (hash_mark): Changed useless use of vecref_l to vecref. + (gethash_f): Use set when assigning through *found since it + is a possible mutation. + + * lib.c (car_l, cdr_l, vecref_l): Got rid of loc macro uses. Using the + value properly is going to be the caller's responsibility. + (push): push may be a mutation, so use set. + (intern): Uset set to mutate a hash entry. + (acons_new_l, aconsq_new_l): Use set when replacing *list. + + * lib.h (PTR_BIT): New preprocessor symbol. + (obj_common): New macro for defining common object fields. + type_t is split into two bitfields, half a pointer wide, + allowing for generation to be represented. + (struct any, struct cons, struct string, struct sym, struct package, + struct func, struct vec, struct lazy_cons, struct cobj, struct env, + struct bignum, struct flonum): Use obj_common macro to defined + common fields. + (loc): Macro removed. + (set, mut): Macros conditionally defined for real functionality. + (list_collect, list_collect_nconc, list_collect_append): Replace + mutating operations with set. + + * match.c (dest_set, v_cat, v_output, v_filter): Replace + mutating operations with set. + + * stream.c (string_in_get_line, string_in_get_char, + strlist_out_put_string, strlist_out_put_char): Replace mutating + operations with set. + + * unwind.c (uw_register_subtype): Replace mutating operation with set. + +2012-04-02 Kaz Kylheku <kaz@kylheku.com> + * lib.c (vec_set_length): Use set instead of assignment. (vecref_l): Use loc to lift address of cell. (replace_vec): Use macro mut to indicate the object is being @@ -139,6 +139,7 @@ valgrind=${valgrind-} lit_align=${lit_align-} extra_debugging=${extra_debugging-} debug_support=${debug_support-y} +gen_gc=${gen_gc-y} mpi_version=1.8.6 have_quilt= have_patch= @@ -1123,9 +1124,8 @@ fi # Some final blurbs into config.h # -if [ -n "$debug_support" ] ; then - printf "#define CONFIG_DEBUG_SUPPORT 1\n" >> config.h -fi +[ -n "$debug_support" ] && printf "#define CONFIG_DEBUG_SUPPORT 1\n" >> config.h +[ -n "$gen_gc" ] && printf "#define CONFIG_GEN_GC 1\n" >> config.h # # Regenerate config.make @@ -701,7 +701,7 @@ static val op_defvar(val form, val env) val existing = gethash(top_vb, sym); if (existing) - *cdr_l(existing) = value; + set(*cdr_l(existing), value); else sethash(top_vb, sym, cons(sym, value)); } @@ -895,7 +895,7 @@ static val *dwim_loc(val form, val env, val op, val newform, val *retval) loc = gethash_l(obj, first(args), &new_p); if (new_p) - *loc = second(args); + set(*loc, second(args)); return loc; } } @@ -950,7 +950,7 @@ static val op_modplace(val form, val env) } loc = gethash_l(hash, key, &new_p); if (new_p) - *loc = eval(fourth(place), env, form); + set(*loc, eval(fourth(place), env, form)); } else if (sym == car_s) { val cons = eval(second(place), env, form); loc = car_l(cons); @@ -975,13 +975,13 @@ static val op_modplace(val form, val env) if (op == set_s) { if (!third_arg_p) eval_error(form, lit("~a: missing argument"), op, place, nao); - return *loc = eval(newform, env, form); + return set(*loc, eval(newform, env, form)); } else if (op == inc_s) { val inc = or2(eval(newform, env, form), one); - return *loc = plus(*loc, inc); + return set(*loc, plus(*loc, inc)); } else if (op == dec_s) { val inc = or2(eval(newform, env, form), one); - return *loc = minus(*loc, inc); + return set(*loc, minus(*loc, inc)); } else if (op == push_s) { return push(newval, loc); } else if (op == pop_s) { @@ -1035,6 +1035,16 @@ static val op_dohash(val form, val env) uw_block_begin (nil, result); + /* + * Avoid issuing set() operations in the loop; + * just tell GC that these variables are being mutated. + * TODO: This is not enough since gc can take place while we execute this + * loop. What we need is to conditionally re-establish this. + * GC needs to provide a way to let us know "has GC happened since ..." + */ + mut(keyvar); + mut(valvar); + while ((cell = hash_next(&iter)) != nil) { *cdr_l(keyvar) = car(cell); *cdr_l(valvar) = cdr(cell); @@ -1501,7 +1511,7 @@ static val transform_op(val forms, val syms, val rg) val newsyms = syms; val new_p; val *place = acons_new_l(vararg, &new_p, &newsyms); - val sym = if3(new_p, *place = gensym(prefix), *place); + val sym = if3(new_p, set(*place, gensym(prefix)), *place); cons_bind (outsyms, outforms, transform_op(re, newsyms, rg)); return cons(outsyms, rlcp(cons(sym, outforms), outforms)); } else if (eq(vararg, rest_s)) { @@ -61,7 +61,7 @@ static val trie_add(val trie, val key, val value) val newnode_p; val *loc = gethash_l(node, ch, &newnode_p); if (newnode_p) - *loc = make_hash(nil, nil, nil); + set(*loc, make_hash(nil, nil, nil)); node = *loc; } @@ -90,11 +90,11 @@ static void trie_compress(val *ptrie) val value = get_hash_userdata(trie); if (zerop(count)) { - *ptrie = value; + set(*ptrie, value); } else if (eq(count, one) && nullp(value)) { val iter = hash_begin(trie); val cell = hash_next(&iter); - *ptrie = cons(car(cell), cdr(cell)); + set(*ptrie, cons(car(cell), cdr(cell))); trie_compress(cdr_l(*ptrie)); } else { val cell, iter = hash_begin(trie); @@ -44,6 +44,8 @@ #define PROT_STACK_SIZE 1024 #define HEAP_SIZE 16384 +#define BACKPTR_VEC_SIZE 4096 +#define FULL_GC_INTERVAL 10 typedef struct heap { struct heap *next; @@ -72,6 +74,13 @@ static val heap_min_bound, heap_max_bound; int gc_enabled = 1; +#if CONFIG_GEN_GC +static val backptr[BACKPTR_VEC_SIZE]; +static int backptr_idx; +static int partial_gc_count; +static int full; +#endif + #if EXTRA_DEBUGGING static val break_obj; #endif @@ -165,6 +174,9 @@ val make_obj(void) if (opt_vg_debug) VALGRIND_MAKE_MEM_UNDEFINED(ret, sizeof *ret); #endif +#if CONFIG_GEN_GC + ret->t.gen = 0; +#endif return ret; } @@ -472,6 +484,16 @@ void gc(void) { val gc_stack_top = nil; +#if CONFIG_GEN_GC + if (backptr_idx && ++partial_gc_count == FULL_GC_INTERVAL) { + full = 1; + partial_gc_count = 0; + backptr_idx = 0; + } else { + full = 0; + } +#endif + if (gc_enabled) { mach_context_t mc; save_context(mc); @@ -513,6 +535,34 @@ int gc_is_reachable(val obj) return (t & REACHABLE) != 0; } +#if CONFIG_GEN_GC + +val gc_set(val *ptr, val val) +{ + if (!is_ptr(val)) + goto out; + if (val->t.gen != 0) + goto out; + + backptr[backptr_idx++] = val; +out: + *ptr = val; + + if (backptr_idx == BACKPTR_VEC_SIZE) + gc(); + + return val; +} + +void gc_mutated(val obj) +{ + backptr[backptr_idx++] = obj; + if (backptr_idx == BACKPTR_VEC_SIZE) + gc(); +} + +#endif + /* * Useful functions for gdb'ing. */ @@ -23,6 +23,7 @@ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. */ + void gc_init(val *stack_bottom); val prot1(val *loc); void rel1(val *loc); @@ -33,8 +34,15 @@ void gc(void); int gc_state(int); void gc_mark(val); int gc_is_reachable(val); + +#if CONFIG_GEN_GC +val gc_set(val *, val); +void gc_mutated(val); +#endif + void unmark(void); void gc_hint_func(val *); + #define gc_hint(var) gc_hint_func(&var) #define REACHABLE 0x100 #define FREE 0x200 @@ -282,10 +282,10 @@ static void hash_mark(val hash) /* Keys are weak: mark the values only. */ for (i = 0; i < h->modulus; i++) { val ind = num(i); - val *pchain = vecref_l(h->table, ind); + val chain = vecref(h->table, ind); val iter; - for (iter = *pchain; iter != nil; iter = cdr(iter)) { + for (iter = chain; iter != nil; iter = cdr(iter)) { val entry = car(iter); gc_mark(cdr(entry)); } @@ -298,10 +298,10 @@ static void hash_mark(val hash) for (i = 0; i < h->modulus; i++) { val ind = num(i); - val *pchain = vecref_l(h->table, ind); + val chain = vecref(h->table, ind); val iter; - for (iter = *pchain; iter != nil; iter = cdr(iter)) { + for (iter = chain; iter != nil; iter = cdr(iter)) { val entry = car(iter); gc_mark(car(entry)); } @@ -393,7 +393,7 @@ val gethash_f(val hash, val key, val *found) { struct hash *h = (struct hash *) cobj_handle(hash, hash_s); val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus)); - *found = h->assoc_fun(key, chain); + set(*found, h->assoc_fun(key, chain)); return cdr(*found); } @@ -249,13 +249,13 @@ val *car_l(val cons) { switch (type(cons)) { case CONS: - return loc(cons->c.car); + return &cons->c.car; case LCONS: if (cons->lc.func) { funcall1(cons->lc.func, cons); cons->lc.func = nil; } - return loc(cons->lc.car); + return &cons->lc.car; default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -265,13 +265,13 @@ val *cdr_l(val cons) { switch (type(cons)) { case CONS: - return loc(cons->c.cdr); + return &cons->c.cdr; case LCONS: if (cons->lc.func) { funcall1(cons->lc.func, cons); cons->lc.func = nil; } - return loc(cons->lc.cdr); + return &cons->lc.cdr; default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -361,7 +361,9 @@ val pop(val *plist) val push(val value, val *plist) { - return *plist = cons(value, *plist); + /* TODO: doing set here is suboptimal since + it is often used for just a local var. */ + return set(*plist, cons(value, *plist)); } val copy_list(val list) @@ -2249,7 +2251,7 @@ val intern(val str, val package) } else { val newsym = make_sym(str); newsym->s.package = package; - return *place = newsym; + return set(*place, newsym); } } @@ -3096,7 +3098,7 @@ val *vecref_l(val vec, val ind) cnum index = c_num(ind); cnum len = c_num(length_vec(vec)); range_bug_unless (index >= 0 && index < len); - return loc(vec->v.vec[index]); + return vec->v.vec + index; } val vec_push(val vec, val item) @@ -3618,7 +3620,7 @@ val *acons_new_l(val key, val *new_p, val *list) return cdr_l(existing); } else { val nc = cons(key, nil); - *list = cons(nc, *list); + set(*list, cons(nc, *list)); if (new_p) *new_p = t; return cdr_l(nc); @@ -3647,7 +3649,7 @@ val *aconsq_new_l(val key, val *new_p, val *list) return cdr_l(existing); } else { val nc = cons(key, nil); - *list = cons(nc, *list); + set(*list, cons(nc, *list)); if (new_p) *new_p = t; return cdr_l(nc); @@ -37,6 +37,8 @@ typedef int_ptr_t cnum; #define NUM_MAX (INT_PTR_MAX/4) #define NUM_MIN (INT_PTR_MIN/4) +#define PTR_BIT (SIZEOF_PTR * CHAR_BIT) + typedef enum type { NIL, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS, STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV, @@ -59,39 +61,48 @@ typedef obj_t *val; typedef unsigned char mem_t; +#if CONFIG_GEN_GC +#define obj_common \ + type_t type : PTR_BIT/2; \ + int gen : PTR_BIT/2 +#else +#define obj_common \ + type_t type +#endif + struct any { - type_t type; + obj_common; void *dummy[2]; val next; /* GC free list */ }; struct cons { - type_t type; + obj_common; val car, cdr; }; struct string { - type_t type; + obj_common; wchar_t *str; val len; val alloc; }; struct sym { - type_t type; + obj_common; val name; val package; val value; }; struct package { - type_t type; + obj_common; val name; val symhash; }; struct func { - type_t type; + obj_common; unsigned fixparam : 7; /* total non-variadic parameters */ unsigned optargs : 7; /* fixparam - optargs = required args */ unsigned variadic : 1; @@ -126,7 +137,7 @@ struct func { enum vecindex { vec_alloc = -2, vec_length = -1 }; struct vec { - type_t type; + obj_common; /* vec points two elements down */ /* vec[-2] is allocated size */ /* vec[-1] is fill pointer */ @@ -145,7 +156,7 @@ struct vec { */ struct lazy_cons { - type_t type; + obj_common; val car, cdr; val func; /* when nil, car and cdr are valid */ }; @@ -155,14 +166,14 @@ struct lazy_cons { * of a list of strings. */ struct lazy_string { - type_t type; + obj_common; val prefix; /* actual string part */ val list; /* remaining list */ val opts; /* ( separator . limit ) */ }; struct cobj { - type_t type; + obj_common; mem_t *handle; struct cobj_ops *ops; val cls; @@ -185,19 +196,19 @@ void cobj_mark_op(val); cnum cobj_hash_op(val); struct env { - type_t type; + obj_common; val vbindings; val fbindings; val up_env; }; struct bignum { - type_t type; + obj_common; mp_int mp; }; struct flonum { - type_t type; + obj_common; double n; }; @@ -217,9 +228,13 @@ union obj { struct flonum fl; }; +#if CONFIG_GEN_GC #define set(place, val) ((place) = (val)) -#define loc(place) (&(place)) #define mut(obj) +#else +#define set(place, val) (gc_set(&(place), val)) +#define mut(obj) (gc_mutated(obj)); +#endif INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; } INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; } @@ -654,7 +669,7 @@ INLINE val eq(val a, val b) { return ((a) == (b) ? t : nil); } do { \ if (*PTAIL) \ PTAIL = tail(*PTAIL); \ - *PTAIL = cons(OBJ, nil); \ + set(*PTAIL, cons(OBJ, nil)); \ PTAIL = cdr_l(*PTAIL); \ } while(0) @@ -663,16 +678,16 @@ INLINE val eq(val a, val b) { return ((a) == (b) ? t : nil); } if (*PTAIL) { \ PTAIL = tail(*PTAIL); \ } \ - *PTAIL = OBJ; \ + set(*PTAIL, OBJ); \ } while (0) #define list_collect_append(PTAIL, OBJ) \ do { \ if (*PTAIL) { \ - *PTAIL = copy_list(*PTAIL); \ + set(*PTAIL, copy_list(*PTAIL)); \ PTAIL = tail(*PTAIL); \ } \ - *PTAIL = OBJ; \ + set(*PTAIL, OBJ); \ } while (0) #define cons_bind(CAR, CDR, CONS) \ @@ -233,7 +233,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); - *cdr_l(existing) = value; + set(*cdr_l(existing), value); } else if (consp(pattern)) { if (first(pattern) == var_s) { uw_throwf(query_error_s, @@ -2828,7 +2828,7 @@ static val v_flatten(match_files_ctx *c) val existing = assoc(sym, c->bindings); if (existing) - *cdr_l(existing) = flatten(cdr(existing)); + set(*cdr_l(existing), flatten(cdr(existing))); } } @@ -2987,7 +2987,7 @@ static val v_cat(match_files_ctx *c) if (existing) { val sep = if3(sep_form, txeval(specline, sep_form, c->bindings), lit(" ")); - *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); } @@ -3057,9 +3057,9 @@ static val v_output(match_files_ctx *c) if (existing) { if (append) { - *cdr_l(existing) = append2(flatten(cdr(existing)), list_out); + set(*cdr_l(existing), append2(flatten(cdr(existing)), list_out)); } else { - *cdr_l(existing) = list_out; + set(*cdr_l(existing), list_out); } } else { c->bindings = acons(into_var, list_out, c->bindings); @@ -3351,7 +3351,7 @@ static val v_filter(match_files_ctx *c) if (!existing) sem_error(specline, lit("filter: variable ~a is unbound"), var, nao); - *cdr_l(existing) = filter_string_tree(filter, cdr(existing)); + set(*cdr_l(existing), filter_string_tree(filter, cdr(existing))); } uw_env_end; @@ -355,7 +355,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); - *cdr_l(pair) = nlpos ? plus(nlpos, one) : length_str(string); + set(*cdr_l(pair), nlpos ? plus(nlpos, one) : length_str(string)); return result; } @@ -369,7 +369,7 @@ static val string_in_get_char(val stream) val pos = cdr(pair); if (lt(pos, length_str(string))) { - *cdr_l(pair) = plus(pos, one); + set(*cdr_l(pair), plus(pos, one)); return chr_str(string, pos); } @@ -584,8 +584,8 @@ static val strlist_out_put_string(val stream, val str) strstream = make_string_output_stream(); } - *car_l(cell) = lines; - *cdr_l(cell) = strstream; + set(*car_l(cell), lines); + set(*cdr_l(cell), strstream); return t; } @@ -602,8 +602,8 @@ static val strlist_out_put_char(val stream, val ch) put_char(ch, strstream); } - *car_l(cell) = lines; - *cdr_l(cell) = strstream; + set(*car_l(cell), lines); + set(*cdr_l(cell), strstream); return t; } @@ -386,7 +386,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) { - *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); |