Implement NaN boxing.

On platforms with 64 bit pointers, and therefore 64-bit-wide
TXR values, we can use a representation technique which allows
double floating-point values to be unboxed.

Fixnum integers are reduced from 62 bits to 50, and there is
a little more complexity in the run-time type checking and
dispatch which costs extra cycles.

The support is currently off by default; it must be explicitly
enabled with ./configure --nan-boxing.

* lib.h (NUM_MAX, NUM_MIN, NUM_BIT): Define separately for
NaN boxing.
(TAG_FLNUM, TAG_WIDTH, NAN_TAG_BIT, NAN_TAG_MASK, TAG_BIGMASK,
TAG_BIGSHIFT, NAN_FLNUM_DELTA): New preprocessor symbols.
(enum type, type_t): The FLNUM enumeration constant moves
to just after LIT, so that its value is the same as TAG_FLNUM.
(struct flonum): Does not exist under NaN boxing.
(union obj): No fl member under NaN boxing.
(tag, is_ptr): Separately defined for NaN boxing.
(is_flo): New function under NaN boxing.
(tag_ex): New function. It's like tag, but identifies
floating-point values as TAG_FLNUM. The tag function continues
to map them to TAG_PTR, which is wrong under NaN boxing,
but needed in order not to separately write tons of cases in
the arith.c module.
(type): Use tag_ex, so TAG_FLNUM is handled, if it exists.
(auto_str, static_str, litptr, num_fast, chr, c_n, c_u):
Different definition for NaN boxing.
(c_ch, c_f): New function.
(throw_mismatch): Attribute with NORETURN.
(nao): Separate definition for NaN boxing.

* lib.c (seq_kind_tab): Reorder initializer to follow enum
reordering.
(seq_iter_rewind): use c_n and c_ch functions, since type
checking has been done in those cases. The self parameter
is no longer needed.
(iter_more): use c_ch on CHR object.
(equal): Use c_f accessor to get double value rather than
assuming there is a struct flonum representation.
(stringp): Use tag_ex, otherwise a floating-point number
is identified as TAG_PTR.
(diff, isec, isecp): Don't pass removed self parameter
to seq_iter_rewind.

* arith.c (c_unum, c_dbl_num, c_dbl_unum, plus, minus,
signum, gt, lt, ge, le, numeq, logand, logior,
logxor, logxor_old, bit, bitset, tofloat, toint,
width, c_num, c_fixnum): Extract floating-point value
using c_f accessor. Handle CHR type separately from NUM
because the storage representation is no longer identical;
CHR values have a two bit tag over bits where NUM has
ordinary value bits. NUM is tagged at the NaN level with
the upper 14 bits being 0xFFFC. The remaining 50 bits
are the value.
(flo): Construct unboxed float under NaN boxing by taking
image of double as a 64 bit value, and adding the
delta offset, then casting to the val pointer type.
(c_flo): Separate implementation for NaN boxing.
(integerp, numberp): Use tag_ex.

* buf.c (str_buf, buf_int): Separate CHR and NUM cases,
like in numerous arith.c functions.

* chksum.c (sha256_hash, md5_hash): Use c_ch accessor for
CHR value.

* hash.c (equal_hash, eql_hash): Handle CHR separately. Use
c_f accessor for floating-point value.
(eq_hash): Use tag_ex and handle TAG_FLNUM value under NaN
boxing. Handle CHR separately from NUM.

* ffi.c (ffi_float_put, ffi_double_put, carray_uint, carray_int):
Handle CHR and NUM separately.

* stream.c (formatv): Use c_f accessor.

* configure: disable automatic selection of NaN boxing
on 64 bit platforms, for now.
Add test whether -Wno-strict-aliasing is supported by
the compiler, performed only if NaN boxing is enabled.
We need to disable this warning because it goes off on
the code that reinterprets an integer as a double and
vice versa.

1 files changed, 149 insertions, 36 deletions

