Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) math.fth 98/01/26 1.2 |
2 | \ Extended Math routines | |
3 | \ FM/MOD SM/REM | |
4 | \ | |
5 | \ Author: Phil Burk | |
1a088514 | 6 | \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom |
8e9db35f PB |
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 | ; |