float.4th

   1 \ Floating point arithmetic
   2
   3 : lshift 2* ;
   4 : rshift 2/ ;
   5
   6 : nlshift 0 do lshift loop ;
   7 : nrshift 0 do rshift loop ;
   8
   9 1 52 nlshift 1- constant frac-mask
  10 1 11 nlshift 1- 52 nlshift constant exp-mask
  11
  12 : fraction
  13     frac-mask and ;
  14
  15 : exponent
  16     exp-mask and 52 nrshift ;
  17
  18 : sign ( float -- sign  )
  19     0> ;
  20
  21 : make-float ( sign exponent fraction -- float )
  22     swap 52 nlshift or
  23     swap false = if
  24         negate
  25     then
  26 ;