\ FIXED.SCR                                  hhh 12:30 02/09/97
  written using LMI PC/FORTH 3.2
  Heinrich Hohl, Lucent Technologies

This package facilitates the use of fixed point double length
numbers (fd). These are double length numbers containing an
implied decimal point at a known, fixed position. The following
words allow easy handling of fixed point numbers:

PLACES ................ determine position of decimal point
(FD.) FD. FD.R ........ used to display fd numbers
FIXED ................. convert any input d number to fd number
D+ D- D* D/ ........... calculate with d or fd numbers
T* T/ TU* TU/ TU// .... basic triple length number operators
D*/ DU*/ DU*// ........ scale d or fd numbers; triple length
                        intermediate results are used
\ load screen                                hhh 14:16 02/08/97
FORTH DEFINITIONS  DECIMAL
BSTART OVERLAY
2 ?SCREENS 1- THRU

FORTH DEFINITIONS  DECIMAL
BSTART OVERLAY
2 ?SCREENS 1- THRU

BSAVE OVERLAY FIXED
0 RETURN





\ variables                                  hhh 14:02 02/08/97
VARIABLE places \ number of digits behind decimal point














\ number input                               hhh 14:00 02/08/97
: PLACES ( n -- )  0 MAX  places ! ;
\ specify number of places behind the decimal point

: DSHIFT ( d n -- d')
  DUP 0<
  IF    NEGATE
        0 ?DO 10 D/  LOOP
  ELSE  0 ?DO 10 D*  LOOP  THEN ;
\ decimal left shift (n<0 shifts |n| digits to the right)

: FIXED ( d -- fd)
  places @  DPL @ 0 MAX -  DSHIFT ;
\ convert double length number to fd considering DPL


\ formatted output                           hhh 13:58 02/08/97
: (FD.) ( fd -- addr len)
  TUCK DABS
  <#  places @ 0 ?DO # LOOP  ASCII . HOLD  #S  ROT SIGN  #> ;
\ convert fixed point double length number to formatted string

: FD. ( fd -- )  (FD.) TYPE SPACE ;
\ display fixed point double length number

: FD.R ( fd width -- )  >R  (FD.)  R> OVER - SPACES  TYPE ;
\ display number right justified in a field of specified width





\ extended arithmetics                           12:31 02/09/97
: UM/ ( ud u -- u')  UM/MOD NIP ;

: T* ( d v -- t)  TUCK M* >R >R UM* 0 R> R> D+ ;
: T/ ( t v -- d)  DUP >R M/MOD -ROT R> UM/ SWAP ;
\ multiply or divide signed long number by 0 <= v <= 7FFF

: TU* ( ud u -- ut)  TUCK UM* >R >R UM* 0 R> R> D+ ;
: TU/ ( ut u -- ud)  DUP >R UM/MOD -ROT R> UM/ SWAP ;
\ multiply or divide unsigned long numbers by unsigned number

: TU// ( ut ud -- u)
  DUP 1+
  DUP >R UM/ R> SWAP >R TU/ R> UM/ ;
\ divide ut number by ud number

\ scaling                                    hhh 14:05 02/08/97
: D*/ ( d v1 v2 -- d')  >R T* R> T/ ;
\ scale double length number d according to the unsigned
\ numbers v1 and v2 of range 0 <= v <= 7FFF: (d*v1)/v2 = d'

: DU*/ ( ud u1 u2 -- ud')  >R TU* R> TU/ ;
\ scale unsigned double length number ud according to the
\ unsigned numbers u1 and u2: (ud*u1)/u2 = ud'

: DU*// ( u ud1 ud2 -- u')  >R >R ROT TU* R> R> TU// ;
\ scale unsigned number u according to the unsigned double
\ length numbers ud1 and ud2: (u*ud1)/ud2 = u'

\ tip: avoid fussy stack operations by using basic triple
\ length arithmetic operators for scaling instead of the
\ scaling operators shown in this screen
\ excise headers                             hhh 13:33 02/08/97
EXCISE places places
EXCISE DSHIFT DSHIFT
EXCISE UM/ UM/