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.

6 files changed, 104 insertions, 66 deletions

diff --git a/ChangeLog b/ChangeLog
index 4e20ecb1..a90801f0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.
 
diff --git a/gc.c b/gc.c
index efc135e0..4d19fedf 100644
--- a/gc.c
+++ b/gc.c
@@ -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;
diff --git a/hash.c b/hash.c
index 33510917..05db2fdd 100644
--- a/hash.c
+++ b/hash.c
@@ -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");
diff --git a/lib.c b/lib.c
index 0d55c14c..c009b7b0 100644
--- a/lib.c
+++ b/lib.c
@@ -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:
     {
diff --git a/lib.h b/lib.h
index ce84f69f..2b32582d 100644
--- a/lib.h
+++ b/lib.h
@@ -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)
 
diff --git a/match.c b/match.c
index 0e70947b..fb82d945 100644
--- a/match.c
+++ b/match.c
@@ -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);