extra/half-floats/half-floats.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: accessors alien.c-types alien.syntax kernel math math.order ;
   3 IN: half-floats
   4
   5 : half>bits ( float -- bits )
   6     float>bits
   7     [ -31 shift 15 shift ] [
   8         HEX: 7fffffff bitand
   9         dup zero? [
  10             dup HEX: 7f800000 >= [ -13 shift HEX: 7fff bitand ] [
  11                 -13 shift
  12                 112 10 shift -
  13                 0 HEX: 7c00 clamp
  14             ] if
  15         ] unless
  16     ] bi bitor ;
  17
  18 : bits>half ( bits -- float )
  19     [ -15 shift 31 shift ] [
  20         HEX: 7fff bitand
  21         dup zero? [
  22             dup HEX: 7c00 >= [ 13 shift HEX: 7f800000 bitor ] [
  23                 13 shift
  24                 112 23 shift +
  25             ] if
  26         ] unless
  27     ] bi bitor bits>float ;
  28
  29 C-STRUCT: half { "ushort" "(bits)" } ;
  30
  31 <<
  32
  33 "half" c-type
  34     [ half>bits <ushort> ] >>unboxer-quot
  35     [ *ushort bits>half ] >>boxer-quot
  36     drop
  37
  38 >>