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 | 7 | \ |
1f99f95d S |
8 | \ Permission to use, copy, modify, and/or distribute this |
9 | \ software for any purpose with or without fee is hereby granted. | |
10 | \ | |
11 | \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL | |
12 | \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED | |
13 | \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL | |
14 | \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR | |
15 | \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING | |
16 | \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF | |
17 | \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF | |
18 | \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. | |
8e9db35f PB |
19 | |
20 | anew task-math.fth | |
21 | decimal | |
22 | ||
23 | : FM/MOD { dl dh nn | dlp dhp nnp rem quo -- rem quo , floored } | |
24 | dl dh dabs -> dhp -> dlp | |
25 | nn abs -> nnp | |
26 | dlp dhp nnp um/mod -> quo -> rem | |
27 | dh 0< | |
28 | IF \ negative dividend | |
29 | nn 0< | |
30 | IF \ negative divisor | |
31 | rem negate -> rem | |
32 | ELSE \ positive divisor | |
33 | rem 0= | |
34 | IF | |
35 | quo negate -> quo | |
36 | ELSE | |
37 | quo 1+ negate -> quo | |
38 | nnp rem - -> rem | |
39 | THEN | |
40 | THEN | |
41 | ELSE \ positive dividend | |
42 | nn 0< | |
43 | IF \ negative divisor | |
44 | rem 0= | |
45 | IF | |
46 | quo negate -> quo | |
47 | ELSE | |
48 | nnp rem - negate -> rem | |
49 | quo 1+ negate -> quo | |
50 | THEN | |
51 | THEN | |
52 | THEN | |
53 | rem quo | |
54 | ; | |
55 | ||
56 | : SM/REM { dl dh nn | dlp dhp nnp rem quo -- rem quo , symmetric } | |
57 | dl dh dabs -> dhp -> dlp | |
58 | nn abs -> nnp | |
59 | dlp dhp nnp um/mod -> quo -> rem | |
60 | dh 0< | |
61 | IF \ negative dividend | |
62 | rem negate -> rem | |
63 | nn 0> | |
64 | IF \ positive divisor | |
65 | quo negate -> quo | |
66 | THEN | |
67 | ELSE \ positive dividend | |
68 | nn 0< | |
69 | IF \ negative divisor | |
70 | quo negate -> quo | |
71 | THEN | |
72 | THEN | |
73 | rem quo | |
74 | ; | |
75 | ||
76 | ||
77 | : /MOD ( a b -- rem quo ) | |
78 | >r s>d r> sm/rem | |
79 | ; | |
80 | ||
81 | : MOD ( a b -- rem ) | |
82 | /mod drop | |
83 | ; | |
84 | ||
85 | : */MOD ( a b c -- rem a*b/c , use double precision intermediate value ) | |
86 | >r m* | |
87 | r> sm/rem | |
88 | ; | |
89 | : */ ( a b c -- a*b/c , use double precision intermediate value ) | |
90 | */mod | |
91 | nip | |
92 | ; |