home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / ddjmag / ddj8806.arc / TRACY.ARC / TRACY.EXM
Text File  |  1980-01-01  |  2KB  |  119 lines
  1. : QNORM ( q - t exp)
  2.  
  3. \ normalize q to bit 30;
  4.  
  5. \ leave adjustment as exp.
  6.  
  7.   2DUP OR 2OVER OR OR
  8.  
  9.   IF 1 ( count) >R
  10.  
  11.    BEGIN DUP 0< NOT
  12.      WHILE Q2* R> 1- >R REPEAT
  13.  
  14.    2>R SWAP DROP 2R> TU2/ R>
  15.  
  16.   THEN ;
  17.  
  18.  
  19.  
  20. : ROUND ( t - ud exp )
  21.  
  22. \ assumes hi bit is zero.
  23.  
  24.   32768 0 0 T+ ROT DROP 
  25.   DUP 0< DUP IF >R DU2/ R> THEN ;
  26.  
  27.  
  28.  
  29. : F* ( r r2 - r3)
  30.  
  31.   f0= IF FSWAP THEN
  32.  
  33.   FOVER F0= IF FDROP EXIT THEN
  34.  
  35.   ( exp2 ) >R ROT ( exp ) >R
  36.   UNPACK >R
  37.   2SWAP UNPACK >R DUM*
  38.  
  39.   QNORM ( t exp ) >R
  40.  
  41.   ROUND ( d exp ) R> + ROT ROT
  42.  
  43.   2R> XOR PACK ROT 2R> + + 1+ ;
  44.  
  45.  
  46.  
  47.  
  48. Example 1: Normalizing and rounding the quad-precision result
  49.  
  50.  
  51. : F.  OVER >R FABS DUP 0>
  52.  
  53.   IF  0 0 ROT 0
  54.  
  55.    DO Q2* LOOP Q2* 999999999. DMIN
  56.  
  57.      2SWAP DU2/
  58.  
  59.   ELSE NEGATE D>SHIFT 0 0 2SWAP THEN
  60.  
  61.   500000000. 1073741824. DUM*/
  62.  
  63.   <# # # # # # # # # #
  64.  
  65.   [ ASCII . ] LITERAL HOLD 2DROP
  66.  
  67.   #S R> 0< SIGN #> TYPE SPACE ;
  68.  
  69.  
  70.  
  71. : FLOAT ( d - r)
  72.  
  73.   2DUP D0= IF 0 EXIT THEN
  74.  
  75.   SWAP OVER DABS 1 ( count) >R
  76.  
  77.   BEGIN DUP 0< NOT
  78.  
  79.   WHILE D2* R> 1- >R REPEAT
  80.  
  81.   DU2/ ROT PACK R> 31 + ;
  82.  
  83.  
  84.  
  85. : >F ( d - fn)
  86.  
  87. \ converts most recent double number
  88.  
  89. \ to mixed fraction.
  90.  
  91. \ Used like 3.14159 >F
  92.  
  93.   DPL @ 0< ABORT" Needs dec point"
  94.  
  95.   FLOAT
  96.  
  97.   DPL @ ?DUP
  98.  
  99.   IF 1 0 ROT 0
  100.  
  101.    DO 10 0 DUM* 2DROP LOOP
  102.  
  103.    FLOAT F/
  104.  
  105.   THEN ;
  106.  
  107.  
  108.  
  109.  
  110.   3.14159 FLOAT F. prints 3.141589999
  111.  
  112.   3.14159 FLOAT FCONSTANT PI
  113.   PI PI F* F. prints 9.869587719
  114.  
  115.  
  116.  
  117. Example 2: Input and output primitives
  118.  
  119.