_Forth Column_
by Martin Tracy


: QNORM ( q - t exp)

\ normalize q to bit 30;

\ leave adjustment as exp.

  2DUP OR 2OVER OR OR

  IF 1 ( count) >R

   BEGIN DUP 0< NOT
	 WHILE Q2* R> 1- >R REPEAT

   2>R SWAP DROP 2R> TU2/ R>

  THEN ;



: ROUND ( t - ud exp )

\ assumes hi bit is zero.

  32768 0 0 T+ ROT DROP 
  DUP 0< DUP IF >R DU2/ R> THEN ;



: F* ( r r2 - r3)

  f0= IF FSWAP THEN

  FOVER F0= IF FDROP EXIT THEN

  ( exp2 ) >R ROT ( exp ) >R
  UNPACK >R
  2SWAP UNPACK >R DUM*

  QNORM ( t exp ) >R

  ROUND ( d exp ) R> + ROT ROT

  2R> XOR PACK ROT 2R> + + 1+ ;




Example 1: Normalizing and rounding the quad-precision result


: F.  OVER >R FABS DUP 0>

  IF  0 0 ROT 0
 
   DO Q2* LOOP Q2* 999999999. DMIN

     2SWAP DU2/

  ELSE NEGATE D>SHIFT 0 0 2SWAP THEN

  500000000. 1073741824. DUM*/

  <# # # # # # # # # #

  [ ASCII . ] LITERAL HOLD 2DROP

  #S R> 0< SIGN #> TYPE SPACE ;



: FLOAT ( d - r)

  2DUP D0= IF 0 EXIT THEN

  SWAP OVER DABS 1 ( count) >R

  BEGIN DUP 0< NOT

  WHILE D2* R> 1- >R REPEAT

  DU2/ ROT PACK R> 31 + ;



: >F ( d - fn)

\ converts most recent double number

\ to mixed fraction.

\ Used like 3.14159 >F

  DPL @ 0< ABORT" Needs dec point"

  FLOAT

  DPL @ ?DUP

  IF 1 0 ROT 0
 
   DO 10 0 DUM* 2DROP LOOP
 
   FLOAT F/

  THEN ;




  3.14159 FLOAT F. prints 3.141589999

  3.14159 FLOAT FCONSTANT PI
  PI PI F* F. prints 9.869587719



Example 2: Input and output primitives