diff --git a/arith.c b/arith.c
index dc73a729..30847a4a 100644
--- a/arith.c
+++ b/arith.c
@@ -189,7 +189,14 @@ val normalize(val bignum)
 ucnum c_unum(val num, val self)
 {
   switch (type(num)) {
-  case CHR: case NUM:
+  case CHR:
+    {
+      cnum n = c_ch(num);
+      if (n >= 0)
+        return n;
+    }
+    goto range;
+  case NUM:
     {
       cnum n = c_n(num);
       if (n >= 0)
@@ -227,7 +234,9 @@ val unum(ucnum u)
 dbl_cnum c_dbl_num(val n)
 {
   switch (type(n)) {
-  case CHR: case NUM:
+  case CHR:
+    return c_ch(n);
+  case NUM:
     return c_n(n);
   case BGNUM:
     if (mp_in_double_intptr_range(mp(n))) {
@@ -245,7 +254,14 @@ dbl_cnum c_dbl_num(val n)
 dbl_ucnum c_dbl_unum(val n)
 {
   switch (type(n)) {
-  case CHR: case NUM:
+  case CHR:
+    {
+      dbl_cnum cn = c_ch(n);
+      if (cn >= 0)
+        return cn;
+      break;
+    }
+  case NUM:
     {
       dbl_cnum cn = c_n(n);
       if (cn >= 0)
@@ -656,7 +672,7 @@ tail:
     break;
   case TAG_PAIR(TAG_CHR, TAG_NUM):
     {
-      wchar_t a = c_chr(anum);
+      wchar_t a = c_ch(anum);
       cnum b = c_n(bnum);
       cnum sum = a + b;
 
@@ -667,7 +683,7 @@ tail:
   case TAG_PAIR(TAG_NUM, TAG_CHR):
     {
       cnum a = c_n(anum);
-      wchar_t b = c_chr(bnum);
+      wchar_t b = c_ch(bnum);
       cnum sum = a + b;
 
       if (sum < 0 || sum > 0x10FFFF)
@@ -696,9 +712,18 @@ val minus(val anum, val bnum)
 
 tail:
   switch (TAG_PAIR(tag(anum), tag(bnum))) {
-  case TAG_PAIR(TAG_NUM, TAG_NUM):
   case TAG_PAIR(TAG_CHR, TAG_CHR):
     {
+      cnum a = c_ch(anum);
+      cnum b = c_ch(bnum);
+      cnum sum = a - b;
+
+      if (sum < NUM_MIN || sum > NUM_MAX)
+        return bignum(sum);
+      return num_fast(sum);
+    }
+  case TAG_PAIR(TAG_NUM, TAG_NUM):
+    {
       cnum a = c_n(anum);
       cnum b = c_n(bnum);
       cnum sum = a - b;
@@ -828,7 +853,7 @@ tail:
     break;
   case TAG_PAIR(TAG_CHR, TAG_NUM):
     {
-      wchar_t a = c_chr(anum);
+      wchar_t a = c_ch(anum);
       cnum b = c_n(bnum);
       cnum sum = a - b;
 
@@ -911,7 +936,7 @@ static val signum(val anum)
     return if3(mp_isneg(mp(anum)), negone, one);
   case FLNUM:
     {
-      double a = anum->fl.n;
+      double a = c_f(anum);
       return flo(if3(a > 0, 1.0, if3(a < 0, -1.0, 0.0)));
     }
   case NUM:
@@ -1967,10 +1992,13 @@ val gt(val anum, val bnum)
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
+    return c_n(anum) > c_n(bnum) ? t : nil;
   case TYPE_PAIR(CHR, CHR):
+    return c_ch(anum) > c_ch(bnum) ? t : nil;
   case TYPE_PAIR(NUM, CHR):
+    return c_n(anum) > c_ch(bnum) ? t : nil;
   case TYPE_PAIR(CHR, NUM):
-    return c_n(anum) > c_n(bnum) ? t : nil;
+    return c_ch(anum) > c_n(bnum) ? t : nil;
   case TYPE_PAIR(NUM, BGNUM):
   case TYPE_PAIR(CHR, BGNUM):
     return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil;
@@ -1980,11 +2008,13 @@ tail:
   case TYPE_PAIR(BGNUM, BGNUM):
     return mp_cmp(mp(anum), mp(bnum)) == MP_GT ? t : nil;
   case TYPE_PAIR(NUM, FLNUM):
-  case TYPE_PAIR(CHR, FLNUM):
     return c_n(anum) > c_flo(bnum, self) ? t : nil;
+  case TYPE_PAIR(CHR, FLNUM):
+    return c_ch(anum) > c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, NUM):
-  case TYPE_PAIR(FLNUM, CHR):
     return c_flo(anum, self) > c_n(bnum) ? t : nil;
+  case TYPE_PAIR(FLNUM, CHR):
+    return c_flo(anum, self) > c_ch(bnum) ? t : nil;
   case TYPE_PAIR(FLNUM, FLNUM):
     return c_flo(anum, self) > c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, BGNUM):
@@ -2030,10 +2060,13 @@ val lt(val anum, val bnum)
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
+    return c_n(anum) < c_n(bnum) ? t : nil;
   case TYPE_PAIR(CHR, CHR):
+    return c_ch(anum) < c_ch(bnum) ? t : nil;
   case TYPE_PAIR(NUM, CHR):
+    return c_n(anum) < c_ch(bnum) ? t : nil;
   case TYPE_PAIR(CHR, NUM):
-    return c_n(anum) < c_n(bnum) ? t : nil;
+    return c_ch(anum) < c_n(bnum) ? t : nil;
   case TYPE_PAIR(NUM, BGNUM):
   case TYPE_PAIR(CHR, BGNUM):
     return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil;
@@ -2043,11 +2076,13 @@ tail:
   case TYPE_PAIR(BGNUM, BGNUM):
     return mp_cmp(mp(anum), mp(bnum)) == MP_LT ? t : nil;
   case TYPE_PAIR(NUM, FLNUM):
-  case TYPE_PAIR(CHR, FLNUM):
     return c_n(anum) < c_flo(bnum, self) ? t : nil;
+  case TYPE_PAIR(CHR, FLNUM):
+    return c_ch(anum) < c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, NUM):
-  case TYPE_PAIR(FLNUM, CHR):
     return c_flo(anum, self) < c_n(bnum) ? t : nil;
+  case TYPE_PAIR(FLNUM, CHR):
+    return c_flo(anum, self) < c_ch(bnum) ? t : nil;
   case TYPE_PAIR(FLNUM, FLNUM):
     return c_flo(anum, self) < c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, BGNUM):
@@ -2093,10 +2128,13 @@ val ge(val anum, val bnum)
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
+    return c_n(anum) >= c_n(bnum) ? t : nil;
   case TYPE_PAIR(CHR, CHR):
+    return c_ch(anum) >= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(NUM, CHR):
+    return c_n(anum) >= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(CHR, NUM):
-    return c_n(anum) >= c_n(bnum) ? t : nil;
+    return c_ch(anum) >= c_n(bnum) ? t : nil;
   case TYPE_PAIR(NUM, BGNUM):
   case TYPE_PAIR(CHR, BGNUM):
     return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil;
@@ -2111,11 +2149,13 @@ tail:
       return nil;
     }
   case TYPE_PAIR(NUM, FLNUM):
-  case TYPE_PAIR(CHR, FLNUM):
     return c_n(anum) >= c_flo(bnum, self) ? t : nil;
+  case TYPE_PAIR(CHR, FLNUM):
+    return c_ch(anum) >= c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, NUM):
-  case TYPE_PAIR(FLNUM, CHR):
     return c_flo(anum, self) >= c_n(bnum) ? t : nil;
+  case TYPE_PAIR(FLNUM, CHR):
+    return c_flo(anum, self) >= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(FLNUM, FLNUM):
     return c_flo(anum, self) >= c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, BGNUM):
@@ -2161,10 +2201,13 @@ val le(val anum, val bnum)
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
+    return c_n(anum) <= c_n(bnum) ? t : nil;
   case TYPE_PAIR(CHR, CHR):
+    return c_ch(anum) <= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(NUM, CHR):
+    return c_n(anum) <= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(CHR, NUM):
-    return c_n(anum) <= c_n(bnum) ? t : nil;
+    return c_ch(anum) <= c_n(bnum) ? t : nil;
   case TYPE_PAIR(NUM, BGNUM):
   case TYPE_PAIR(CHR, BGNUM):
     return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil;
@@ -2179,11 +2222,13 @@ tail:
       return nil;
     }
   case TYPE_PAIR(NUM, FLNUM):
-  case TYPE_PAIR(CHR, FLNUM):
     return c_n(anum) <= c_flo(bnum, self) ? t : nil;
+  case TYPE_PAIR(CHR, FLNUM):
+    return c_ch(anum) <= c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, NUM):
-  case TYPE_PAIR(FLNUM, CHR):
     return c_flo(anum, self) <= c_n(bnum) ? t : nil;
+  case TYPE_PAIR(FLNUM, CHR):
+    return c_flo(anum, self) <= c_ch(bnum) ? t : nil;
   case TYPE_PAIR(FLNUM, FLNUM):
     return c_flo(anum, self) <= c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, BGNUM):
@@ -2259,10 +2304,13 @@ val numeq(val anum, val bnum)
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
+    return c_n(anum) == c_n(bnum) ? t : nil;
   case TYPE_PAIR(CHR, CHR):
+    return c_ch(anum) == c_ch(bnum) ? t : nil;
   case TYPE_PAIR(NUM, CHR):
+    return c_n(anum) == c_ch(bnum) ? t : nil;
   case TYPE_PAIR(CHR, NUM):
-    return c_n(anum) == c_n(bnum) ? t : nil;
+    return c_ch(anum) == c_n(bnum) ? t : nil;
   case TYPE_PAIR(NUM, BGNUM):
   case TYPE_PAIR(CHR, BGNUM):
     return mp_cmp_z(mp(bnum)) == MP_EQ ? t : nil;
@@ -2272,11 +2320,13 @@ tail:
   case TYPE_PAIR(BGNUM, BGNUM):
     return mp_cmp(mp(anum), mp(bnum)) == MP_EQ ? t : nil;
   case TYPE_PAIR(NUM, FLNUM):
-  case TYPE_PAIR(CHR, FLNUM):
     return c_n(anum) == c_flo(bnum, self) ? t : nil;
+  case TYPE_PAIR(CHR, FLNUM):
+    return c_ch(anum) == c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, NUM):
-  case TYPE_PAIR(FLNUM, CHR):
     return c_flo(anum, self) == c_n(bnum) ? t : nil;
+  case TYPE_PAIR(FLNUM, CHR):
+    return c_flo(anum, self) == c_ch(bnum) ? t : nil;
   case TYPE_PAIR(FLNUM, FLNUM):
     return c_flo(anum, self) == c_flo(bnum, self) ? t : nil;
   case TYPE_PAIR(FLNUM, BGNUM):
@@ -3074,9 +3124,14 @@ val logand(val a, val b)
 
   switch (TYPE_PAIR(type(a), type(b))) {
   case TYPE_PAIR(NUM, CHR):
-  case TYPE_PAIR(CHR, NUM):
     {
       cnum ac = c_n(a);
+      cnum bc = c_ch(b);
+      return chr(ac & bc);
+    }
+  case TYPE_PAIR(CHR, NUM):
+    {
+      cnum ac = c_ch(a);
       cnum bc = c_n(b);
       return chr(ac & bc);
     }
@@ -3125,9 +3180,14 @@ val logior(val a, val b)
 
   switch (TYPE_PAIR(type(a), type(b))) {
   case TYPE_PAIR(NUM, CHR):
-  case TYPE_PAIR(CHR, NUM):
     {
       cnum ac = c_n(a);
+      cnum bc = c_ch(b);
+      return chr(ac | bc);
+    }
+  case TYPE_PAIR(CHR, NUM):
+    {
+      cnum ac = c_ch(a);
       cnum bc = c_n(b);
       return chr(ac | bc);
     }
@@ -3176,9 +3236,14 @@ val logxor(val a, val b)
 
   switch (TYPE_PAIR(type(a), type(b))) {
   case TYPE_PAIR(NUM, CHR):
-  case TYPE_PAIR(CHR, NUM):
     {
       cnum ac = c_n(a);
+      cnum bc = c_ch(b);
+      return chr(ac ^ bc);
+    }
+  case TYPE_PAIR(CHR, NUM):
+    {
+      cnum ac = c_ch(a);
       cnum bc = c_n(b);
       return chr(ac ^ bc);
     }
@@ -3229,11 +3294,18 @@ val logxor_old(val a, val b)
 
   switch (TYPE_PAIR(type(a), type(b))) {
   case TYPE_PAIR(NUM, CHR):
-  case TYPE_PAIR(CHR, NUM):
     if (a == b) {
       return a;
     } else {
       cnum ac = c_n(a);
+      cnum bc = c_ch(b);
+      return chr(ac ^ bc);
+    }
+  case TYPE_PAIR(CHR, NUM):
+    if (a == b) {
+      return a;
+    } else {
+      cnum ac = c_ch(a);
       cnum bc = c_n(b);
       return chr(ac ^ bc);
     }
@@ -3556,13 +3628,19 @@ val bit(val a, val bit)
 
   switch (ta) {
   case NUM:
-  case CHR:
     {
       cnum an = c_n(a);
       if (bn < (SIZEOF_PTR * CHAR_BIT))
         return (an & (convert(cnum, 1) << bn)) ? t : nil;
       return an < 0 ? t : nil;
     }
+  case CHR:
+    {
+      cnum an = c_ch(a);
+      if (bn < (SIZEOF_PTR * CHAR_BIT))
+        return (an & (convert(cnum, 1) << bn)) ? t : nil;
+      return an < 0 ? t : nil;
+    }
   case BGNUM:
     {
       mpe = mp_bit(mp(a), bn);
@@ -3614,7 +3692,6 @@ val bitset(val n)
 
   switch (type(n)) {
   case NUM:
-  case CHR:
     {
       cnum c = c_n(n);
       ucnum d = c;
@@ -3629,6 +3706,21 @@ val bitset(val n)
 
       return out;
     }
+  case CHR:
+    {
+      cnum c = c_ch(n);
+      ucnum d = c;
+      int p = 0;
+
+      if (c < 0)
+        d = ~d;
+
+      for (; d; d >>= 1, p++)
+        if (d & 1)
+          ptail = list_collect(ptail, num_fast(p));
+
+      return out;
+    }
   case BGNUM:
     {
       mp_int *mn = mp(n);
@@ -3672,8 +3764,9 @@ val logcount(val n)
   val self = logcount_s;
 
   switch (type(n)) {
-  case NUM:
   case CHR:
+    return logcount(num_fast(c_ch(n)));
+  case NUM:
     {
       int_ptr_t c = c_n(n);
       uint_ptr_t d = c;
@@ -3835,7 +3928,7 @@ val tofloat(val obj)
     return flo_int(obj);
   case TAG_CHR:
     {
-      cnum ch = c_n(obj);
+      cnum ch = c_ch(obj);
       if (ch >= '0' && ch <= '9')
         return flo(ch - '0');
       return nil;
@@ -3872,7 +3965,7 @@ val toint(val obj, val base)
     return int_str(obj, base);
   case TAG_CHR:
     {
-      cnum ch = c_n(obj);
+      cnum ch = c_ch(obj);
 
       if (ch >= '0' && ch <= '9')
         return num(ch - '0');
@@ -3928,6 +4021,7 @@ val width(val obj)
 
   switch (type(obj)) {
   case CHR:
+    return width(num_fast(c_ch(obj)));
   case NUM:
     {
       cnum n = c_n(obj);
@@ -4128,7 +4222,9 @@ val num(cnum n)
 cnum c_num(val n, val self)
 {
   switch (type(n)) {
-  case CHR: case NUM:
+  case CHR:
+    return c_ch(n);
+  case NUM:
     return c_n(n);
   case BGNUM:
     if (mp_in_intptr_range(mp(n))) {
@@ -4146,7 +4242,9 @@ cnum c_num(val n, val self)
 cnum c_fixnum(val num, val self)
 {
   switch (type(num)) {
-  case CHR: case NUM:
+  case CHR:
+    return c_ch(num);
+  case NUM:
     return c_n(num);
   default:
     type_mismatch(lit("~a: ~s is not fixnum integer or character"),
@@ -4175,17 +4273,28 @@ val flo(double n)
   if (bad_float(n)) {
     uw_throw(numeric_error_s, lit("out-of-range floating-point result"));
   } else {
+#if CONFIG_NAN_BOXING
+    ucnum u = *(ucnum *) &n + NAN_FLNUM_DELTA;
+    return coerce(val, u);
+#else
     val obj = make_obj();
     obj->fl.type = FLNUM;
     obj->fl.n = n;
     return obj;
+#endif
   }
 }
 
 double c_flo(val num, val self)
 {
+#if CONFIG_NAN_BOXING
+  if (is_flo(num))
+    return c_f(num);
+  throw_mismatch(self, num, FLNUM);
+#else
   type_check(self, num, FLNUM);
   return num->fl.n;
+#endif
 }
 
 val fixnump(val num)
@@ -4200,7 +4309,7 @@ val bignump(val num)
 
 val integerp(val num)
 {
-  switch (tag(num)) {
+  switch (tag_ex(num)) {
   case TAG_NUM:
     return t;
   case TAG_PTR:
@@ -4221,9 +4330,13 @@ val floatp(val num)
 
 val numberp(val num)
 {
-  switch (tag(num)) {
+  switch (tag_ex(num)) {
   case TAG_NUM:
     return t;
+#if CONFIG_NAN_BOXING
+  case TAG_FLNUM:
+    return t;
+#endif
   case TAG_PTR:
     if (num == nil)
       return nil;