basis/math/floats/half/half.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.accessors alien.c-types alien.data
   4 alien.syntax kernel math math.order ;
   5 FROM: math => float ;
   6 IN: math.floats.half
   7
   8 : half>bits ( float -- bits )
   9     float>bits
  10     [ -31 shift 15 shift ] [
  11         0x7fffffff bitand
  12         dup zero? [
  13             dup 0x7f800000 >= [ -13 shift 0x7fff bitand ] [
  14                 -13 shift
  15                 112 10 shift -
  16                 0 0x7c00 clamp
  17             ] if
  18         ] unless
  19     ] bi bitor ;
  20
  21 : bits>half ( bits -- float )
  22     [ -15 shift 31 shift ] [
  23         0x7fff bitand
  24         dup zero? [
  25             dup 0x7c00 >= [ 13 shift 0x7f800000 bitor ] [
  26                 13 shift
  27                 112 23 shift +
  28             ] if
  29         ] unless
  30     ] bi bitor bits>float ;
  31
  32 SYMBOL: half
  33
  34 <<
  35
  36 <c-type>
  37     float >>class
  38     float >>boxed-class
  39     [ alien-unsigned-2 bits>half ] >>getter
  40     [ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
  41     2 >>size
  42     2 >>align
  43     2 >>align-first
  44     [ >float ] >>unboxer-quot
  45 \ half typedef
  46
  47 >>