43 lines
999 B
Factor
43 lines
999 B
Factor
! (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
|
|
|
|
>>
|