diff --git a/lisp/kernel.gl b/lisp/kernel.gl index b431249..4893017 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -1,4 +1,4 @@ ;; -*- mode: lisp-data -*- -(prin1 1.0) -(write-byte 10) +(prin1 1.0e2) +(write-byte ?\n) diff --git a/src/base.h b/src/base.h index c176262..ba7bb41 100644 --- a/src/base.h +++ b/src/base.h @@ -23,24 +23,16 @@ typedef intptr_t fixnum_t; # define LISP_FLOAT_SCANF "f" # define LISP_FLOAT_PRINTF "f" typedef lisp_float32_t lisp_float_t; -typedef lisp_float32_parts lisp_float_parts_t; -# define LISP_FLOAT_MIN_EXP FLOAT32_MIN_EXP -# define LISP_FLOAT_MAX_EXP FLOAT32_MAX_EXP -# define LISP_FLOAT_MAX_PRECISION FLOAT32_MAX_PRECISION # define LISP_FLOAT_NAN LISP_FLOAT32_NAN() -# define LISP_FLOAT_POS_INF LISP_FLOAT32_INF(false) -# define LISP_FLOAT_NEG_INF LISP_FLOAT32_INF(true) +# define LISP_FLOAT_INF LISP_FLOAT32_INF() +# define LISP_FLOAT_MAX_PRECISION FLOAT32_MAX_PRECISION #else # define LISP_FLOAT_SCANF "lf" # define LISP_FLOAT_PRINTF "f" typedef lisp_float64_t lisp_float_t; -typedef lisp_float64_parts lisp_float_parts_t; -# define LISP_FLOAT_MIN_EXP FLOAT64_MIN_EXP -# define LISP_FLOAT_MAX_EXP FLOAT64_MAX_EXP -# define LISP_FLOAT_MAX_PRECISION FLOAT64_MAX_PRECISION # define LISP_FLOAT_NAN LISP_FLOAT64_NAN() -# define LISP_FLOAT_POS_INF LISP_FLOAT64_INF(false) -# define LISP_FLOAT_NEG_INF LISP_FLOAT64_INF(true) +# define LISP_FLOAT_INF LISP_FLOAT64_INF() +# define LISP_FLOAT_MAX_PRECISION FLOAT64_MAX_PRECISION #endif #define MOST_POSITIVE_FIXNUM ((intptr_t) ((INTPTR_MAX & ~(intptr_t) 3) >> 2)) @@ -92,8 +84,8 @@ static ALWAYS_INLINE LispVal *MAKE_LISP_FLOAT(lisp_float_t flt) { } #define LISP_NAN MAKE_LISP_FLOAT(LISP_FLOAT_NAN) -#define LISP_POS_INF MAKE_LISP_FLOAT(LISP_FLOAT_POS_INF) -#define LISP_NEG_INF MAKE_LISP_FLOAT(LISP_FLOAT_NEG_INF) +#define LISP_POS_INF MAKE_LISP_FLOAT(LISP_FLOAT_INF) +#define LISP_NEG_INF MAKE_LISP_FLOAT(-LISP_FLOAT_INF) // ############### // # Other types # diff --git a/src/memory.h b/src/memory.h index 5516fc0..bd0848f 100644 --- a/src/memory.h +++ b/src/memory.h @@ -51,11 +51,13 @@ static ALWAYS_INLINE bool LITTLE_ENDIAN_P(void) { #endif // Check if we support this system's floating point implementation #if FLT_RADIX != 2 || FLT_MANT_DIG != 24 || DBL_MANT_DIG != 53 \ - || FLT_MAX_EXP != 128 || DBL_MAX_EXP != 1024 + || FLT_MAX_EXP != 128 || DBL_MAX_EXP != 1024 || !defined(INFINITY) # error "Floating point implementation not supported." #endif typedef float lisp_float32_t; typedef double lisp_float64_t; +#define FLOAT32_MAX_PRECISION 6 +#define FLOAT64_MAX_PRECISION 15 static ALWAYS_INLINE uint32_t FLOAT32_TO_INT_BITS(lisp_float32_t flt) { union { @@ -99,140 +101,20 @@ static ALWAYS_INLINE lisp_float64_t INT_TO_FLOAT64_BITS(uint64_t i) { uint32_t: INT_TO_FLOAT32_BITS(i), \ uint64_t: INT_TO_FLOAT64_BITS(i)) -#define FLOAT_POSITIVE 0 -#define FLOAT_NEGATIVE 1 -typedef struct -#if __has_attribute(packed) - __attribute__((packed)) -#endif -{ - uint32_t sign : 1; - int32_t exp : 8; - uint32_t mantissa : 23; -} lisp_float32_parts; -#define FLOAT32_MIN_EXP -127 -#define FLOAT32_MAX_EXP 127 -#define FLOAT32_MAX_PRECISION 6 -#define FLOAT32_MAX_MANTISSA 0x7fffff - -typedef struct -#if __has_attribute(packed) - __attribute__((packed)) -#endif -{ - uint64_t sign : 1; - int64_t exp : 11; - uint64_t mantissa : 52; -} lisp_float64_parts; -#define FLOAT64_MIN_EXP -1023 -#define FLOAT64_MAX_EXP 1023 -#define FLOAT64_MAX_PRECISION 15 -#define FLOAT64_MAX_MANTISSA 0xfffffffffffff - -static ALWAYS_INLINE lisp_float32_parts FLOAT32_TO_PARTS(lisp_float32_t flt) { -#if __has_attribute(packed) - union { - lisp_float32_parts parts; - lisp_float32_t flt_val; - } conv = {.flt_val = flt}; - conv.parts.exp -= 127; - return conv.parts; -#else - uint32_t bits = FLOAT_TO_INT_BITS(flt); - return (lisp_float32_parts) { - .sign = bits >> 31, - .exp = (bits >> 23) - 127, - .mantissa = bits & 0x7fffff, - }; -#endif -} - -static ALWAYS_INLINE lisp_float64_parts FLOAT64_TO_PARTS(lisp_float64_t flt) { -#if __has_attribute(packed) - union { - lisp_float64_parts parts; - lisp_float64_t flt_val; - } conv = {.flt_val = flt}; - conv.parts.exp -= 1023; - return conv.parts; -#else - uint64_t bits = FLOAT_TO_INT_BITS(flt); - return (lisp_float64_parts) { - .sign = bits >> 63, - .exp = (bits >> 52) - 1023, - .mantissa = bits & 0xfffffffffffff, - }; -#endif -} - -#define FLOAT_TO_PARTS(flt) \ - _Generic((flt), \ - lisp_float32_t: FLOAT32_TO_PARTS(flt), \ - lisp_float64_t: FLOAT64_TO_PARTS(flt)) - -static ALWAYS_INLINE lisp_float64_t PARTS_TO_FLOAT64(lisp_float64_parts parts) { -#if __has_attribute(packed) - parts.exp += 1023; - union { - lisp_float64_parts parts; - lisp_float64_t flt_val; - } conv = {.parts = parts}; - return conv.flt_val; -#else - return INT_TO_FLOAT64_BITS(parts.sign << 63 | (parts.exp + 1023) << 52 - | parts.mantissa); -#endif -} - -static ALWAYS_INLINE lisp_float32_t PARTS_TO_FLOAT32(lisp_float32_parts parts) { -#if __has_attribute(packed) - parts.exp += 127; - union { - lisp_float32_parts parts; - lisp_float32_t flt_val; - } conv = {.parts = parts}; - return conv.flt_val; -#else - return INT_TO_FLOAT32_BITS(parts.sign << 31 | (parts.exp + 127) << 23 - | parts.mantissa); -#endif -} - -#define PARTS_TO_FLOAT(parts) \ - _Generic((parts), \ - lisp_float32_parts: PARTS_TO_FLOAT32(parts), \ - lisp_float64_parts: PARTS_TO_FLOAT64(parts)) - static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_NAN(void) { - return PARTS_TO_FLOAT32((lisp_float32_parts) { - .sign = FLOAT_POSITIVE, - .exp = FLOAT32_MAX_EXP, - .mantissa = FLOAT32_MAX_MANTISSA, - }); + return INT_TO_FLOAT32_BITS(~(uint32_t) 0); } -static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_INF(bool negative) { - return PARTS_TO_FLOAT32((lisp_float32_parts) { - .sign = negative ? FLOAT_NEGATIVE : FLOAT_POSITIVE, - .exp = FLOAT32_MAX_EXP, - .mantissa = 0, - }); +static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_INF(void) { + return INFINITY; } static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_NAN(void) { - return PARTS_TO_FLOAT64((lisp_float64_parts) { - .sign = FLOAT_POSITIVE, - .exp = FLOAT64_MAX_EXP, - .mantissa = FLOAT64_MAX_MANTISSA, - }); + return INT_TO_FLOAT64_BITS(~(uint64_t) 0); } -static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(bool negative) { - return PARTS_TO_FLOAT64((lisp_float64_parts) { - .sign = negative ? FLOAT_NEGATIVE : FLOAT_POSITIVE, - .exp = FLOAT64_MAX_EXP, - .mantissa = 0, - }); +static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(void) { + return INFINITY; } // Allocator diff --git a/src/print.c b/src/print.c index c088ede..6e37ffa 100644 --- a/src/print.c +++ b/src/print.c @@ -3,6 +3,7 @@ #include "lisp.h" #include +#include DEFVAR(print_circular, "print-circular", "", Qt); DEFVAR(print_length, "print-length", "", MAKE_FIXNUM(100)); @@ -172,12 +173,23 @@ static void print_float(struct PrintContext *restrict pc, LispVal *val) { case FP_NORMAL: { char fmt[16]; int written = - snprintf(fmt, sizeof(fmt), "%%%" LISP_FIXNUM_PRINTF(d) "g", + snprintf(fmt, sizeof(fmt), "%%.%" LISP_FIXNUM_PRINTF(d) "g", pc->opts.precision); assert(written < sizeof(fmt)); char buffer[32]; - written = snprintf(buffer, sizeof(buffer), fmt, buffer); + written = snprintf(buffer, sizeof(buffer), fmt, fv); assert(written < sizeof(buffer)); + size_t i; + for (i = 0; i < written && buffer[i] != 'e'; ++i) { + if (buffer[i] == '.') { + goto no_add; + } + } + memmove(buffer + i + 2, buffer + i, written - i); + buffer[i] = '.'; + buffer[i + 1] = '0'; + written += 2; + no_add: print_buffer(pc, buffer, written); } break; default: