From 2b01d17888b36961f2c237766750c22930d45129 Mon Sep 17 00:00:00 2001 From: "Arthur A. Gleckler" Date: Wed, 1 Sep 2010 22:23:39 -0700 Subject: [PATCH] * Renamed `cast-flonum-to-integer' to `cast-ieee754-double-to-integer'. * Renamed `cast-integer-to-flonum' to `cast-integer-to-ieee754-double'. * Changed both to use instead of for conversion. That way, they should work on 32-bit systems. (Thanks to Taylor for pointing out that bug.) * Added `cast-ieee754-single-to-integer' and `cast-integer-to-ieee754-single'. * Updated existing tests. * Added tests for casts to and from single-precision floating-point numbers. --- src/microcode/flonum.c | 54 ++++++++++--- tests/microcode/test-flonum-casts.scm | 111 +++++++++++++++++++------- 2 files changed, 125 insertions(+), 40 deletions(-) diff --git a/src/microcode/flonum.c b/src/microcode/flonum.c index b18726715..c72252af9 100644 --- a/src/microcode/flonum.c +++ b/src/microcode/flonum.c @@ -260,34 +260,70 @@ DEFINE_PRIMITIVE ("FLONUM-DENORMALIZE", Prim_flonum_denormalize, 2, 2, 0) CHECK_ARG (2, INTEGER_P); PRIMITIVE_RETURN (flonum_denormalize ((ARG_REF (1)), (ARG_REF (2)))); } - + +/* These conversion primitives don't require IEEE 754, but they do + * make assumptions about the sizes of doubles and floats. If we want + * to support using these primitives with non-IEEE 754 floating-point + * numbers, we may have to adjust them. + */ typedef union { double dbl; - unsigned long ul; -} double_unsigned_long_cast; + uint64_t u64; +} double_uint64_t_cast; -DEFINE_PRIMITIVE ("CAST-FLONUM-TO-INTEGER", Prim_cast_flonum_to_integer, 1, 1, 0) +DEFINE_PRIMITIVE ("CAST-IEEE754-DOUBLE-TO-INTEGER", Prim_cast_ieee754_double_to_integer, 1, 1, 0) { PRIMITIVE_HEADER (1); CHECK_ARG (1, FLONUM_P); - double_unsigned_long_cast cast; + double_uint64_t_cast cast; cast.dbl = FLONUM_TO_DOUBLE (ARG_REF (1)); - PRIMITIVE_RETURN (ulong_to_integer (cast.ul)); + PRIMITIVE_RETURN (uintmax_to_integer (cast.u64)); } -DEFINE_PRIMITIVE ("CAST-INTEGER-TO-FLONUM", Prim_cast_integer_to_flonum, 1, 1, 0) +DEFINE_PRIMITIVE ("CAST-INTEGER-TO-IEEE754-DOUBLE", Prim_cast_integer_to_ieee754_double, 1, 1, 0) { PRIMITIVE_HEADER (1); CHECK_ARG (1, INTEGER_P); - double_unsigned_long_cast cast; + double_uint64_t_cast cast; - cast.ul = integer_to_long (ARG_REF (1)); + cast.u64 = integer_to_uintmax (ARG_REF (1)); PRIMITIVE_RETURN (double_to_flonum (cast.dbl)); } + +typedef +union +{ + float f; + uint32_t u32; +} float_uint32_t_cast; + +DEFINE_PRIMITIVE ("CAST-IEEE754-SINGLE-TO-INTEGER", Prim_cast_ieee754_single_to_integer, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + CHECK_ARG (1, FLONUM_P); + + float_uint32_t_cast cast; + + cast.f = (float) FLONUM_TO_DOUBLE (ARG_REF (1)); + + PRIMITIVE_RETURN (uintmax_to_integer (cast.u32)); +} + +DEFINE_PRIMITIVE ("CAST-INTEGER-TO-IEEE754-SINGLE", Prim_cast_integer_to_ieee754_single, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + CHECK_ARG (1, INTEGER_P); + + float_uint32_t_cast cast; + + cast.u32 = integer_to_uintmax (ARG_REF (1)); + + PRIMITIVE_RETURN (double_to_flonum ((double) cast.f)); +} diff --git a/tests/microcode/test-flonum-casts.scm b/tests/microcode/test-flonum-casts.scm index 48b7a6418..31e7162b7 100644 --- a/tests/microcode/test-flonum-casts.scm +++ b/tests/microcode/test-flonum-casts.scm @@ -27,54 +27,103 @@ USA. (declare (usual-integrations)) -(define-test 'test-casting - (lambda () +(define (factorial n) + (if (< n 2) + 1 + (* n (factorial (- n 1))))) - (define cast-flonum-to-integer - (make-primitive-procedure 'cast-flonum-to-integer)) +(define ((make-cast-tester cast-to-integer cast-to-flonum size-in-bits) + flonum + integer-as-bit-string) + (assert-equal + (unsigned-integer->bit-string size-in-bits (cast-to-integer flonum)) + integer-as-bit-string) + (assert-equal + flonum + (cast-to-flonum integer-as-bit-string))) - (define cast-integer-to-flonum - (make-primitive-procedure 'cast-integer-to-flonum)) +(define-test 'test-casting-doubles + (lambda () + (define cast-ieee754-double-to-integer + (make-primitive-procedure 'cast-ieee754-double-to-integer)) - (define (itof integer-as-bit-string) - (cast-integer-to-flonum - (bit-string->unsigned-integer integer-as-bit-string))) + (define cast-integer-to-ieee754-double + (make-primitive-procedure 'cast-integer-to-ieee754-double)) - (define (factorial n) - (if (< n 2) - 1 - (* n (factorial (- n 1))))) + (define (integer-to-double integer-as-bit-string) + (cast-integer-to-ieee754-double + (bit-string->unsigned-integer integer-as-bit-string))) - (define (test flonum integer-as-bit-string) - (assert-equal - (unsigned-integer->bit-string 64 (cast-flonum-to-integer flonum)) - integer-as-bit-string) - (assert-equal - flonum - (itof integer-as-bit-string))) + (define test-double + (make-cast-tester cast-ieee754-double-to-integer + integer-to-double + 64)) - (test 0.0 + (test-double 0.0 #*0000000000000000000000000000000000000000000000000000000000000000) - (test -0.0 + (test-double -0.0 #*1000000000000000000000000000000000000000000000000000000000000000) - (test 1.0 + (test-double 1.0 #*0011111111110000000000000000000000000000000000000000000000000000) - (test 2.0 + (test-double 2.0 #*0100000000000000000000000000000000000000000000000000000000000000) - (test 4.0 + (test-double 4.0 #*0100000000010000000000000000000000000000000000000000000000000000) - (test 8.0 + (test-double 8.0 #*0100000000100000000000000000000000000000000000000000000000000000) - (test (->flonum (factorial 100)) + (test-double (->flonum (factorial 100)) #*0110000010111011001100001001011001001110110000111001010111011100) - (test -1.0 + (test-double -1.0 #*1011111111110000000000000000000000000000000000000000000000000000) (assert-true (flo:nan? - (itof + (integer-to-double #*0111111111110000000000000000000000000000000000000000000000000001))) (assert-true (flo:nan? - (itof - #*0111111111111111111111111111111111111111111111111111111111111111))))) \ No newline at end of file + (integer-to-double + #*0111111111111111111111111111111111111111111111111111111111111111))))) + +(define-test 'test-casting-singles + (lambda () + (define cast-ieee754-single-to-integer + (make-primitive-procedure 'cast-ieee754-single-to-integer)) + + (define cast-integer-to-ieee754-single + (make-primitive-procedure 'cast-integer-to-ieee754-single)) + + (define (integer-to-single integer-as-bit-string) + (cast-integer-to-ieee754-single + (bit-string->unsigned-integer integer-as-bit-string))) + + (define test-single + (make-cast-tester cast-ieee754-single-to-integer + integer-to-single + 32)) + + (test-single 0.0 + #*00000000000000000000000000000000) + (test-single -0.0 + #*10000000000000000000000000000000) + (test-single 1.0 + #*00111111100000000000000000000000) + (test-single 2.0 + #*01000000000000000000000000000000) + (test-single 4.0 + #*01000000100000000000000000000000) + (test-single 8.0 + #*01000001000000000000000000000000) + (test-single (->flonum (factorial 10)) + #*01001010010111010111110000000000) + (test-single -1.0 + #*10111111100000000000000000000000) + + (assert-true + (flo:nan? + (integer-to-single + #*01111111100000000000000000000001))) + (assert-true + (flo:nan? + (integer-to-single + #*01111111111111111111111111111111))))) \ No newline at end of file -- 2.25.1