diff options
| -rw-r--r-- | ChangeLog | 27 | ||||
| -rw-r--r-- | gc.c | 4 | ||||
| -rw-r--r-- | hash.c | 20 | ||||
| -rw-r--r-- | lib.c | 94 | ||||
| -rw-r--r-- | lib.h | 19 | ||||
| -rw-r--r-- | match.c | 6 |
6 files changed, 104 insertions, 66 deletions
@@ -1,5 +1,32 @@ 2009-11-06 Kaz Kylheku <kkylheku@gmail.com> + Changing representation of objects to allow the NUM type to be + unboxed. If the lowest bit of the obj_t * pointer is 1, then + the remaining bits are a number. A lot of assumptions are made: + - the long type can be converted to and from a pointer + - two's complement. + - behavior of << and >> operators when the sign bit is involved. + + * lib.h (TAG_SHIFT, TAG_MASK, TAG_NUM, TAG_PTR, NUM_MASK, NUM_MIN, + is_ptr, is_num, type): New macros. + (struct num): Removed. + (nao): Redefined, so that it doesn't have the numeric tag. + + * lib.c (typeof, type_check2, type_check3, car, car_l, cdr, cdr_l, + equal, consp, atom, listp, num, c_num, nump, plus, minus, + stringp, lazy_stringp, obj_print, obj_pprint): Fixed these + functions to use the new number representation, and not to deference + the obj_t * poitner if it is actually a number. + (obj_init): Adjusted values of maxint and minint. + + * gc.c (mark_obj, gc_is_reachable): Avoid dereferencing numbers. + + * hash.c (ll_hash): Likewise. + + * match.c (match_line, do_output_line): Likewise. + +2009-11-06 Kaz Kylheku <kkylheku@gmail.com> + First cut at hash tables. One known problem is allocation during gc, due to use of boxed numbers for vector access. @@ -189,7 +189,7 @@ tail_call: #define mark_obj_tail(o) return mark_obj(o) #endif - if (obj == nil) + if (!is_ptr(obj)) return; t = obj->t.type; @@ -380,7 +380,7 @@ int gc_is_reachable(obj_t *obj) { type_t t; - if (obj == nil) + if (!is_ptr(obj)) return 1; t = obj->t.type; @@ -79,21 +79,21 @@ static long hash_c_str(const char *str) static long ll_hash(obj_t *obj) { if (obj == nil) - return LONG_MAX; + return NUM_MAX; - switch (obj->t.type) { + switch (type(obj)) { case CONS: - return (ll_hash(obj->c.car) + ll_hash(obj->c.cdr)) & LONG_MAX; + return (ll_hash(obj->c.car) + ll_hash(obj->c.cdr)) & NUM_MAX; case STR: return hash_c_str(obj->st.str); case CHR: - return obj->ch.ch + LONG_MAX / 2; + return obj->ch.ch + NUM_MAX / 2; case NUM: - return obj->n.val & LONG_MAX; + return c_num(obj) & NUM_MAX; case SYM: - return ((long) obj) & LONG_MAX; + return ((long) obj) & NUM_MAX; case FUN: - return ((long) obj->f.f.interp_fun + ll_hash(obj->f.env)) & LONG_MAX; + return ((long) obj->f.f.interp_fun + ll_hash(obj->f.env)) & NUM_MAX; case VEC: { obj_t *fill = obj->v.vec[vec_fill]; @@ -101,19 +101,19 @@ static long ll_hash(obj_t *obj) long len = c_num(fill); for (i = 0; i < len; i++) - h = (h + ll_hash(obj->v.vec[i])) & LONG_MAX; + h = (h + ll_hash(obj->v.vec[i])) & NUM_MAX; return h; } case LCONS: - return (ll_hash(car(obj)) + ll_hash(cdr(obj))) & LONG_MAX; + return (ll_hash(car(obj)) + ll_hash(cdr(obj))) & NUM_MAX; case LSTR: lazy_str_force(obj); return ll_hash(obj->ls.prefix); case COBJ: if (obj->co.ops->hash) return obj->co.ops->hash(obj); - return ((long) obj) & LONG_MAX; + return ((long) obj) & NUM_MAX; } internal_error("unhandled case in equal function"); @@ -101,7 +101,9 @@ static obj_t *code2type(int code) obj_t *typeof(obj_t *obj) { - if (obj == nil) { + if (is_num(obj)) { + return num_t; + } else if (obj == nil) { return null; } else if (obj->t.type == COBJ) { return obj->co.cls; @@ -115,14 +117,14 @@ obj_t *typeof(obj_t *obj) obj_t *type_check(obj_t *obj, int type) { - if (!obj || obj->t.type != type) + if (!is_ptr(obj) || obj->t.type != type) type_mismatch("~s is not of type ~s", obj, code2type(type), nao); return t; } obj_t *type_check2(obj_t *obj, int t1, int t2) { - if (!obj || (obj->t.type != t1 && obj->t.type != t2)) + if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2)) type_mismatch("~s is not of type ~s or ~s", obj, code2type(t1), code2type(t2), nao); return t; @@ -130,7 +132,8 @@ obj_t *type_check2(obj_t *obj, int t1, int t2) obj_t *type_check3(obj_t *obj, int t1, int t2, int t3) { - if (!obj || (obj->t.type != t1 && obj->t.type != t2 && obj->t.type != t3)) + if (!is_ptr(obj) || (obj->t.type != t1 && obj->t.type != t2 + && obj->t.type != t3)) type_mismatch("~s is not of type ~s, ~s nor ~s", obj, code2type(t1), code2type(t2), code2type(t3), nao); return t; @@ -140,7 +143,7 @@ obj_t *car(obj_t *cons) { if (cons == nil) return nil; - else switch (cons->t.type) { + else switch (type(cons)) { case CONS: return cons->c.car; case LCONS: @@ -160,7 +163,7 @@ obj_t *cdr(obj_t *cons) { if (cons == nil) return nil; - else switch (cons->t.type) { + else switch (type(cons)) { case CONS: return cons->c.cdr; case LCONS: @@ -178,7 +181,7 @@ obj_t *cdr(obj_t *cons) obj_t **car_l(obj_t *cons) { - switch (cons->t.type) { + switch (type(cons)) { case CONS: return &cons->c.car; case LCONS: @@ -191,7 +194,7 @@ obj_t **car_l(obj_t *cons) obj_t **cdr_l(obj_t *cons) { - switch (cons->t.type) { + switch (type(cons)) { case CONS: return &cons->c.cdr; case LCONS: @@ -401,10 +404,10 @@ obj_t *equal(obj_t *left, obj_t *right) if (left == nil || right == nil) return nil; - switch (left->t.type) { + switch (type(left)) { case CONS: case LCONS: - if ((right->t.type == CONS || left->t.type == LCONS) && + if ((type(right) == CONS || type(right) == LCONS) && equal(car(left), car(right)) && equal(cdr(left), cdr(right))) { @@ -412,27 +415,25 @@ obj_t *equal(obj_t *left, obj_t *right) } return nil; case STR: - if (right->t.type == STR) + if (type(right) == STR) return strcmp(left->st.str, right->st.str) == 0 ? t : nil; - if (right->t.type == LSTR) { + if (type(right) == LSTR) { lazy_str_force(right); return equal(left, right->ls.prefix); } return nil; case CHR: - if (right->t.type == CHR && - left->ch.ch == right->ch.ch) + if (type(right) == CHR && left->ch.ch == right->ch.ch) return t; return nil; case NUM: - if (right->t.type == NUM && - left->n.val == right->n.val) + if (type(right) == NUM && c_num(left) == c_num(right)) return t; return nil; case SYM: return right == left ? t : nil; case FUN: - if (right->t.type == FUN && + if (type(right) == FUN && left->f.functype == right->f.functype && equal(left->f.env, right->f.env)) { @@ -453,7 +454,7 @@ obj_t *equal(obj_t *left, obj_t *right) } return nil; case VEC: - if (right->t.type == VEC) { + if (type(right) == VEC) { long i, fill; if (!equal(left->v.vec[vec_fill], right->v.vec[vec_fill])) return nil; @@ -466,13 +467,13 @@ obj_t *equal(obj_t *left, obj_t *right) } return nil; case LSTR: - if (right->t.type == STR || right->t.type == LSTR) { + if (type(right) == STR || type(right) == LSTR) { lazy_str_force(left); return equal(left->ls.prefix, right); } return nil; case COBJ: - if (right->t.type == COBJ) + if (type(right) == COBJ) return left->co.ops->equal(left, right); return nil; } @@ -547,9 +548,12 @@ obj_t *list(obj_t *first, ...) obj_t *consp(obj_t *obj) { - if (!obj) + if (!obj) { return nil; - return (obj->t.type == CONS || obj->t.type == LCONS) ? t : nil; + } else { + type_t type = type(obj); + return (type == CONS || type == LCONS) ? t : nil; + } } obj_t *nullp(obj_t *obj) @@ -559,14 +563,12 @@ obj_t *nullp(obj_t *obj) obj_t *atom(obj_t *obj) { - return (obj == nil || (obj->t.type != CONS && obj->t.type != LCONS)) - ? t : nil; + return if3(consp(obj), nil, t); } obj_t *listp(obj_t *obj) { - return (obj == nil || obj->t.type == CONS || obj->t.type == LCONS) - ? t : nil; + return if2(obj == nil || consp(obj), t); } obj_t *proper_listp(obj_t *obj) @@ -589,21 +591,20 @@ obj_t *length(obj_t *list) obj_t *num(long val) { - obj_t *obj = make_obj(); - obj->n.type = NUM; - obj->n.val = val; - return obj; + numeric_assert (val >= NUM_MIN && val <= NUM_MAX); + return (obj_t *) ((val << TAG_SHIFT) | TAG_NUM); } long c_num(obj_t *num) { - type_check(num, NUM); - return num->n.val; + if (!is_num(num)) + type_mismatch("~s is not a number", num, nao); + return ((long) num) >> TAG_SHIFT; } obj_t *nump(obj_t *num) { - return (num && num->n.type == NUM) ? t : nil; + return (is_num(num)) ? t : nil; } obj_t *plus(obj_t *anum, obj_t *bnum) @@ -611,8 +612,8 @@ obj_t *plus(obj_t *anum, obj_t *bnum) long a = c_num(anum); long b = c_num(bnum); - numeric_assert (a <= 0 || b <= 0 || LONG_MAX - b >= a); - numeric_assert (a >= 0 || b >= 0 || LONG_MIN - b >= a); + numeric_assert (a <= 0 || b <= 0 || NUM_MAX - b >= a); + numeric_assert (a >= 0 || b >= 0 || NUM_MIN - b >= a); return num(a + b); } @@ -622,9 +623,9 @@ obj_t *minus(obj_t *anum, obj_t *bnum) long a = c_num(anum); long b = c_num(bnum); - numeric_assert (b != LONG_MIN || LONG_MIN == -LONG_MAX); - numeric_assert (a <= 0 || -b <= 0 || LONG_MAX + b >= a); - numeric_assert (a >= 0 || -b >= 0 || LONG_MIN + b >= a); + numeric_assert (b != NUM_MIN || NUM_MIN == -NUM_MAX); + numeric_assert (a <= 0 || -b <= 0 || NUM_MAX + b >= a); + numeric_assert (a >= 0 || -b >= 0 || NUM_MIN + b >= a); return num(a - b); } @@ -724,12 +725,17 @@ obj_t *copy_str(obj_t *str) obj_t *stringp(obj_t *str) { - return (str && (str->st.type == STR || str->st.type == LSTR)) ? t : nil; + if (!is_ptr(str)) { + return nil; + } else { + type_t type = type(str); + return if2(type == STR || type == LSTR, t); + } } obj_t *lazy_stringp(obj_t *str) { - return (str && (str->st.type == LSTR)) ? t : nil; + return (is_ptr(str) && (type(str) == LSTR)) ? t : nil; } obj_t *length_str(obj_t *str) @@ -1775,8 +1781,8 @@ static void obj_init(void) one = num(1); two = num(2); negone = num(-1); - maxint = num(LONG_MAX); - minint = num(LONG_MIN); + maxint = num(NUM_MAX); + minint = num(NUM_MIN); null_string = string(""); @@ -1794,7 +1800,7 @@ void obj_print(obj_t *obj, obj_t *out) return; } - switch (obj->t.type) { + switch (type(obj)) { case CONS: case LCONS: { @@ -1905,7 +1911,7 @@ void obj_pprint(obj_t *obj, obj_t *out) return; } - switch (obj->t.type) { + switch (type(obj)) { case CONS: case LCONS: { @@ -35,6 +35,17 @@ typedef enum functype N0, N1, N2, N3, N4 /* No-env intrinsics. */ } functype_t; +#define TAG_SHIFT 1 +#define TAG_MASK ((1 << TAG_SHIFT) - 1) +#define TAG_NUM 1 +#define TAG_PTR 0 +#define NUM_MAX (LONG_MAX/2) +#define NUM_MIN (LONG_MIN/2) + +#define is_ptr(obj) ((obj) && (((long) obj) & TAG_MASK) == TAG_PTR) +#define is_num(obj) ((((long) obj) & TAG_MASK) == TAG_NUM) +#define type(obj) ((is_num(obj)) ? NUM : obj->t.type) + typedef union obj obj_t; struct any { @@ -59,11 +70,6 @@ struct chr { int ch; }; -struct num { - type_t type; - long val; -}; - struct sym { type_t type; obj_t *name; @@ -144,7 +150,6 @@ union obj { struct cons c; struct string st; struct chr ch; - struct num n; struct sym s; struct func f; struct vec v; @@ -321,7 +326,7 @@ obj_t *match(obj_t *spec, obj_t *data); #define nil ((obj_t *) 0) -#define nao ((obj_t *) -1) /* "not an object", useful as a sentinel. */ +#define nao ((obj_t *) (-1 << TAG_SHIFT)) /* "not an object" sentinel value. */ #define eq(a, b) ((a) == (b) ? t : nil) @@ -296,7 +296,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, elem = first(specline); - switch (elem ? elem->t.type : 0) { + switch (elem ? type(elem) : 0) { case CONS: /* directive */ { obj_t *directive = first(elem); @@ -362,7 +362,7 @@ obj_t *match_line(obj_t *bindings, obj_t *specline, obj_t *dataline, bindings = acons_new(bindings, sym, sub_str(dataline, pos, nil)); pos = length_str(dataline); } - } else if (pat->t.type == STR) { + } else if (type(pat) == STR) { obj_t *find = search_str(dataline, pat, pos, modifier); if (!find) { LOG_MISMATCH("var delimiting string"); @@ -750,7 +750,7 @@ void do_output_line(obj_t *bindings, obj_t *specline, for (; specline; specline = rest(specline)) { obj_t *elem = first(specline); - switch (elem ? elem->t.type : 0) { + switch (elem ? type(elem) : 0) { case CONS: { obj_t *directive = first(elem); |