Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finish float printing

Browse Source
This commit is contained in:
Zander671
2026-08-13 03:51:55 -07:00
parent 7b854c1559
commit 20aed63851
4 changed files with 31 additions and 145 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/kernel.gl
+2 -2
View File
@@ -1,4 +1,4 @@
;; -*- mode: lisp-data -*- ;; -*- mode: lisp-data -*-
(prin1 1.0) (prin1 1.0e2)
(write-byte 10) (write-byte ?\n)
src/base.h
+6 -14
View File
@@ -23,24 +23,16 @@ typedef intptr_t fixnum_t;
# define LISP_FLOAT_SCANF "f" # define LISP_FLOAT_SCANF "f"
# define LISP_FLOAT_PRINTF "f" # define LISP_FLOAT_PRINTF "f"
typedef lisp_float32_t lisp_float_t; 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_NAN LISP_FLOAT32_NAN()
# define LISP_FLOAT_POS_INF LISP_FLOAT32_INF(false) # define LISP_FLOAT_INF LISP_FLOAT32_INF()
# define LISP_FLOAT_NEG_INF LISP_FLOAT32_INF(true) # define LISP_FLOAT_MAX_PRECISION FLOAT32_MAX_PRECISION
#else #else
# define LISP_FLOAT_SCANF "lf" # define LISP_FLOAT_SCANF "lf"
# define LISP_FLOAT_PRINTF "f" # define LISP_FLOAT_PRINTF "f"
typedef lisp_float64_t lisp_float_t; 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_NAN LISP_FLOAT64_NAN()
# define LISP_FLOAT_POS_INF LISP_FLOAT64_INF(false) # define LISP_FLOAT_INF LISP_FLOAT64_INF()
# define LISP_FLOAT_NEG_INF LISP_FLOAT64_INF(true) # define LISP_FLOAT_MAX_PRECISION FLOAT64_MAX_PRECISION
#endif #endif
#define MOST_POSITIVE_FIXNUM ((intptr_t) ((INTPTR_MAX & ~(intptr_t) 3) >> 2)) #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_NAN MAKE_LISP_FLOAT(LISP_FLOAT_NAN)
#define LISP_POS_INF MAKE_LISP_FLOAT(LISP_FLOAT_POS_INF) #define LISP_POS_INF MAKE_LISP_FLOAT(LISP_FLOAT_INF)
#define LISP_NEG_INF MAKE_LISP_FLOAT(LISP_FLOAT_NEG_INF) #define LISP_NEG_INF MAKE_LISP_FLOAT(-LISP_FLOAT_INF)
// ############### // ###############
// # Other types # // # Other types #
src/memory.h
+9 -127
View File
@@ -51,11 +51,13 @@ static ALWAYS_INLINE bool LITTLE_ENDIAN_P(void) {
#endif #endif
// Check if we support this system's floating point implementation // Check if we support this system's floating point implementation
#if FLT_RADIX != 2 || FLT_MANT_DIG != 24 || DBL_MANT_DIG != 53 \ #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." # error "Floating point implementation not supported."
#endif #endif
typedef float lisp_float32_t; typedef float lisp_float32_t;
typedef double lisp_float64_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) { static ALWAYS_INLINE uint32_t FLOAT32_TO_INT_BITS(lisp_float32_t flt) {
union { 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), \ uint32_t: INT_TO_FLOAT32_BITS(i), \
uint64_t: INT_TO_FLOAT64_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) { static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_NAN(void) {
return PARTS_TO_FLOAT32((lisp_float32_parts) { return INT_TO_FLOAT32_BITS(~(uint32_t) 0);
.sign = FLOAT_POSITIVE,
.exp = FLOAT32_MAX_EXP,
.mantissa = FLOAT32_MAX_MANTISSA,
});
} }
static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_INF(bool negative) { static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_INF(void) {
return PARTS_TO_FLOAT32((lisp_float32_parts) { return INFINITY;
.sign = negative ? FLOAT_NEGATIVE : FLOAT_POSITIVE,
.exp = FLOAT32_MAX_EXP,
.mantissa = 0,
});
} }
static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_NAN(void) { static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_NAN(void) {
return PARTS_TO_FLOAT64((lisp_float64_parts) { return INT_TO_FLOAT64_BITS(~(uint64_t) 0);
.sign = FLOAT_POSITIVE,
.exp = FLOAT64_MAX_EXP,
.mantissa = FLOAT64_MAX_MANTISSA,
});
} }
static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(bool negative) { static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(void) {
return PARTS_TO_FLOAT64((lisp_float64_parts) { return INFINITY;
.sign = negative ? FLOAT_NEGATIVE : FLOAT_POSITIVE,
.exp = FLOAT64_MAX_EXP,
.mantissa = 0,
});
} }
// Allocator // Allocator
src/print.c
+14 -2
View File
@@ -3,6 +3,7 @@
#include "lisp.h" #include "lisp.h"
#include <limits.h> #include <limits.h>
#include <string.h>
DEFVAR(print_circular, "print-circular", "", Qt); DEFVAR(print_circular, "print-circular", "", Qt);
DEFVAR(print_length, "print-length", "", MAKE_FIXNUM(100)); 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: { case FP_NORMAL: {
char fmt[16]; char fmt[16];
int written = int written =
snprintf(fmt, sizeof(fmt), "%%%" LISP_FIXNUM_PRINTF(d) "g", snprintf(fmt, sizeof(fmt), "%%.%" LISP_FIXNUM_PRINTF(d) "g",
pc->opts.precision); pc->opts.precision);
assert(written < sizeof(fmt)); assert(written < sizeof(fmt));
char buffer[32]; char buffer[32];
written = snprintf(buffer, sizeof(buffer), fmt, buffer); written = snprintf(buffer, sizeof(buffer), fmt, fv);
assert(written < sizeof(buffer)); 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); print_buffer(pc, buffer, written);
} break; } break;
default: default: