       ͻ
        Lesson 5 Part 070  F-PC 3.5 Tutorial by Jack Brown 
       ͼ

            Ŀ
              Double and Quadruple Arithmetic 
            

In this lesson we will look at the useful double and quadruple precision
arithmetic operators provided by  R. L. SMITH and S. Y. Tang.  You will
find them in the file DMULDIV.SEQ from SMITH.ZIP which is placed in
\FPC\TOOLS\  by F-PC 3.5's Install Program.  We provide a modified
form of DMATH.SEQ originally from the file TANG.ZIP which requires
you to first load DMULDIV.SEQ  The load sequence is as follows.

FLOAD  DMULDIV.SEQ
FLOAD  DMATH.SEQ

A quadruple number " quad " is a 64 bit number and appears on the stack
as four single numbers.

Q        ( -- q )              Puts a quad# on stack.
                               Usage: Q -1234567890 <cr>
Q.R      ( q n -- )            Display quad number right justified
                               in a field n wide.
Q.       ( q -- )              Display quad number.

Examples:

Q 12345678987654321 <enter> ok
QDUP  <enter> ok
Q. <enter> 12345678987654321  ok
25 Q.R <enter>        12345678987654321 ok

QDUP     ( q -- q q)            Duplicate quad number.
QABS     ( q -- qabs)           Absolute value of quad number.

Q0<      ( q -- flag)           Leave true flag if quad number < 0.
Q0=      ( q -- flag)           Leave true flag if quad number = 0.

Q@       ( addr -- q )          Fetch quad number stored at addr.
Q!       ( q addr -- )          Store quad number at addr.
Q?       ( addr -- )            Display quad number at addr.

Examples:
CREATE QVALUE 8 ALLOT  \ 64 bits, 8 bytes, or 4 single numbers.  ok
Q 12345678987654321 <enter>  ok
QVALUE Q!  <enter> ok
QVALUE Q@ Q. <enter> 12345678987654321  ok
QVALUE Q? <enter> 12345678987654321  ok

Exercise 5.4
Well... You can test out these words just as well as we can!
Make up some demonstrations examples of each of the following
operators and upload them to the message base.

Q+       ( q1 q2 -- q3)         Add two quad numbers yielding quad sum
Q-       ( q1 q2 -- q3 )        Subtract two quad numbers.

D>Q      ( d -- q )             Convert double number to quad number.
D>S      ( d -- n)              Convert double number to single number.
S>Q      ( n -- q)              Convert single number to quad number.


UMD*     ( ud1 ud2 -- uqprod )      Unsigned double multiply with
                                    unsigned quad product.
D*       ( d1 d2 -- dprod )         Signed double precision multiply.
DM*      ( d1 d2 -- q)              Signed double precision multiply
                                    with signed quad product.
UQN*     ( uq un -- uqprod)         Unsigned quad time unsigned single
                                    with unsigned quad product.

UMD/MOD  ( uq1 ud1 -- udrem udquot) Unsigned quad divided by double
                                    with double remainder and quotient.
DUM/MOD  ( uq1 ud1 -- udrem uqquot) Unsigned quad divided by double
                                    with double remainder and quad quot.
MD/MOD   ( q d1 --- drem dquot)     Signed quad divided by signed double
                                    with signed double rem. and quot.

D/MOD    ( d1 d2 --- d3 d4)         Forth 83 floored signed double /MOD
D/       ( d1 d2 --- d3 )           Forth 83 floored signed double /
DMOD     ( d1 d2 --- d3 )           Forth 83 floored signed double MOD

D*/MOD   ( d1 d2 d3 --- d4 d5 )     Forth 83 floored signed double */MOD
D*/      ( d1 d2 d3 --- d4 )        Forth 83 floored signed double */


The following quad number formating operators will be discussed in
Lesson 6.   <Q#   Q#>    Q#   Q#S

ķ
 Problem 5.11 
Ľ
As an exercise in using double number arithmetic ( Not QUAD arithmetic!)
rewrite the polygon area case study of Lesson 4 Part 15 so that it all
aritmetic is done with double numbers. You may keep loop counters as
single numbers if you wish.

( Please Move to Lesson 5 Part 8 )

Appendix to Lesson 5 Part 8..  Listing of DMATH.SEQ

\                   DOUBLE PRECISION ARITHMETIC
\                         BY S. Y. TANG
\ Double precision arithmetic with some quad precision arithmetic
\ using codes by Robert Smith and public domain MVP-MATH by
\ Kooperman modified to give floored division in accordance with the
\ Forth-83 standard.
\ Naming convention used is: U indicates unsigned, D double, Q quad
\ and M mixed double and quad.
\ Usage of this package is subject to the conditions specified by R. Smith
\ and Kooperman.
\
\ If you have any questions contact
\                         S. Y. Tang
\                         3236 Round Hill Dr
\                         Hayward, Ca 94542

\ Modified for compatibility with DMULDIV.SEQ by Jack Brown 041690
\ Deleted UMD/MOD , D*  and renamed  UDM* to UMD* as in DMULDIV.SEQ

