Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 14:49:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

immediate flonums now work on 64-bit machines.

Browse source 
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.
This commit is contained in:
Alex Shinn 2009-12-27 13:37:25 +09:00
parent f645ecbb54
commit 5f7201ab04
4 changed files with 32 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
include/chibi/sexp.h
View file

@ -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)

4
opcodes.c
View file

@ -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),

3
opt/bignum.c
View file

@ -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);
}

20
sexp.c
View file

@ -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';
}