diff --git a/extra/half-floats/authors.txt b/extra/half-floats/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/half-floats/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor new file mode 100644 index 0000000000..15ad53d611 --- /dev/null +++ b/extra/half-floats/half-floats-tests.factor @@ -0,0 +1,46 @@ +USING: alien.c-types alien.syntax half-floats kernel tools.test ; +IN: half-floats.tests + +[ HEX: 0000 ] [ 0.0 half>bits ] unit-test +[ HEX: 8000 ] [ -0.0 half>bits ] unit-test +[ HEX: 3e00 ] [ 1.5 half>bits ] unit-test +[ HEX: be00 ] [ -1.5 half>bits ] unit-test +[ HEX: 7c00 ] [ 1/0. half>bits ] unit-test +[ HEX: fc00 ] [ -1/0. half>bits ] unit-test +[ HEX: fe00 ] [ 0/0. half>bits ] unit-test + +! too-big floats overflow to infinity +[ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test +[ HEX: fc00 ] [ -65536.0 half>bits ] unit-test +[ HEX: 7c00 ] [ 131072.0 half>bits ] unit-test +[ HEX: fc00 ] [ -131072.0 half>bits ] unit-test + +! too-small floats flush to zero +[ HEX: 0000 ] [ 1.0e-9 half>bits ] unit-test +[ HEX: 8000 ] [ -1.0e-9 half>bits ] unit-test + +[ 0.0 ] [ HEX: 0000 bits>half ] unit-test +[ -0.0 ] [ HEX: 8000 bits>half ] unit-test +[ 1.5 ] [ HEX: 3e00 bits>half ] unit-test +[ -1.5 ] [ HEX: be00 bits>half ] unit-test +[ 1/0. ] [ HEX: 7c00 bits>half ] unit-test +[ -1/0. ] [ HEX: fc00 bits>half ] unit-test +[ 0/0. ] [ HEX: 7e00 bits>half ] unit-test + +C-STRUCT: halves + { "half" "tom" } + { "half" "dick" } + { "half" "harry" } + { "half" "harry-jr" } ; + +[ 8 ] [ "halves" heap-size ] unit-test + +[ 3.0 ] [ + "halves" + 3.0 over set-halves-dick + halves-dick +] unit-test + +[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ] +[ { 1.0 2.0 3.0 1/0. -1/0. } >half-array ] unit-test + diff --git a/extra/half-floats/half-floats.factor b/extra/half-floats/half-floats.factor new file mode 100644 index 0000000000..53f6c6cfb1 --- /dev/null +++ b/extra/half-floats/half-floats.factor @@ -0,0 +1,42 @@ +! (c)2009 Joe Groff bsd license +USING: accessors alien.c-types alien.syntax kernel math math.order +specialized-arrays.direct.functor specialized-arrays.functor ; +IN: half-floats + +: half>bits ( float -- bits ) + float>bits + [ -31 shift 15 shift ] [ + HEX: 7fffffff bitand + dup zero? [ + dup HEX: 7f800000 >= [ -13 shift HEX: 7fff bitand ] [ + -13 shift + 112 10 shift - + 0 HEX: 7c00 clamp + ] if + ] unless + ] bi bitor ; + +: bits>half ( bits -- float ) + [ -15 shift 31 shift ] [ + HEX: 7fff bitand + dup zero? [ + dup HEX: 7c00 >= [ 13 shift HEX: 7f800000 bitor ] [ + 13 shift + 112 23 shift + + ] if + ] unless + ] bi bitor bits>float ; + +C-STRUCT: half { "ushort" "(bits)" } ; + +<< + +"half" c-type + [ half>bits ] >>unboxer-quot + [ *ushort bits>half ] >>boxer-quot + drop + +"half" define-array +"half" define-direct-array + +>> diff --git a/extra/half-floats/summary.txt b/extra/half-floats/summary.txt new file mode 100644 index 0000000000..b22448f69b --- /dev/null +++ b/extra/half-floats/summary.txt @@ -0,0 +1 @@ +Half-precision float support for FFI