\ CR .( DMATH.SEQ requires loading of  DMULDIV.SEQ  first.   )
\ CR .( DMULDIV.SEQ is from SMITH.ZIP and is placed in  \FPC\TOOLS\ )
\ CR .( by F-PC 3.5 INSTALL program )

: DUM/MOD   ( uq1 ud1 --- ud2 uqq)
   >R >R 0 0 R> R> 2DUP >R >R
   UMD/MOD  R> R> 2SWAP  >R >R UMD/MOD  R> R>
;
: D>S   ( d --- n)   DROP  ;

: QDUP   ( q --- q q)   2OVER 2OVER ;

: Q0<   ( q --- flag)   >R 2DROP 2DROP R> 0< ;

: Q0=   ( q --- flag)   OR OR OR 0= ;

: Q@   ( addr --- q )
   DUP 4 + 2@ ROT 2@
;
: Q!   ( q addr --- )
   DUP >R 2!  R> 4 + 2!
;

: DXOR   ( d1 d2 --- d3 )
   >R SWAP >R  XOR  R> R> XOR
;
: QXOR   ( q1 q2 --- q3)
   >R >R 2SWAP >R >R DXOR R> R> R> R> DXOR
;
: ADC   ( n1 n2 carry.in --- n3 carry.out)
   >R 0 ROT 0 D+  R> IF 1 0 D+ THEN
;
: DADC   ( d1 d2 carry.in --- d3 carry.out)
   SWAP >R ROT >R ADC R> R> ROT ADC
;
: QADC   ( q1 q2 carry.in --- q3 carry.out)
   -ROT >R >R >R 2SWAP R> -ROT >R >R DADC
   R> R> ROT R> R> ROT DADC
;
: Q+   ( q1 q2 --- q3)  0 QADC DROP ;

: QNEGATE   ( q1 --- -q1)
   -1. -1. QXOR   1. 0. Q+
;
: Q+-   ( q n --- q1)    0< IF QNEGATE THEN ;

: QABS   ( q --- qabs)   DUP Q+- ;

: Q-   ( q1 q2 --- q3 )   QNEGATE Q+ ;

: D>Q   ( d --- q )   DUP >R DABS 0 0 R> Q+- ;

HEX

: <Q#   ( q1 --- q1)   <#  ;

: Q#>   ( uq1 --- addr n2)
   2DROP 2DROP   HLD @  PAD OVER - ;

: Q#   ( uq1 --- uq2 )
   BASE @ S>D  DUM/MOD   2ROT   D>S   9 OVER <
   IF 7 + THEN  30 + HOLD
;
: Q#S   ( uq --- 0 0 0 0 )
   BEGIN Q# QDUP Q0= UNTIL
;

DECIMAL

: Q.R   ( q n --- )
   DEPTH 5 < ABORT" EMPTY STACK"
   >R DUP >R QABS
   <Q# Q#S R> SIGN Q#>
   R> OVER - SPACES TYPE
;
: Q.   ( q --- )   0 Q.R SPACE ;

: Q?   ( addr --- )   Q@ Q. ;

: MD/MOD  ( q d1 --- d2 d3)
   2DUP >R >R 2 PICK >R     \ keep d1 and sign of q
   >R >R QABS R> R> DABS UMD/MOD    ( udmod udquot)
   2SWAP R@ ?DNEGATE                ( udquot dmod)
   R> R> R@ SWAP >R XOR 0<             \ find sign
   IF R> R> D+  2SWAP DNEGATE 1. D-   ( dmod dquot)
   ELSE R> R> 2DROP 2SWAP
   THEN
;
: D/MOD   ( d1 d2 --- d3 d4)
   >R >R   D>Q  R> R>  MD/MOD
;
: D/     ( d1 d2 --- d3 )    D/MOD  2SWAP 2DROP ;

: DMOD   ( d1 d2 --- d3 )    D/MOD 2DROP ;

: DM*   ( d1 d2 --- q)
   DUP 3 PICK XOR >R
   DABS 2SWAP DABS UMD* R> Q+-
;
: D*/MOD   ( d1 d2 d3 --- d4 d5 )  >R >R DM* R> R> MD/MOD ;

: D*/   ( d1 d2 d3 --- d4 )  D*/MOD 2SWAP 2DROP ;

: S>Q   ( n --- q) DUP >R ABS 0 0 0 R> Q+- ;

: UQN*   ( uq un --- uq1)
   >R R@ S>D UMD* 2SWAP
   2ROT R> S>D UMD* Q+
;
: QCONVERT   ( q1 adr1 --- q2 adr2 )
   BEGIN
   1+ DUP >R C@ BASE @ DIGIT
     WHILE >R BASE @ UQN* R> S>Q Q+ R>
   REPEAT DROP R>
;
: Q   ( --- q ) \ Puts a quad# on stack. Usage: Q -1234567890 <cr>
   BL WORD 0 0 ROT 0 0 ROT
   DUP 1+ C@ ASCII - =
   IF -1 DPL ! 1+ ELSE 0 DPL ! THEN
   QCONVERT DROP DPL @ Q+-
;

Ŀ
   Please move to Lesson 5 Part 080  

