]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorJoe Groff <arcata@gmail.com>
Wed, 10 Jun 2009 18:06:44 +0000 (13:06 -0500)
committerJoe Groff <arcata@gmail.com>
Wed, 10 Jun 2009 18:06:44 +0000 (13:06 -0500)
extra/half-floats/authors.txt [new file with mode: 0644]
extra/half-floats/half-floats-tests.factor [new file with mode: 0644]
extra/half-floats/half-floats.factor [new file with mode: 0644]
extra/half-floats/summary.txt [new file with mode: 0644]

diff --git a/extra/half-floats/authors.txt b/extra/half-floats/authors.txt
new file mode 100644 (file)
index 0000000..f13c9c1
--- /dev/null
@@ -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 (file)
index 0000000..15ad53d
--- /dev/null
@@ -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" <c-object>
+    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 (file)
index 0000000..53f6c6c
--- /dev/null
@@ -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 <ushort> ] >>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 (file)
index 0000000..b22448f
--- /dev/null
@@ -0,0 +1 @@
+Half-precision float support for FFI