home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p070 < prev    next >
Encoding:
Text File  |  1990-07-15  |  7.9 KB  |  247 lines
  1.        ╔════════════════════════════════════════════════════╗
  2.        ║ Lesson 5 Part 070  F-PC 3.5 Tutorial by Jack Brown ║
  3.        ╚════════════════════════════════════════════════════╝
  4.  
  5.             ┌──────────────────────────────────┐
  6.             │  Double and Quadruple Arithmetic │
  7.             └──────────────────────────────────┘
  8.  
  9. In this lesson we will look at the useful double and quadruple precision
  10. arithmetic operators provided by  R. L. SMITH and S. Y. Tang.  You will
  11. find them in the file DMULDIV.SEQ from SMITH.ZIP which is placed in
  12. \FPC\TOOLS\  by F-PC 3.5's Install Program.  We provide a modified
  13. form of DMATH.SEQ originally from the file TANG.ZIP which requires
  14. you to first load DMULDIV.SEQ  The load sequence is as follows.
  15.  
  16. FLOAD  DMULDIV.SEQ
  17. FLOAD  DMATH.SEQ
  18.  
  19. A quadruple number " quad " is a 64 bit number and appears on the stack
  20. as four single numbers.
  21.  
  22. Q        ( -- q )              Puts a quad# on stack.
  23.                                Usage: Q -1234567890 <cr>
  24. Q.R      ( q n -- )            Display quad number right justified
  25.                                in a field n wide.
  26. Q.       ( q -- )              Display quad number.
  27.  
  28. Examples:
  29.  
  30. Q 12345678987654321 <enter> ok
  31. QDUP  <enter> ok
  32. Q. <enter> 12345678987654321  ok
  33. 25 Q.R <enter>        12345678987654321 ok
  34.  
  35. QDUP     ( q -- q q)            Duplicate quad number.
  36. QABS     ( q -- qabs)           Absolute value of quad number.
  37.  
  38. Q0<      ( q -- flag)           Leave true flag if quad number < 0.
  39. Q0=      ( q -- flag)           Leave true flag if quad number = 0.
  40.  
  41. Q@       ( addr -- q )          Fetch quad number stored at addr.
  42. Q!       ( q addr -- )          Store quad number at addr.
  43. Q?       ( addr -- )            Display quad number at addr.
  44.  
  45. Examples:
  46. CREATE QVALUE 8 ALLOT  \ 64 bits, 8 bytes, or 4 single numbers.  ok
  47. Q 12345678987654321 <enter>  ok
  48. QVALUE Q!  <enter> ok
  49. QVALUE Q@ Q. <enter> 12345678987654321  ok
  50. QVALUE Q? <enter> 12345678987654321  ok
  51.  
  52. Exercise 5.4
  53. Well... You can test out these words just as well as we can!
  54. Make up some demonstrations examples of each of the following
  55. operators and upload them to the message base.
  56.  
  57. Q+       ( q1 q2 -- q3)         Add two quad numbers yielding quad sum
  58. Q-       ( q1 q2 -- q3 )        Subtract two quad numbers.
  59.  
  60. D>Q      ( d -- q )             Convert double number to quad number.
  61. D>S      ( d -- n)              Convert double number to single number.
  62. S>Q      ( n -- q)              Convert single number to quad number.
  63.  
  64.  
  65. UMD*     ( ud1 ud2 -- uqprod )      Unsigned double multiply with
  66.                                     unsigned quad product.
  67. D*       ( d1 d2 -- dprod )         Signed double precision multiply.
  68. DM*      ( d1 d2 -- q)              Signed double precision multiply
  69.                                     with signed quad product.
  70. UQN*     ( uq un -- uqprod)         Unsigned quad time unsigned single
  71.                                     with unsigned quad product.
  72.  
  73. UMD/MOD  ( uq1 ud1 -- udrem udquot) Unsigned quad divided by double
  74.                                     with double remainder and quotient.
  75. DUM/MOD  ( uq1 ud1 -- udrem uqquot) Unsigned quad divided by double
  76.                                     with double remainder and quad quot.
  77. MD/MOD   ( q d1 --- drem dquot)     Signed quad divided by signed double
  78.                                     with signed double rem. and quot.
  79.  
  80. D/MOD    ( d1 d2 --- d3 d4)         Forth 83 floored signed double /MOD
  81. D/       ( d1 d2 --- d3 )           Forth 83 floored signed double /
  82. DMOD     ( d1 d2 --- d3 )           Forth 83 floored signed double MOD
  83.  
  84. D*/MOD   ( d1 d2 d3 --- d4 d5 )     Forth 83 floored signed double */MOD
  85. D*/      ( d1 d2 d3 --- d4 )        Forth 83 floored signed double */
  86.  
  87.  
  88. The following quad number formating operators will be discussed in
  89. Lesson 6.   <Q#   Q#>    Q#   Q#S
  90.  
  91. ╓──────────────╖
  92. ║ Problem 5.11 ║
  93. ╙──────────────╜
  94. As an exercise in using double number arithmetic ( Not QUAD arithmetic!)
  95. rewrite the polygon area case study of Lesson 4 Part 15 so that it all
  96. aritmetic is done with double numbers. You may keep loop counters as
  97. single numbers if you wish.
  98.  
  99. ( Please Move to Lesson 5 Part 8 )
  100.  
  101. Appendix to Lesson 5 Part 8..  Listing of DMATH.SEQ
  102.  
  103. \                   DOUBLE PRECISION ARITHMETIC
  104. \                         BY S. Y. TANG
  105. \ Double precision arithmetic with some quad precision arithmetic
  106. \ using codes by Robert Smith and public domain MVP-MATH by
  107. \ Kooperman modified to give floored division in accordance with the
  108. \ Forth-83 standard.
  109. \ Naming convention used is: U indicates unsigned, D double, Q quad
  110. \ and M mixed double and quad.
  111. \ Usage of this package is subject to the conditions specified by R. Smith
  112. \ and Kooperman.
  113. \
  114. \ If you have any questions contact
  115. \                         S. Y. Tang
  116. \                         3236 Round Hill Dr
  117. \                         Hayward, Ca 94542
  118.  
  119. \ Modified for compatibility with DMULDIV.SEQ by Jack Brown 041690
  120. \ Deleted UMD/MOD , D*  and renamed  UDM* to UMD* as in DMULDIV.SEQ
  121.  
  122. \ CR .( DMATH.SEQ requires loading of  DMULDIV.SEQ  first.   )
  123. \ CR .( DMULDIV.SEQ is from SMITH.ZIP and is placed in  \FPC\TOOLS\ )
  124. \ CR .( by F-PC 3.5 INSTALL program )
  125.  
  126. : DUM/MOD   ( uq1 ud1 --- ud2 uqq)
  127.    >R >R 0 0 R> R> 2DUP >R >R
  128.    UMD/MOD  R> R> 2SWAP  >R >R UMD/MOD  R> R>
  129. ;
  130. : D>S   ( d --- n)   DROP  ;
  131.  
  132. : QDUP   ( q --- q q)   2OVER 2OVER ;
  133.  
  134. : Q0<   ( q --- flag)   >R 2DROP 2DROP R> 0< ;
  135.  
  136. : Q0=   ( q --- flag)   OR OR OR 0= ;
  137.  
  138. : Q@   ( addr --- q )
  139.    DUP 4 + 2@ ROT 2@
  140. ;
  141. : Q!   ( q addr --- )
  142.    DUP >R 2!  R> 4 + 2!
  143. ;
  144.  
  145. : DXOR   ( d1 d2 --- d3 )
  146.    >R SWAP >R  XOR  R> R> XOR
  147. ;
  148. : QXOR   ( q1 q2 --- q3)
  149.    >R >R 2SWAP >R >R DXOR R> R> R> R> DXOR
  150. ;
  151. : ADC   ( n1 n2 carry.in --- n3 carry.out)
  152.    >R 0 ROT 0 D+  R> IF 1 0 D+ THEN
  153. ;
  154. : DADC   ( d1 d2 carry.in --- d3 carry.out)
  155.    SWAP >R ROT >R ADC R> R> ROT ADC
  156. ;
  157. : QADC   ( q1 q2 carry.in --- q3 carry.out)
  158.    -ROT >R >R >R 2SWAP R> -ROT >R >R DADC
  159.    R> R> ROT R> R> ROT DADC
  160. ;
  161. : Q+   ( q1 q2 --- q3)  0 QADC DROP ;
  162.  
  163. : QNEGATE   ( q1 --- -q1)
  164.    -1. -1. QXOR   1. 0. Q+
  165. ;
  166. : Q+-   ( q n --- q1)    0< IF QNEGATE THEN ;
  167.  
  168. : QABS   ( q --- qabs)   DUP Q+- ;
  169.  
  170. : Q-   ( q1 q2 --- q3 )   QNEGATE Q+ ;
  171.  
  172. : D>Q   ( d --- q )   DUP >R DABS 0 0 R> Q+- ;
  173.  
  174. HEX
  175.  
  176. : <Q#   ( q1 --- q1)   <#  ;
  177.  
  178. : Q#>   ( uq1 --- addr n2)
  179.    2DROP 2DROP   HLD @  PAD OVER - ;
  180.  
  181. : Q#   ( uq1 --- uq2 )
  182.    BASE @ S>D  DUM/MOD   2ROT   D>S   9 OVER <
  183.    IF 7 + THEN  30 + HOLD
  184. ;
  185. : Q#S   ( uq --- 0 0 0 0 )
  186.    BEGIN Q# QDUP Q0= UNTIL
  187. ;
  188.  
  189. DECIMAL
  190.  
  191. : Q.R   ( q n --- )
  192.    DEPTH 5 < ABORT" EMPTY STACK"
  193.    >R DUP >R QABS
  194.    <Q# Q#S R> SIGN Q#>
  195.    R> OVER - SPACES TYPE
  196. ;
  197. : Q.   ( q --- )   0 Q.R SPACE ;
  198.  
  199. : Q?   ( addr --- )   Q@ Q. ;
  200.  
  201. : MD/MOD  ( q d1 --- d2 d3)
  202.    2DUP >R >R 2 PICK >R     \ keep d1 and sign of q
  203.    >R >R QABS R> R> DABS UMD/MOD    ( udmod udquot)
  204.    2SWAP R@ ?DNEGATE                ( udquot dmod)
  205.    R> R> R@ SWAP >R XOR 0<             \ find sign
  206.    IF R> R> D+  2SWAP DNEGATE 1. D-   ( dmod dquot)
  207.    ELSE R> R> 2DROP 2SWAP
  208.    THEN
  209. ;
  210. : D/MOD   ( d1 d2 --- d3 d4)
  211.    >R >R   D>Q  R> R>  MD/MOD
  212. ;
  213. : D/     ( d1 d2 --- d3 )    D/MOD  2SWAP 2DROP ;
  214.  
  215. : DMOD   ( d1 d2 --- d3 )    D/MOD 2DROP ;
  216.  
  217. : DM*   ( d1 d2 --- q)
  218.    DUP 3 PICK XOR >R
  219.    DABS 2SWAP DABS UMD* R> Q+-
  220. ;
  221. : D*/MOD   ( d1 d2 d3 --- d4 d5 )  >R >R DM* R> R> MD/MOD ;
  222.  
  223. : D*/   ( d1 d2 d3 --- d4 )  D*/MOD 2SWAP 2DROP ;
  224.  
  225. : S>Q   ( n --- q) DUP >R ABS 0 0 0 R> Q+- ;
  226.  
  227. : UQN*   ( uq un --- uq1)
  228.    >R R@ S>D UMD* 2SWAP
  229.    2ROT R> S>D UMD* Q+
  230. ;
  231. : QCONVERT   ( q1 adr1 --- q2 adr2 )
  232.    BEGIN
  233.    1+ DUP >R C@ BASE @ DIGIT
  234.      WHILE >R BASE @ UQN* R> S>Q Q+ R>
  235.    REPEAT DROP R>
  236. ;
  237. : Q   ( --- q ) \ Puts a quad# on stack. Usage: Q -1234567890 <cr>
  238.    BL WORD 0 0 ROT 0 0 ROT
  239.    DUP 1+ C@ ASCII - =
  240.    IF -1 DPL ! 1+ ELSE 0 DPL ! THEN
  241.    QCONVERT DROP DPL @ Q+-
  242. ;
  243.  
  244. ┌─────────────────────────────────────┐
  245. │   Please move to Lesson 5 Part 080  │
  246. └─────────────────────────────────────┘
  247.