Changing representation of objects to allow for unboxed characters.

Now numbers and characters fit into a cell. We lose one more bit
from the range of numbers.

4 files changed, 64 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index 0f71e03d..4ed23e2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2009-11-06  Kaz Kylheku  <kkylheku@gmail.com>
 
+	Changing representation of objects to allow for unboxed characters.
+	Now numbers and characters fit into a cell. We lose one more bit
+	from the range of numbers.
+
+	* lib.h (TAG_SHIFT, TAG_MASK, TAG_NUM, TAG_PTR, NUM_MASK, NUM_MIN,
+	is_ptr, is_num):  Macros updated.
+	(is_chr, tag): New macros.
+	(struct chr): Removed.
+	(union obj): Updated.
+
+	* lib.c (typeof, equal, chr, chrp, c_chr, obj_print): Updated.
+
+	* hash.c (ll_hash): Characters aren't pointers any longer;
+	use abstract accessor.
+
+2009-11-06  Kaz Kylheku  <kkylheku@gmail.com>
+
 	Add hash removal.
 
 	* hash.c (remhash): New function.
diff --git a/hash.c b/hash.c
index d583862f..390d7662 100644
--- a/hash.c
+++ b/hash.c
@@ -87,7 +87,7 @@ static long ll_hash(obj_t *obj)
   case STR:
     return hash_c_str(obj->st.str);
   case CHR:
-    return obj->ch.ch + NUM_MAX / 2;
+    return c_chr(obj) + NUM_MAX / 2;
   case NUM:
     return c_num(obj) & NUM_MAX;
   case SYM:
diff --git a/lib.c b/lib.c
index c009b7b0..51a1cdd2 100644
--- a/lib.c
+++ b/lib.c
@@ -101,17 +101,24 @@ static obj_t *code2type(int code)
 
 obj_t *typeof(obj_t *obj)
 {
-  if (is_num(obj)) {
+  switch (tag(obj)) {
+  case TAG_NUM:
     return num_t;
-  } else if (obj == nil) {
-    return null;
-  } else if (obj->t.type == COBJ) {
-    return obj->co.cls;
-  } else {
-    obj_t *type = code2type(obj->t.type);
-    if (!type)
-      internal_error("corrupt type field");
-    return type;
+  case TAG_CHR:
+    return chr_t;
+  case TAG_PTR:
+    if (obj == nil) {
+      return null;
+    } else if (obj->t.type == COBJ) {
+      return obj->co.cls;
+    } else {
+      obj_t *type = code2type(obj->t.type);
+      if (!type)
+        internal_error("corrupt type field");
+      return type;
+    }
+  default:
+    internal_error("invalid type tag");
   }
 }
 
@@ -398,10 +405,16 @@ long c_num(obj_t *num);
 
 obj_t *equal(obj_t *left, obj_t *right)
 {
-  if (left == nil && right == nil)
+  /* Bitwise equality is equality.
+     The object nil, and types CHR and NUM
+     need no further test. */
+  if (left == right)
     return t;
 
-  if (left == nil || right == nil)
+  /* If the objects are not bitwise equal,
+     and any one of them is not a pointer,
+     then they can't be equal. */
+  if (!is_ptr(left) || !is_ptr(right))
     return nil;
 
   switch (type(left)) {
@@ -422,14 +435,6 @@ obj_t *equal(obj_t *left, obj_t *right)
       return equal(left, right->ls.prefix);
     }
     return nil;
-  case CHR:
-    if (type(right) == CHR && left->ch.ch == right->ch.ch)
-      return t;
-    return nil;
-  case NUM:
-    if (type(right) == NUM && c_num(left) == c_num(right))
-      return t;
-    return nil;
   case SYM:
     return right == left ? t : nil;
   case FUN:
@@ -952,21 +957,20 @@ obj_t *string_lt(obj_t *astr, obj_t *bstr)
 
 obj_t *chr(int ch)
 {
-  obj_t *obj = make_obj();
-  obj->ch.type = CHR;
-  obj->ch.ch = ch;
-  return obj;
+  numeric_assert (ch >= NUM_MIN && ch <= NUM_MAX);
+  return (obj_t *) ((ch << TAG_SHIFT) | TAG_CHR);
 }
 
 obj_t *chrp(obj_t *chr)
 {
-  return (chr && chr->st.type == CHR) ? t : nil;
+  return (is_chr(num)) ? t : nil;
 }
 
 int c_chr(obj_t *chr)
 {
-  type_check(chr, CHR);
-  return chr->ch.ch;
+  if (!is_chr(chr))
+    type_mismatch("~s is not a character", chr, nao);
+  return ((int) chr) >> TAG_SHIFT;
 }
 
 obj_t *chr_str(obj_t *str, obj_t *index)
@@ -1848,7 +1852,7 @@ void obj_print(obj_t *obj, obj_t *out)
     return;
   case CHR:
     {
-      int ch = obj->ch.ch;
+      int ch = c_chr(obj);
 
       put_cchar(out, '\'');
       switch (ch) {
diff --git a/lib.h b/lib.h
index 2b32582d..b993d39e 100644
--- a/lib.h
+++ b/lib.h
@@ -24,8 +24,16 @@
  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  */
 
+#define TAG_SHIFT 2
+#define TAG_MASK ((1 << TAG_SHIFT) - 1)
+#define TAG_PTR 0
+#define TAG_NUM 1
+#define TAG_CHR 2
+#define NUM_MAX (LONG_MAX/4)
+#define NUM_MIN (LONG_MIN/4)
+
 typedef enum type {
-  CONS = 1, STR, CHR, NUM, SYM, FUN, VEC, LCONS, LSTR, COBJ
+  NUM = TAG_NUM, CHR = TAG_CHR, CONS, STR, SYM, FUN, VEC, LCONS, LSTR, COBJ
 } type_t;
 
 typedef enum functype
@@ -35,16 +43,11 @@ 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)
+#define tag(obj) (((long) (obj)) & TAG_MASK)
+#define is_ptr(obj) ((obj) && (tag(obj) == TAG_PTR))
+#define is_num(obj) (tag(obj) == TAG_NUM)
+#define is_chr(obj) (tag(obj) == TAG_CHR)
+#define type(obj) (tag(obj) ? ((type_t) tag(obj)) : obj->t.type)
 
 typedef union obj obj_t;
 
@@ -65,11 +68,6 @@ struct string {
   obj_t *len;
 };
 
-struct chr {
-  type_t type;
-  int ch;
-};
-
 struct sym {
   type_t type;
   obj_t *name;
@@ -149,7 +147,6 @@ union obj {
   struct any t;
   struct cons c;
   struct string st;
-  struct chr ch;
   struct sym s;
   struct func f;
   struct vec v;