1 ! Copyright (C) 2009 Joe Groff.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.accessors alien.c-types combinators
8 : half>bits ( float -- bits )
10 [ -16 shift 0x8000 bitand ] keep
11 [ 0x7fffff bitand ] keep
12 -23 shift 0xff bitand 127 - {
13 { [ dup -24 < ] [ 2drop 0 ] }
14 { [ dup -14 < ] [ [ 1 + shift ] [ 24 + 2^ ] bi bitor ] }
15 { [ dup 15 <= ] [ [ -13 shift ] [ 15 + 10 shift ] bi* bitor ] }
16 { [ dup 128 < ] [ 2drop 0x7c00 ] }
17 [ drop -13 shift 0x7c00 bitor ]
20 : bits>half ( bits -- float )
21 [ -15 shift 31 shift ] [
24 dup 0x7c00 >= [ 13 shift 0x7f800000 bitor ] [
27 [ nip 103 + 23 shift ]
28 [ 23 swap - shift 0x7fffff bitand ] 2bi bitor
35 ] bi bitor bits>float ;
44 [ alien-unsigned-2 bits>half ] >>getter
45 [ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
49 [ >float ] >>unboxer-quot