diff --git a/config.h b/config.h index 4b254b17..84ee7941 100644 --- a/config.h +++ b/config.h @@ -14,6 +14,9 @@ /* uncomment this if you only want fixnum support */ /* #define USE_FLONUMS 0 */ +/* uncomment this if you want immediate flonums */ +#define USE_IMMEDIATE_FLONUMS 1 + /* uncomment this if you don't need extended math operations */ /* #define USE_MATH 0 */ diff --git a/debug.c b/debug.c index cd329db9..8a03a8a8 100644 --- a/debug.c +++ b/debug.c @@ -62,6 +62,7 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { return SEXP_VOID; } +#ifdef DEBUG_VM static void sexp_print_stack (sexp *stack, int top, int fp, sexp out) { int i; for (i=0; i SEXP_CONTEXT)) - return sexp_align(1, 4); + return sexp_heap_align(1); t = &(sexp_types[sexp_pointer_tag(x)]); len_ptr = (sexp_uint_t*) (((char*)x) + sexp_type_size_off(t)); res = sexp_type_size_base(t) + len_ptr[0] * sexp_type_size_scale(t); @@ -83,7 +83,7 @@ sexp sexp_sweep (sexp ctx) { char *end; /* scan over the whole heap */ for ( ; h; h=h->next) { - p = (sexp) (h->data + sexp_align(sexp_sizeof(pair), 4)); + p = (sexp) (h->data + sexp_heap_align(sexp_sizeof(pair))); q = h->free_list; end = (char*)h->data + h->size; while (((char*)p) < end) { @@ -94,7 +94,7 @@ sexp sexp_sweep (sexp ctx) { p = (sexp) (((char*)p) + (sexp_uint_t)sexp_car(p)); continue; } - size = sexp_align(sexp_allocated_bytes(p), 4); + size = sexp_heap_align(sexp_allocated_bytes(p)); if ((! sexp_gc_mark(p)) && (! stack_references_pointer_p(ctx, p))) { sum_freed += size; if (((((char*)q)+(sexp_uint_t)sexp_car(q)) == (char*)p) @@ -153,15 +153,15 @@ sexp_heap sexp_make_heap (size_t size) { sexp_heap h = (sexp_heap) malloc(sizeof(struct sexp_heap) + size); if (h) { h->size = size; - h->data = (char*) sexp_align((sexp_uint_t)&(h->data), 4); + h->data = (char*) sexp_heap_align((sexp_uint_t)&(h->data)); free = h->free_list = (sexp) h->data; h->next = NULL; - next = (sexp) ((char*)free + sexp_align(sexp_sizeof(pair), 4)); + next = (sexp) ((char*)free + sexp_heap_align(sexp_sizeof(pair))); sexp_pointer_tag(free) = SEXP_PAIR; sexp_car(free) = 0; /* actually sexp_sizeof(pair) */ sexp_cdr(free) = next; sexp_pointer_tag(next) = SEXP_PAIR; - sexp_car(next) = (sexp) (size - sexp_align(sexp_sizeof(pair), 4)); + sexp_car(next) = (sexp) (size - sexp_heap_align(sexp_sizeof(pair))); sexp_cdr(next) = SEXP_NULL; } return h; @@ -171,7 +171,7 @@ int sexp_grow_heap (sexp ctx, size_t size) { size_t cur_size, new_size; sexp_heap h = sexp_heap_last(heap); cur_size = h->size; - new_size = sexp_align(((cur_size > size) ? cur_size : size) * 2, 4); + new_size = sexp_heap_align(((cur_size > size) ? cur_size : size) * 2); h->next = sexp_make_heap(new_size); return (h->next != NULL); } @@ -207,7 +207,7 @@ void* sexp_alloc (sexp ctx, size_t size) { void *res; size_t freed; sexp_heap h; - size = sexp_align(size, 4); + size = sexp_heap_align(size); res = sexp_try_alloc(ctx, size); if (! res) { freed = sexp_unbox_integer(sexp_gc(ctx)); @@ -226,7 +226,7 @@ void* sexp_alloc (sexp ctx, size_t size) { } void sexp_gc_init () { - sexp_uint_t size = sexp_align(SEXP_INITIAL_HEAP_SIZE, 4); + sexp_uint_t size = sexp_heap_align(SEXP_INITIAL_HEAP_SIZE); heap = sexp_make_heap(size); /* the +32 is a hack, but this is just for debugging anyway */ stack_base = ((sexp*)&size) + 32; diff --git a/sexp.c b/sexp.c index 87bf0e6b..69516f5f 100644 --- a/sexp.c +++ b/sexp.c @@ -5,7 +5,7 @@ #include "sexp.h" /* optional huffman-compressed immediate symbols */ -#ifdef USE_HUFF_SYMS +#if USE_HUFF_SYMS struct huff_entry { unsigned char len; unsigned short bits; @@ -326,6 +326,15 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) { loop: if (a == b) return SEXP_TRUE; +#if USE_IMMEDIATE_FLONUMS + if ((! sexp_pointerp(a)) || (! sexp_pointerp(b))) + return + sexp_make_boolean((a == b) + || (sexp_flonump(a) + && sexp_make_integer(sexp_flonum_value(a)) == b) + || (sexp_flonump(b) + && sexp_make_integer(sexp_flonum_value(b)) == a)); +#else if (! sexp_pointerp(a)) return sexp_make_boolean(sexp_integerp(a) && sexp_pointerp(b) && (sexp_unbox_integer(a) @@ -334,6 +343,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) { return sexp_make_boolean(sexp_integerp(b) && sexp_pointerp(a) && (sexp_unbox_integer(b) == sexp_flonum_value(a))); +#endif if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) return SEXP_FALSE; switch (sexp_pointer_tag(a)) { @@ -358,8 +368,10 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) { && (! strncmp(sexp_string_data(a), sexp_string_data(b), sexp_string_length(a)))); +#if ! USE_IMMEDIATE_FLONUMS case SEXP_FLONUM: return sexp_make_boolean(sexp_flonum_value(a) == sexp_flonum_value(b)); +#endif default: return SEXP_FALSE; } @@ -367,11 +379,13 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) { /********************* strings, symbols, vectors **********************/ +#if ! USE_IMMEDIATE_FLONUMS sexp sexp_make_flonum(sexp ctx, double f) { sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM); sexp_flonum_value(x) = f; return x; } +#endif sexp sexp_make_string(sexp ctx, sexp len, sexp ch) { sexp_sint_t clen = sexp_unbox_integer(len); @@ -780,6 +794,11 @@ void sexp_write (sexp obj, sexp out) { } } else if (sexp_integerp(obj)) { sexp_printf(out, "%ld", sexp_unbox_integer(obj)); +#if USE_IMMEDIATE_FLONUMS + } else if (sexp_flonump(obj)) { + f = sexp_flonum_value(obj); + sexp_printf(out, "%.15g%s", f, (f == trunc(f)) ? ".0" : ""); +#endif } else if (sexp_charp(obj)) { if (obj == sexp_make_character(' ')) sexp_write_string("#\\space", out); @@ -933,7 +952,12 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) { if ((c!='.') && (sexp_flonum_value(f) == round(sexp_flonum_value(f)))) { res = (sexp_sint_t) sexp_flonum_value(f); } else { - if (negativep) sexp_flonum_value(f) = -sexp_flonum_value(f); + if (negativep) +#if USE_IMMEDIATE_FLONUMS + f = sexp_make_flonum(ctx, -sexp_flonum_value(f)); +#else + sexp_flonum_value(f) = -sexp_flonum_value(f); +#endif return f; } } else { @@ -1146,9 +1170,13 @@ sexp sexp_read_raw (sexp ctx, sexp in) { sexp_push_char(c2, in); res = sexp_read_number(ctx, in, 10); if ((c1 == '-') && ! sexp_exceptionp(res)) { -#ifdef USE_FLONUMS +#if USE_FLONUMS if (sexp_flonump(res)) +#if USE_IMMEDIATE_FLONUMS + res = sexp_make_flonum(ctx, -1 * sexp_flonum_value(res)); +#else sexp_flonum_value(res) = -1 * sexp_flonum_value(res); +#endif else #endif res = sexp_fx_mul(res, -1); diff --git a/sexp.h b/sexp.h index f713e0bd..4e3dd368 100644 --- a/sexp.h +++ b/sexp.h @@ -21,8 +21,8 @@ /* tagging system * bits end in 00: pointer * 01: fixnum - * 011: - * 111: immediate symbol + * 011: immediate flonum (optional) + * 111: immediate symbol (optional) * 0110: char * 1110: other immediate object (NULL, TRUE, FALSE) */ @@ -38,6 +38,7 @@ #define SEXP_POINTER_TAG 0 #define SEXP_FIXNUM_TAG 1 #define SEXP_ISYMBOL_TAG 7 +#define SEXP_IFLONUM_TAG 3 #define SEXP_CHAR_TAG 6 #define SEXP_EXTENDED_TAG 14 @@ -256,6 +257,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size); #endif #define sexp_align(n, bits) (((n)+(1<<(bits))-1)&(((sexp_uint_t)-1)-((1<<(bits))-1))) +#define sexp_heap_align(n) sexp_align(n, 4) #define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \ + sizeof(((sexp)0)->value.x)) @@ -280,12 +282,25 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size); #define sexp_check_tag(x,t) (sexp_pointerp(x) && (sexp_pointer_tag(x) == (t))) +#if USE_IMMEDIATE_FLONUMS +union sexp_flonum_conv { + float flonum; + sexp_uint_t bits; +}; +#define sexp_flonump(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_IFLONUM_TAG) +#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) +#else +#define sexp_flonump(x) (sexp_check_tag(x, SEXP_FLONUM)) +#define sexp_flonum_value(f) ((f)->value.flonum) +sexp sexp_make_flonum(sexp ctx, double f); +#endif + #define sexp_typep(x) (sexp_check_tag(x, SEXP_TYPE)) #define sexp_pairp(x) (sexp_check_tag(x, SEXP_PAIR)) #define sexp_stringp(x) (sexp_check_tag(x, SEXP_STRING)) #define sexp_lsymbolp(x) (sexp_check_tag(x, SEXP_SYMBOL)) #define sexp_vectorp(x) (sexp_check_tag(x, SEXP_VECTOR)) -#define sexp_flonump(x) (sexp_check_tag(x, SEXP_FLONUM)) #define sexp_iportp(x) (sexp_check_tag(x, SEXP_IPORT)) #define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT)) #define sexp_exceptionp(x) (sexp_check_tag(x, SEXP_EXCEPTION)) @@ -319,8 +334,6 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size); #define sexp_make_character(n) ((sexp) ((((sexp_sint_t)n)<>SEXP_EXTENDED_BITS)) -#define sexp_flonum_value(f) ((f)->value.flonum) - #if USE_FLONUMS #define sexp_integer_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_integer(x))) #else @@ -515,7 +528,6 @@ sexp sexp_length(sexp ctx, sexp ls); sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen); sexp sexp_make_string(sexp ctx, sexp len, sexp ch); sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end); -sexp sexp_make_flonum(sexp ctx, double f); sexp sexp_intern(sexp ctx, char *str); sexp sexp_string_to_symbol(sexp ctx, sexp str); sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);