summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2022-09-13 07:17:44 -0700
committerKaz Kylheku <kaz@kylheku.com>2022-09-13 07:17:44 -0700
commit516dd3d1bf29ffd72e6f868896738ffd29df588e (patch)
tree1a5c81f7fd26542010f531ae17fb4fbf36e850c7
parent7b399ee696036fe6d1acbbb64cd8a15d6a53078d (diff)
downloadtxr-516dd3d1bf29ffd72e6f868896738ffd29df588e.tar.gz
txr-516dd3d1bf29ffd72e6f868896738ffd29df588e.tar.bz2
txr-516dd3d1bf29ffd72e6f868896738ffd29df588e.zip
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.
-rw-r--r--arith.c185
-rw-r--r--buf.c8
-rw-r--r--chksum.c4
-rwxr-xr-xconfigure21
-rw-r--r--ffi.c16
-rw-r--r--hash.c13
-rw-r--r--lib.c20
-rw-r--r--lib.h154
-rw-r--r--stream.c2
9 files changed, 347 insertions, 76 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;
diff --git a/buf.c b/buf.c
index e6e03da1..a998b172 100644
--- a/buf.c
+++ b/buf.c
@@ -1150,7 +1150,9 @@ static val buf_int(val num)
val self = lit("buf-int");
switch (type(num)) {
- case NUM: case CHR:
+ case CHR:
+ return buf_int(num_fast(c_ch(num)));
+ case NUM:
num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
@@ -1180,7 +1182,9 @@ static val buf_uint(val num)
val self = lit("buf-uint");
switch (type(num)) {
- case NUM: case CHR:
+ case CHR:
+ return buf_uint(num_fast(c_ch(num)));
+ case NUM:
num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
diff --git a/chksum.c b/chksum.c
index 9d697619..c2cb06c1 100644
--- a/chksum.c
+++ b/chksum.c
@@ -212,7 +212,7 @@ val sha256_hash(val ctx, val obj)
sha256_szmax_upd(ps256, obj->b.data, c_unum(obj->b.len, self));
break;
case CHR:
- utf8_encode(c_chr(obj), sha256_utf8_byte_callback, coerce(mem_t *, ps256));
+ utf8_encode(c_ch(obj), sha256_utf8_byte_callback, coerce(mem_t *, ps256));
break;
case NUM:
{
@@ -476,7 +476,7 @@ val md5_hash(val ctx, val obj)
md5_szmax_upd(pmd5, obj->b.data, c_unum(obj->b.len, self));
break;
case CHR:
- utf8_encode(c_chr(obj), md5_utf8_byte_callback, coerce(mem_t *, pmd5));
+ utf8_encode(c_ch(obj), md5_utf8_byte_callback, coerce(mem_t *, pmd5));
break;
case NUM:
{
diff --git a/configure b/configure
index 671fcfe4..d1fbe948 100755
--- a/configure
+++ b/configure
@@ -1586,7 +1586,8 @@ fi
if ! [ $nan_boxing_given ] ; then
printf "Checking whether to use NaN boxing ... "
- if [ $SIZEOF_PTR -eq 8 ] ; then
+ # too experimental: disabled
+ if false && [ $SIZEOF_PTR -eq 8 ] ; then
nan_boxing=y
printf "yes\n"
else
@@ -1601,6 +1602,24 @@ if [ -n "$nan_boxing" ] ; then
printf "#define CONFIG_NAN_BOXING 1\n" >> config.h
fi
+if [ -n "$nan_boxing" ] ; then
+ printf "Checking how to disable strict aliasing warnings ... "
+
+ cat > conftest.c <<!
+int main(void)
+{
+ return 0;
+}
+!
+
+ if conftest EXTRA_FLAGS=-Wno-strict-aliasing ; then
+ printf -- "-Wno-strict-aliasing\n"
+ diag_flags="$diag_flags -Wno-strict-aliasing"
+ else
+ printf "unknown\n"
+ fi
+fi
+
printf "Checking for intmax_t ... "
cat > conftest.c <<!
#include <inttypes.h>
diff --git a/ffi.c b/ffi.c
index bf59fb1d..dfe90ddc 100644
--- a/ffi.c
+++ b/ffi.c
@@ -879,8 +879,10 @@ static void ffi_float_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
switch (type(n)) {
case NUM:
+ v = c_n(n);
+ break;
case CHR:
- v = c_num(n, self);
+ v = c_ch(n);
break;
case BGNUM:
n = int_flo(n);
@@ -918,8 +920,10 @@ static void ffi_double_put(struct txr_ffi_type *tft, val n, mem_t *dst,
switch (type(n)) {
case NUM:
+ v = c_n(n);
+ break;
case CHR:
- v = c_num(n, self);
+ v = c_ch(n);
break;
case BGNUM:
n = int_flo(n);
@@ -6618,7 +6622,9 @@ val carray_uint(val num, val eltype_in)
carray_elem_check(tft, self);
switch (type(num)) {
- case NUM: case CHR:
+ case CHR:
+ return carray_uint(num_fast(c_ch(num)), eltype);
+ case NUM:
num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
@@ -6653,7 +6659,9 @@ val carray_int(val num, val eltype_in)
carray_elem_check(tft, self);
switch (type(num)) {
- case NUM: case CHR:
+ case CHR:
+ return carray_int(num_fast(c_ch(num)), eltype);
+ case NUM:
num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
diff --git a/hash.c b/hash.c
index 70471382..4982c8b5 100644
--- a/hash.c
+++ b/hash.c
@@ -317,6 +317,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
case STR:
return hash_c_str(obj->st.str, seed, count);
case CHR:
+ return c_ch(obj);
case NUM:
return c_u(obj);
case SYM:
@@ -358,7 +359,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
case BGNUM:
return mp_hash(mp(obj)) * if3(seed, seed, 1);
case FLNUM:
- return hash_double(obj->fl.n) * if3(seed, seed, 1);
+ return hash_double(c_f(obj)) * if3(seed, seed, 1);
case COBJ:
case CPTR:
if (obj->co.ops->equalsub) {
@@ -394,7 +395,7 @@ static ucnum eql_hash(val obj, int *count)
case BGNUM:
return mp_hash(mp(obj));
case FLNUM:
- return hash_double(obj->fl.n);
+ return hash_double(c_f(obj));
case RNG:
return eql_hash(obj->rn.from, count) + 2 * eql_hash(obj->rn.to, count);
default:
@@ -406,6 +407,7 @@ static ucnum eql_hash(val obj, int *count)
}
}
case TAG_CHR:
+ return c_ch(obj);
case TAG_NUM:
return c_u(obj);
case TAG_LIT:
@@ -422,7 +424,7 @@ static ucnum eql_hash(val obj, int *count)
static ucnum eq_hash(val obj)
{
- switch (tag(obj)) {
+ switch (tag_ex(obj)) {
case TAG_PTR:
switch (CHAR_BIT * sizeof (mem_t *)) {
case 32:
@@ -431,6 +433,7 @@ static ucnum eq_hash(val obj)
return coerce(ucnum, obj) >> 5;
}
case TAG_CHR:
+ return c_ch(obj);
case TAG_NUM:
return c_u(obj);
case TAG_LIT:
@@ -440,6 +443,10 @@ static ucnum eq_hash(val obj)
case 64: default:
return coerce(ucnum, obj) >> 3;
}
+#if CONFIG_NAN_BOXING
+ case TAG_FLNUM:
+ return coerce(ucnum, obj);
+#endif
}
/* notreached */
abort();
diff --git a/lib.c b/lib.c
index 464cab79..26304231 100644
--- a/lib.c
+++ b/lib.c
@@ -153,6 +153,7 @@ const seq_kind_t seq_kind_tab[MAXTYPE+1] = {
SEQ_NOTSEQ, /* NUM */
SEQ_NOTSEQ, /* CHR */
SEQ_VECLIKE, /* LIT */
+ SEQ_NOTSEQ, /* FLNUM */
SEQ_LISTLIKE, /* CONS */
SEQ_VECLIKE, /* STR */
SEQ_NOTSEQ, /* SYM */
@@ -165,7 +166,6 @@ const seq_kind_t seq_kind_tab[MAXTYPE+1] = {
SEQ_NOTSEQ, /* CPTR */
SEQ_NOTSEQ, /* ENV */
SEQ_NOTSEQ, /* BGNUM */
- SEQ_NOTSEQ, /* FLNUM */
SEQ_NOTSEQ, /* RNG */
SEQ_VECLIKE, /* BUF */
SEQ_NOTSEQ, /* TNOD */
@@ -811,7 +811,7 @@ val seq_geti(seq_iter_t *it)
return v;
}
-static void seq_iter_rewind(seq_iter_t *it, val self)
+static void seq_iter_rewind(seq_iter_t *it)
{
switch (it->inf.type) {
case RNG:
@@ -820,10 +820,10 @@ static void seq_iter_rewind(seq_iter_t *it, val self)
switch (type(rf)) {
case NUM:
- it->ui.cn = c_num(rf, self);
+ it->ui.cn = c_n(rf);
break;
case CHR:
- it->ui.cn = c_chr(rf);
+ it->ui.cn = c_ch(rf);
break;
case BGNUM:
it->ui.vn = rf;
@@ -1241,7 +1241,7 @@ val iter_more(val iter)
case NIL:
return nil;
case CHR:
- return if2(c_chr(iter) <= 0x10FFFF, t);
+ return if2(c_ch(iter) <= 0x10FFFF, t);
case NUM:
case BGNUM:
return t;
@@ -4180,7 +4180,7 @@ val equal(val left, val right)
break;
case FLNUM:
if (type(right) == FLNUM) {
- if (left->fl.n == right->fl.n)
+ if (c_f(left) == c_f(right))
return t;
return nil;
}
@@ -5096,7 +5096,7 @@ val string_get_code(val str)
val stringp(val str)
{
- if (str) switch (tag(str)) {
+ if (str) switch (tag_ex(str)) {
case TAG_LIT:
return t;
case TAG_PTR:
@@ -12216,7 +12216,7 @@ val diff(val seq1, val seq2, val testfun, val keyfun)
val el2;
int found = 0;
- seq_iter_rewind(&si2, self);
+ seq_iter_rewind(&si2);
while (seq_get(&si2, &el2)) {
val el2_key = funcall1(keyfun, el2);
@@ -12322,7 +12322,7 @@ val isec(val seq1, val seq2, val testfun, val keyfun)
val el1_key = funcall1(keyfun, el1);
val el2;
- seq_iter_rewind(&si2, self);
+ seq_iter_rewind(&si2);
while (seq_get(&si2, &el2)) {
val el2_key = funcall1(keyfun, el2);
@@ -12354,7 +12354,7 @@ val isecp(val seq1, val seq2, val testfun, val keyfun)
val el1_key = funcall1(keyfun, el1);
val el2;
- seq_iter_rewind(&si2, self);
+ seq_iter_rewind(&si2);
while (seq_get(&si2, &el2)) {
val el2_key = funcall1(keyfun, el2);
diff --git a/lib.h b/lib.h
index f4e24ca6..35a237fa 100644
--- a/lib.h
+++ b/lib.h
@@ -52,18 +52,42 @@ typedef double_uintptr_t dbl_ucnum;
#define FLEX_ARRAY 1
#endif
-#define TAG_SHIFT 2
-#define TAG_MASK ((convert(cnum, 1) << TAG_SHIFT) - 1)
+#define PTR_BIT (SIZEOF_PTR * CHAR_BIT)
+
#define TAG_PTR 0
#define TAG_NUM 1
#define TAG_CHR 2
#define TAG_LIT 3
-#define NUM_MAX (INT_PTR_MAX/4)
-#define NUM_MIN (INT_PTR_MIN/4)
-#define PTR_BIT (SIZEOF_PTR * CHAR_BIT)
+#if CONFIG_NAN_BOXING
+
+#define TAG_FLNUM 4 /* pseudo-tag */
+#define TAG_WIDTH 2
+#define TAG_PAIR(A, B) ((A) << TAG_WIDTH | (B))
+
+#define NAN_TAG_BIT 14
+#define NAN_TAG_MASK 0xFFFC000000000000U
+#define TAG_BIGMASK 0xFFFF000000000000U
+#define TAG_BIGSHIFT 48
+
+#define NAN_FLNUM_DELTA 0x0004000000000000U
+
+#define NUM_MAX (INT_PTR_MAX >> NAN_TAG_BIT)
+#define NUM_MIN (INT_PTR_MIN >> NAN_TAG_BIT)
+#define NUM_BIT (PTR_BIT - NAN_TAG_BIT)
+
+#else
+
+#define TAG_SHIFT 2
+#define TAG_MASK ((convert(cnum, 1) << TAG_SHIFT) - 1)
+#define TAG_PAIR(A, B) ((A) << TAG_SHIFT | (B))
+
+#define NUM_MAX (INT_PTR_MAX >> TAG_SHIFT)
+#define NUM_MIN (INT_PTR_MIN >> TAG_SHIFT)
#define NUM_BIT (PTR_BIT - TAG_SHIFT)
+#endif
+
#ifdef __GNUC__
#define NORETURN __attribute__((noreturn))
#define NOINLINE __attribute__((noinline))
@@ -73,15 +97,14 @@ typedef double_uintptr_t dbl_ucnum;
#endif
typedef enum type {
- NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
- STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
- BGNUM, FLNUM, RNG, BUF, TNOD, DARG, MAXTYPE = DARG
+ NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, FLNUM,
+ CONS, STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
+ BGNUM, RNG, BUF, TNOD, DARG, MAXTYPE = DARG
/* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */
} type_t;
#define TYPE_SHIFT 5
#define TYPE_PAIR(A, B) ((A) << TYPE_SHIFT | (B))
-#define TAG_PAIR(A, B) ((A) << TAG_SHIFT | (B))
typedef enum functype
{
@@ -315,10 +338,12 @@ struct bignum {
mp_int mp;
};
+#if !CONFIG_NAN_BOXING
struct flonum {
obj_common;
double n;
};
+#endif
struct range {
obj_common;
@@ -353,7 +378,9 @@ union obj {
struct cptr cp;
struct env e;
struct bignum bn;
+#if !CONFIG_NAN_BOXING
struct flonum fl;
+#endif
struct range rn;
struct buf b;
struct tnod tn;
@@ -438,15 +465,54 @@ extern const seq_kind_t seq_kind_tab[MAXTYPE+1];
#define SEQ_KIND_PAIR(A, B) ((A) << 3 | (B))
+#if CONFIG_NAN_BOXING
+
+INLINE cnum tag(val obj)
+{
+ ucnum word = coerce(ucnum, obj) >> TAG_BIGSHIFT;
+ if (word <= TAG_LIT)
+ return word;
+ if ((word & (NAN_TAG_MASK >> TAG_BIGSHIFT)) == (NAN_TAG_MASK >> TAG_BIGSHIFT))
+ return TAG_NUM;
+ return TAG_PTR;
+}
+
+INLINE cnum tag_ex(val obj)
+{
+ ucnum word = coerce(ucnum, obj) >> TAG_BIGSHIFT;
+ if (word <= TAG_LIT)
+ return word;
+ if ((word & (NAN_TAG_MASK >> TAG_BIGSHIFT)) == (NAN_TAG_MASK >> TAG_BIGSHIFT))
+ return TAG_NUM;
+ return TAG_FLNUM;
+}
+
+INLINE int is_ptr(val obj)
+{
+ return obj && coerce(ucnum, obj) >> TAG_BIGSHIFT == TAG_PTR;
+}
+
+INLINE int is_flo(val obj)
+{
+ ucnum nantag = coerce(ucnum, obj) & NAN_TAG_MASK;
+ return nantag != 0 && nantag != NAN_TAG_MASK;
+}
+
+#else
+
INLINE cnum tag(val obj) { return coerce(cnum, obj) & TAG_MASK; }
+INLINE cnum tag_ex(val obj) { return tag(obj); }
INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; }
+
+#endif
+
INLINE int is_num(val obj) { return tag(obj) == TAG_NUM; }
INLINE int is_chr(val obj) { return tag(obj) == TAG_CHR; }
INLINE int is_lit(val obj) { return tag(obj) == TAG_LIT; }
INLINE type_t type(val obj)
{
- cnum tg = tag(obj);
+ cnum tg = tag_ex(obj);
return obj ? tg
? convert(type_t, tg)
: obj->t.type
@@ -455,7 +521,7 @@ INLINE type_t type(val obj)
typedef struct wli wchli_t;
-#if SIZEOF_WCHAR_T < 4
+#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
#define wli_noex(lit) (coerce(const wchli_t *,\
convert(const wchar_t *,\
L"\0" L ## lit L"\0" + 1)))
@@ -472,19 +538,31 @@ typedef struct wli wchli_t;
INLINE val auto_str(const wchli_t *str)
{
+#if CONFIG_NAN_BOXING
+ return coerce(val, coerce(cnum, str) |
+ (coerce(cnum, TAG_LIT) << TAG_BIGSHIFT));
+#else
return coerce(val, coerce(cnum, str) | TAG_LIT);
+#endif
}
INLINE val static_str(const wchli_t *str)
{
+#if CONFIG_NAN_BOXING
+ return coerce(val, coerce(cnum, str) |
+ (coerce(cnum, TAG_LIT) << TAG_BIGSHIFT));
+#else
return coerce(val, coerce(cnum, str) | TAG_LIT);
+#endif
}
INLINE wchar_t *litptr(val obj)
{
-#if SIZEOF_WCHAR_T < 4
+#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
wchar_t *ret = coerce(wchar_t *, (coerce(cnum, obj) & ~TAG_MASK));
return (*ret == 0) ? ret + 1 : ret;
+#elif CONFIG_NAN_BOXING
+ return coerce(wchar_t *, coerce(cnum, obj) & ~TAG_BIGMASK);
#else
return coerce(wchar_t *, coerce(cnum, obj) & ~TAG_MASK);
#endif
@@ -492,7 +570,9 @@ INLINE wchar_t *litptr(val obj)
INLINE val num_fast(cnum n)
{
-#if HAVE_UBSAN
+#if CONFIG_NAN_BOXING
+ return coerce(val, n | NAN_TAG_MASK);
+#elif HAVE_UBSAN
return coerce(val, (n * (1 << TAG_SHIFT)) | TAG_NUM);
#else
return coerce(val, (n << TAG_SHIFT) | TAG_NUM);
@@ -506,25 +586,60 @@ INLINE mp_int *mp(val bign)
INLINE val chr(wchar_t ch)
{
+#if CONFIG_NAN_BOXING
+ return coerce(val, ch | convert(cnum, TAG_CHR) << TAG_BIGSHIFT);
+#else
return coerce(val, (convert(cnum, ch) << TAG_SHIFT) | TAG_CHR);
+#endif
+}
+
+INLINE cnum c_ch(val num)
+{
+#if CONFIG_NAN_BOXING
+ return coerce(cnum, num) & ~TAG_BIGMASK;
+#else
+ return coerce(cnum, num) >> TAG_SHIFT;
+#endif
}
INLINE cnum c_n(val num)
{
+#if CONFIG_NAN_BOXING
+ cnum n = coerce(cnum, num) & ~NAN_TAG_MASK;
+ return n << NAN_TAG_BIT >> NAN_TAG_BIT;
+#else
return coerce(cnum, num) >> TAG_SHIFT;
+#endif
}
INLINE ucnum c_u(val num)
{
+#if CONFIG_NAN_BOXING
+ return coerce(ucnum, num) & ~NAN_TAG_MASK;
+#else
return convert(ucnum, coerce(cnum, num) >> TAG_SHIFT);
+#endif
}
-#if SIZEOF_WCHAR_T < 4
+INLINE double c_f(val num)
+{
+#if CONFIG_NAN_BOXING
+ ucnum u = coerce(ucnum, num) - NAN_FLNUM_DELTA;
+ return *coerce(double *, &u);
+#else
+ return num->fl.n;
+#endif
+}
+
+#if SIZEOF_WCHAR_T < 4 && !CONFIG_NAN_BOXING
#define lit_noex(strlit) coerce(obj_t *,\
coerce(cnum, L"\0" L ## strlit L"\0" + 1) | \
TAG_LIT)
+#elif CONFIG_NAN_BOXING
+#define lit_noex(strlit) coerce(val, coerce(cnum, L ## strlit) | \
+ (coerce(cnum, TAG_LIT) << TAG_BIGSHIFT))
#else
-#define lit_noex(strlit) coerce(obj_t *, coerce(cnum, L ## strlit) | TAG_LIT)
+#define lit_noex(strlit) coerce(val, coerce(cnum, L ## strlit) | TAG_LIT)
#endif
#define lit(strlit) lit_noex(strlit)
@@ -610,7 +725,7 @@ val iter_more(val iter);
val iter_item(val iter);
val iter_step(val iter);
val iter_reset(val iter, val obj);
-val throw_mismatch(val self, val obj, type_t);
+NORETURN val throw_mismatch(val self, val obj, type_t);
INLINE val type_check(val self, val obj, type_t typecode)
{
if (type(obj) != typecode)
@@ -1300,7 +1415,12 @@ INLINE val null(val v) { return v ? nil : t; }
#define nilp(o) ((o) == nil)
-#define nao coerce(obj_t *, 1 << TAG_SHIFT) /* "not an object" sentinel value. */
+/* "not an object" sentinel value. */
+#if CONFIG_NAN_BOXING
+#define nao coerce(obj_t *, 1)
+#else
+#define nao coerce(obj_t *, 1 << TAG_SHIFT)
+#endif
#define missingp(v) ((v) == colon_k)
diff --git a/stream.c b/stream.c
index 9fc61afc..08c2adc9 100644
--- a/stream.c
+++ b/stream.c
@@ -3709,7 +3709,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
uw_throwf(error_s, lit("~a: excessive precision: ~s"),
self, num(precision), nao);
- sprintf(num_buf, "%.*g", precision, obj->fl.n);
+ sprintf(num_buf, "%.*g", precision, c_f(obj));
#if CONFIG_LOCALE_TOLERANCE
if (dec_point != '.') {