diff --git a/basis/math/floats/half/half-tests.factor b/basis/math/floats/half/half-tests.factor index c1ab238f5e..41371278eb 100644 --- a/basis/math/floats/half/half-tests.factor +++ b/basis/math/floats/half/half-tests.factor @@ -1,5 +1,6 @@ -USING: accessors alien.c-types alien.syntax math.floats.half kernel -math tools.test specialized-arrays alien.data classes.struct ; +USING: accessors alien.c-types alien.data classes.struct kernel +math math.floats.half math.order sequences specialized-arrays +tools.test ; SPECIALIZED-ARRAY: half IN: math.floats.half.tests @@ -46,3 +47,12 @@ STRUCT: halves { half-array{ 1.0 2.0 3.0 1/0. -1/0. } } [ { 1.0 2.0 3.0 1/0. -1/0. } half >c-array ] unit-test + +{ 0x1.0p-24 } [ 1 bits>half ] unit-test + +{ t } [ + 65536 + [ 0x7c01 0x7dff between? ] reject + [ 0xfc01 0xfdff between? ] reject + [ dup bits>half half>bits = ] all? +] unit-test diff --git a/basis/math/floats/half/half.factor b/basis/math/floats/half/half.factor index bcb37879d2..35fd7adbf8 100644 --- a/basis/math/floats/half/half.factor +++ b/basis/math/floats/half/half.factor @@ -1,30 +1,35 @@ ! Copyright (C) 2009 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.accessors alien.c-types alien.data -alien.syntax kernel math math.order ; +USING: accessors alien.accessors alien.c-types combinators +kernel math ; FROM: math => float ; IN: math.floats.half : half>bits ( float -- bits ) float>bits - [ -31 shift 15 shift ] [ - 0x7fffffff bitand - dup zero? [ - dup 0x7f800000 >= [ -13 shift 0x7fff bitand ] [ - -13 shift - 112 10 shift - - 0 0x7c00 clamp - ] if - ] unless - ] bi bitor ; + [ -16 shift 0x8000 bitand ] keep + [ 0x7fffff bitand ] keep + -23 shift 0xff bitand 127 - { + { [ dup -24 < ] [ 2drop 0 ] } + { [ dup -14 < ] [ [ 1 + shift ] [ 24 + 2^ ] bi bitor ] } + { [ dup 15 <= ] [ [ -13 shift ] [ 15 + 10 shift ] bi* bitor ] } + { [ dup 128 < ] [ 2drop 0x7c00 ] } + [ drop -13 shift 0x7c00 bitor ] + } cond bitor ; : bits>half ( bits -- float ) [ -15 shift 31 shift ] [ 0x7fff bitand dup zero? [ dup 0x7c00 >= [ 13 shift 0x7f800000 bitor ] [ - 13 shift - 112 23 shift + + dup 0x0400 < [ + dup log2 + [ nip 103 + 23 shift ] + [ 23 swap - shift 0x7fffff bitand ] 2bi bitor + ] [ + 13 shift + 112 23 shift + + ] if ] if ] unless ] bi bitor bits>float ;