From 5f7201ab045b5d70cdd786426546c96b4c86f28e Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 27 Dec 2009 13:37:25 +0900
Subject: [PATCH] immediate flonums now work on 64-bit machines.

we pack a 32-bit float so there's no funky rounding issues as
on 32-bit machines.  this reduces heap usage, and avoids
allocations during flonum arithmetic.
---
 include/chibi/sexp.h |  8 +++++++-
 opcodes.c            |  4 ++++
 opt/bignum.c         |  3 +++
 sexp.c               | 20 ++++++++++++++++++--
 4 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index 9f1b775f..a73f3e98 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -391,11 +391,17 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
 #if SEXP_USE_IMMEDIATE_FLONUMS
 union sexp_flonum_conv {
   float flonum;
-  sexp_uint_t bits;
+  unsigned int bits;
 };
 #define sexp_flonump(x)      (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_IFLONUM_TAG)
+SEXP_API sexp sexp_flonum_predicate (sexp ctx, sexp x);
+#if SEXP_64_BIT
+SEXP_API float sexp_flonum_value (sexp x);
+SEXP_API sexp sexp_make_flonum(sexp ctx, float f);
+#else
 #define sexp_make_flonum(ctx, x)  ((sexp) ((((union sexp_flonum_conv)((float)(x))).bits & ~SEXP_IMMEDIATE_MASK) + SEXP_IFLONUM_TAG))
 #define sexp_flonum_value(x) (((union sexp_flonum_conv)(((sexp_uint_t)(x)) & ~SEXP_IMMEDIATE_MASK)).flonum)
+#endif
 #else
 #define sexp_flonump(x)      (sexp_check_tag(x, SEXP_FLONUM))
 #define sexp_flonum_value(f) ((f)->value.flonum)
diff --git a/opcodes.c b/opcodes.c
index a2af3017..c6f5445d 100644
--- a/opcodes.c
+++ b/opcodes.c
@@ -57,7 +57,11 @@ _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_FIXNUMP,  1, 0, 0, 0, 0, "fixnum?", NULL, 0
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0),
+#if SEXP_USE_IMMEDIATE_FLONUMS
+_FN1(0, "flonum?", 0, sexp_flonum_predicate),
+#else
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0),
+#endif
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "bignum?", sexp_make_fixnum(SEXP_BIGNUM), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0),
 _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP,  1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0),
diff --git a/opt/bignum.c b/opt/bignum.c
index 49cfb314..90f71661 100644
--- a/opt/bignum.c
+++ b/opt/bignum.c
@@ -465,6 +465,9 @@ static int sexp_number_types[] =
 
 static int sexp_number_type (sexp a) {
   return sexp_pointerp(a) ? sexp_number_types[sexp_pointer_tag(a)&15]
+#if SEXP_USE_IMMEDIATE_FLONUMS
+    : sexp_flonump(a) ? 2
+#endif
     : sexp_fixnump(a);
 }
 
diff --git a/sexp.c b/sexp.c
index 0bcc3a57..b12900b3 100644
--- a/sexp.c
+++ b/sexp.c
@@ -574,12 +574,28 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
 /********************* strings, symbols, vectors **********************/
 
 #if ! SEXP_USE_IMMEDIATE_FLONUMS
-sexp sexp_make_flonum(sexp ctx, double f) {
+sexp sexp_make_flonum (sexp ctx, double f) {
   sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
   if (sexp_exceptionp(x)) return x;
   sexp_flonum_value(x) = f;
   return x;
 }
+#else
+sexp sexp_flonum_predicate (sexp ctx, sexp x) {
+  return sexp_make_boolean(sexp_flonump(x));
+}
+#if SEXP_64_BIT
+float sexp_flonum_value (sexp x) {
+  union sexp_flonum_conv r;
+  r.bits = (sexp_uint_t)x >> 32;
+  return r.flonum;
+}
+sexp sexp_make_flonum (sexp ctx, float f) {
+  union sexp_flonum_conv x;
+  x.flonum = f;
+  return (sexp)(((sexp_uint_t)(x.bits) << 32) + SEXP_IFLONUM_TAG);
+}
+#endif
 #endif
 
 sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
@@ -1111,7 +1127,7 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
     } else
 #endif
     {
-      i = sprintf(numbuf, "%.15g", f);
+      i = sprintf(numbuf, "%.8g", f);
       if (f == trunc(f) && ! strchr(numbuf, '.')) {
         numbuf[i++] = '.'; numbuf[i++] = '0'; numbuf[i++] = '\0';
       }