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

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