Path: utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!ucbvax!BLIULG11.BITNET!A-PIRARD
From: A-PIRARD@BLIULG11.BITNET (Andr'e PIRARD)
Newsgroups: comp.lang.forth
Subject: Re: Floating Number
Message-ID: <8911301435.AA12690@jade.berkeley.edu>
Date: 30 Nov 89 09:21:53 GMT
References: <7811105@TWNCTU01>
Sender: daemon@ucbvax.BERKELEY.EDU
Reply-To: Forth Interest Group International List <FIGI-L%SCFVM.bitnet@jade.berkeley.edu>
Organization: The Internet
Lines: 54

>Besides, can someone tell me how can I devide two real number eff-
>iciently?  I only know to subtract repeatedly.  Is this the best

Developing the arithmetic of mantissas held in double words
in Taylor series shows that floating point division is a matter of
3 UM/MOD and 1 UM*. Plus a couple of shifts and exponent handling.
This makes for a not-unreasonable, all-high-level, poor-man floating
point package found in Comforth as a start for something more efficient.
It hurts me exhibit pieces of gibberish like this, but I'll still
do it to just give an idea of the arithmetics involved.

\ TOS WORD: 2'S COMPLEMENT EXPONENT
\ BOS 2 WORDS: MANTISSA ABSOLUTE VALUE
\              SIGN IN HIGH ORDER BIT

: F>I ( -- M / F -- : CONVERT TO INTERNAL FORMAT
  FTOP DUP 2@ EXP0 2! \ EXP & SIGN
  2+ 2@ HEXA 7FFF AND \ MANTISSA
  FDROP ;

: I>F ( M -- / -- F : CONVERT TO EXTERNAL FORMAT
  FPROD
  EXP0 2+ @ HEXA 8000 AND OR \ APPLY SIGN
  FTOP EXP0 @ OVER ! \ EXPONENT
  2+ 2! ;            \ MANTISSA

\ .....

: AEXP ( -- EXP1 EXP0-ADDR / F0 F1 -- : ADJUST MULT/DIV SIGN+EXPONENT
  F>I EXP0>1 F>I 2SWAP
  SIGN0 SIGN1 C@ TOGGLE
  EXP1 @ EXP0 ;

: F* ( / F0 F1 -- F0*F1
  AEXP +!        \ ADJUST SIGN+EXPONENT
  ROT >R >R >R   \ M0L / M1L M1H M0H
  1 RPICK UM*    \ M0L*M1H / IDEM
  R> 1 RPICK UM* \ M0L*M1H M1L*M0H / M1H M0H
  D+ SWAP DROP 0 \ ALIGN DECIMAL POINT
  R> R> UM* D+   \ MN0*MN1
  D2*            \ ALIGN DECIMAL POINT
  LNORM I>F ;

: F/ ( / F0 F1 -- F0/F1
  AEXP -!         \ ADJUST SIGN+EXPONENT
  D2* >R >R       \ M0 / scaled M1L M1H
  1 RPICK UM/MOD
  >R 0 SWAP       \ DR / [M0/M1H]H M1L M1H
  2 RPICK UM/MOD
  SWAP DROP R>    \ M0/M1H /M1L M1H
  DUP R> -1 SHIFT UM*  \ M0/M1H M0/M1H*M1L/2 / M1H
  R> UM/MOD SWAP DROP
  0 D2*                \ M0/M1H M0/M1H*M1L/M1H
  D- RNORM I>F ;