git.gag.com Git - debian/pforth/blob - math.fth

   1 \ @(#) math.fth 98/01/26 1.2
   2 \ Extended Math routines
   3 \ FM/MOD SM/REM
   4 \
   5 \ Author: Phil Burk
   6 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
   7 \
   8 \ The pForth software code is dedicated to the public domain,
   9 \ and any third party may reproduce, distribute and modify
  10 \ the pForth software code or any derivative works thereof
  11 \ without any compensation or license.  The pForth software
  12 \ code is provided on an "as is" basis without any warranty
  13 \ of any kind, including, without limitation, the implied
  14 \ warranties of merchantability and fitness for a particular
  15 \ purpose and their equivalents under the laws of any jurisdiction.
  16
  17 anew task-math.fth
  18 decimal
  19
  20 : FM/MOD { dl dh nn | dlp dhp nnp rem quo -- rem quo , floored }
  21         dl dh dabs -> dhp -> dlp
  22         nn abs -> nnp
  23         dlp dhp nnp um/mod -> quo -> rem
  24         dh 0<
  25         IF  \ negative dividend
  26                 nn 0<
  27                 IF   \ negative divisor
  28                         rem negate -> rem
  29                 ELSE  \ positive divisor
  30                         rem 0=
  31                         IF
  32                                 quo negate -> quo
  33                         ELSE
  34                                 quo 1+ negate -> quo
  35                                 nnp rem - -> rem
  36                         THEN
  37                 THEN
  38         ELSE  \ positive dividend
  39                 nn 0<
  40                 IF  \ negative divisor
  41                         rem 0=
  42                         IF
  43                                 quo negate -> quo
  44                         ELSE
  45                                 nnp rem - negate -> rem
  46                                 quo 1+ negate -> quo
  47                         THEN
  48                 THEN
  49         THEN
  50         rem quo
  51 ;
  52
  53 : SM/REM { dl dh nn | dlp dhp nnp rem quo -- rem quo , symmetric }
  54         dl dh dabs -> dhp -> dlp
  55         nn abs -> nnp
  56         dlp dhp nnp um/mod -> quo -> rem
  57         dh 0<
  58         IF  \ negative dividend
  59                 rem negate -> rem
  60                 nn 0>
  61                 IF   \ positive divisor
  62                         quo negate -> quo
  63                 THEN
  64         ELSE  \ positive dividend
  65                 nn 0<
  66                 IF  \ negative divisor
  67                         quo negate -> quo
  68                 THEN
  69         THEN
  70         rem quo
  71 ;
  72
  73
  74 : /MOD ( a b -- rem quo )
  75         >r s>d r> sm/rem
  76 ;
  77
  78 : MOD ( a b -- rem )
  79         /mod drop
  80 ;
  81
  82 : */MOD ( a b c -- rem a*b/c , use double precision intermediate value )
  83         >r m*
  84         r> sm/rem
  85 ;
  86 : */ ( a b c -- a*b/c , use double precision intermediate value )
  87         */mod
  88         nip
  89 ;