Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | /* @(#) pfinnrfp.h 98/02/26 1.4 */ |
2 | /*************************************************************** | |
3 | ** Compile FP routines. | |
4 | ** This file is included from "pf_inner.c" | |
5 | ** | |
6 | ** These routines could be left out of an execute only version. | |
7 | ** | |
8 | ** Author: Darren Gibbs, Phil Burk | |
9 | ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom | |
10 | ** | |
1f99f95d S |
11 | ** Permission to use, copy, modify, and/or distribute this |
12 | ** software for any purpose with or without fee is hereby granted. | |
13 | ** | |
14 | ** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL | |
15 | ** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED | |
16 | ** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL | |
17 | ** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR | |
18 | ** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING | |
19 | ** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF | |
20 | ** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF | |
21 | ** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. | |
8e9db35f PB |
22 | ** |
23 | **************************************************************** | |
24 | ** | |
25 | ***************************************************************/ | |
26 | ||
27 | #ifdef PF_SUPPORT_FP | |
28 | ||
58a4c23b | 29 | #define FP_DHI1 (((PF_FLOAT)((cell_t)1<<(sizeof(cell_t)*8-2)))*4.0) |
8e9db35f PB |
30 | |
31 | case ID_FP_D_TO_F: /* ( dlo dhi -- ) ( F: -- r ) */ | |
32 | PUSH_FP_TOS; | |
33 | Scratch = M_POP; /* dlo */ | |
34 | DBUG(("dlo = 0x%8x , ", Scratch)); | |
35 | DBUG(("dhi = 0x%8x\n", TOS)); | |
36 | ||
37 | if( ((TOS == 0) && (Scratch >= 0)) || | |
38 | ((TOS == -1) && (Scratch < 0))) | |
39 | { | |
40 | /* <= 32 bit precision. */ | |
41 | FP_TOS = ((PF_FLOAT) Scratch); /* Convert dlo and push on FP stack. */ | |
42 | } | |
43 | else /* > 32 bit precision. */ | |
44 | { | |
45 | fpTemp = ((PF_FLOAT) TOS); /* dhi */ | |
46 | fpTemp *= FP_DHI1; | |
47 | fpScratch = ( (PF_FLOAT) ((ucell_t)Scratch) ); /* Convert TOS and push on FP stack. */ | |
48 | FP_TOS = fpTemp + fpScratch; | |
49 | } | |
50 | M_DROP; | |
51 | /* printf("d2f = %g\n", FP_TOS); */ | |
52 | break; | |
53 | ||
54 | case ID_FP_FSTORE: /* ( addr -- ) ( F: r -- ) */ | |
55 | #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC)) | |
56 | if( IN_CODE_DIC(TOS) ) | |
57 | { | |
58 | WRITE_FLOAT_DIC( (PF_FLOAT *) TOS, FP_TOS ); | |
59 | } | |
60 | else | |
61 | { | |
62 | *((PF_FLOAT *) TOS) = FP_TOS; | |
63 | } | |
64 | #else | |
65 | *((PF_FLOAT *) TOS) = FP_TOS; | |
66 | #endif | |
67 | M_FP_DROP; /* drop FP value */ | |
68 | M_DROP; /* drop addr */ | |
69 | break; | |
70 | ||
71 | case ID_FP_FTIMES: /* ( F: r1 r2 -- r1*r2 ) */ | |
72 | FP_TOS = M_FP_POP * FP_TOS; | |
73 | break; | |
74 | ||
75 | case ID_FP_FPLUS: /* ( F: r1 r2 -- r1+r2 ) */ | |
76 | FP_TOS = M_FP_POP + FP_TOS; | |
77 | break; | |
78 | ||
79 | case ID_FP_FMINUS: /* ( F: r1 r2 -- r1-r2 ) */ | |
80 | FP_TOS = M_FP_POP - FP_TOS; | |
81 | break; | |
82 | ||
83 | case ID_FP_FSLASH: /* ( F: r1 r2 -- r1/r2 ) */ | |
84 | FP_TOS = M_FP_POP / FP_TOS; | |
85 | break; | |
86 | ||
87 | case ID_FP_F_ZERO_LESS_THAN: /* ( -- flag ) ( F: r -- ) */ | |
88 | PUSH_TOS; | |
89 | TOS = (FP_TOS < 0.0) ? FTRUE : FFALSE ; | |
90 | M_FP_DROP; | |
91 | break; | |
92 | ||
93 | case ID_FP_F_ZERO_EQUALS: /* ( -- flag ) ( F: r -- ) */ | |
94 | PUSH_TOS; | |
95 | TOS = (FP_TOS == 0.0) ? FTRUE : FFALSE ; | |
96 | M_FP_DROP; | |
97 | break; | |
98 | ||
99 | case ID_FP_F_LESS_THAN: /* ( -- flag ) ( F: r1 r2 -- ) */ | |
100 | PUSH_TOS; | |
101 | TOS = (M_FP_POP < FP_TOS) ? FTRUE : FFALSE ; | |
102 | M_FP_DROP; | |
103 | break; | |
104 | ||
105 | case ID_FP_F_TO_D: /* ( -- dlo dhi) ( F: r -- ) */ | |
106 | /* printf("f2d = %g\n", FP_TOS); */ | |
107 | { | |
108 | ucell_t dlo; | |
109 | cell_t dhi; | |
110 | int ifNeg; | |
111 | /* Convert absolute value, then negate D if negative. */ | |
112 | PUSH_TOS; /* Save old TOS */ | |
113 | fpTemp = FP_TOS; | |
114 | M_FP_DROP; | |
115 | ifNeg = (fpTemp < 0.0); | |
116 | if( ifNeg ) | |
117 | { | |
118 | fpTemp = 0.0 - fpTemp; | |
119 | } | |
120 | fpScratch = fpTemp / FP_DHI1; | |
121 | /* printf("f2d - fpScratch = %g\n", fpScratch); */ | |
122 | dhi = (cell_t) fpScratch; /* dhi */ | |
123 | fpScratch = ((PF_FLOAT) dhi) * FP_DHI1; | |
124 | /* printf("f2d - , dhi = 0x%x, fpScratch = %g\n", dhi, fpScratch); */ | |
125 | ||
126 | fpTemp = fpTemp - fpScratch; /* Remainder */ | |
127 | dlo = (ucell_t) fpTemp; | |
128 | /* printf("f2d - , dlo = 0x%x, fpTemp = %g\n", dlo, fpTemp); */ | |
129 | if( ifNeg ) | |
130 | { | |
131 | dlo = 0 - dlo; | |
132 | dhi = 0 - dhi - 1; | |
133 | } | |
134 | /* Push onto stack. */ | |
135 | TOS = dlo; | |
136 | PUSH_TOS; | |
137 | TOS = dhi; | |
138 | } | |
139 | break; | |
140 | ||
141 | case ID_FP_FFETCH: /* ( addr -- ) ( F: -- r ) */ | |
142 | PUSH_FP_TOS; | |
143 | #if (defined(PF_BIG_ENDIAN_DIC) || defined(PF_LITTLE_ENDIAN_DIC)) | |
144 | if( IN_CODE_DIC(TOS) ) | |
145 | { | |
146 | FP_TOS = READ_FLOAT_DIC( (PF_FLOAT *) TOS ); | |
147 | } | |
148 | else | |
149 | { | |
150 | FP_TOS = *((PF_FLOAT *) TOS); | |
151 | } | |
152 | #else | |
153 | FP_TOS = *((PF_FLOAT *) TOS); | |
154 | #endif | |
155 | M_DROP; | |
156 | break; | |
157 | ||
158 | case ID_FP_FDEPTH: /* ( -- n ) ( F: -- ) */ | |
159 | PUSH_TOS; | |
160 | /* Add 1 to account for FP_TOS in cached in register. */ | |
161 | TOS = (( M_FP_SPZERO - FP_STKPTR) + 1); | |
162 | break; | |
163 | ||
164 | case ID_FP_FDROP: /* ( -- ) ( F: r -- ) */ | |
165 | M_FP_DROP; | |
166 | break; | |
167 | ||
168 | case ID_FP_FDUP: /* ( -- ) ( F: r -- r r ) */ | |
169 | PUSH_FP_TOS; | |
170 | break; | |
171 | ||
172 | case ID_FP_FLOAT_PLUS: /* ( addr1 -- addr2 ) ( F: -- ) */ | |
173 | TOS = TOS + sizeof(PF_FLOAT); | |
174 | break; | |
175 | ||
176 | case ID_FP_FLOATS: /* ( n -- size ) ( F: -- ) */ | |
177 | TOS = TOS * sizeof(PF_FLOAT); | |
178 | break; | |
179 | ||
180 | case ID_FP_FLOOR: /* ( -- ) ( F: r1 -- r2 ) */ | |
181 | FP_TOS = (PF_FLOAT) fp_floor( FP_TOS ); | |
182 | break; | |
183 | ||
184 | case ID_FP_FMAX: /* ( -- ) ( F: r1 r2 -- r3 ) */ | |
185 | fpScratch = M_FP_POP; | |
186 | FP_TOS = ( FP_TOS > fpScratch ) ? FP_TOS : fpScratch ; | |
187 | break; | |
188 | ||
189 | case ID_FP_FMIN: /* ( -- ) ( F: r1 r2 -- r3 ) */ | |
190 | fpScratch = M_FP_POP; | |
191 | FP_TOS = ( FP_TOS < fpScratch ) ? FP_TOS : fpScratch ; | |
192 | break; | |
193 | ||
194 | case ID_FP_FNEGATE: | |
195 | FP_TOS = -FP_TOS; | |
196 | break; | |
197 | ||
198 | case ID_FP_FOVER: /* ( -- ) ( F: r1 r2 -- r1 r2 r1 ) */ | |
199 | PUSH_FP_TOS; | |
200 | FP_TOS = M_FP_STACK(1); | |
201 | break; | |
202 | ||
203 | case ID_FP_FROT: /* ( -- ) ( F: r1 r2 r3 -- r2 r3 r1 ) */ | |
204 | fpScratch = M_FP_POP; /* r2 */ | |
205 | fpTemp = M_FP_POP; /* r1 */ | |
206 | M_FP_PUSH( fpScratch ); /* r2 */ | |
207 | PUSH_FP_TOS; /* r3 */ | |
208 | FP_TOS = fpTemp; /* r1 */ | |
209 | break; | |
210 | ||
211 | case ID_FP_FROUND: | |
3a940535 | 212 | PUSH_TOS; |
65279741 | 213 | TOS = (cell_t)fp_round(FP_TOS); |
3a940535 | 214 | M_FP_DROP; |
8e9db35f PB |
215 | break; |
216 | ||
217 | case ID_FP_FSWAP: /* ( -- ) ( F: r1 r2 -- r2 r1 ) */ | |
218 | fpScratch = FP_TOS; | |
219 | FP_TOS = *FP_STKPTR; | |
220 | *FP_STKPTR = fpScratch; | |
221 | break; | |
222 | ||
223 | case ID_FP_FSTAR_STAR: /* ( -- ) ( F: r1 r2 -- r1^r2 ) */ | |
224 | fpScratch = M_FP_POP; | |
225 | FP_TOS = (PF_FLOAT) fp_pow(fpScratch, FP_TOS); | |
226 | break; | |
227 | ||
228 | case ID_FP_FABS: /* ( -- ) ( F: r1 -- r2 ) */ | |
229 | FP_TOS = (PF_FLOAT) fp_fabs( FP_TOS ); | |
230 | break; | |
231 | ||
232 | case ID_FP_FACOS: /* ( -- ) ( F: r1 -- r2 ) */ | |
233 | FP_TOS = (PF_FLOAT) fp_acos( FP_TOS ); | |
234 | break; | |
235 | ||
236 | case ID_FP_FACOSH: /* ( -- ) ( F: r1 -- r2 ) */ | |
237 | /* fp_acosh(x) = fp_log(y + sqrt(y^2 - 1) */ | |
238 | FP_TOS = (PF_FLOAT) fp_log(FP_TOS + (fp_sqrt((FP_TOS * FP_TOS) - 1))); | |
239 | break; | |
240 | ||
241 | case ID_FP_FALOG: /* ( -- ) ( F: r1 -- r2 ) */ | |
242 | FP_TOS = (PF_FLOAT) fp_pow(10.0,FP_TOS); | |
243 | break; | |
244 | ||
245 | case ID_FP_FASIN: /* ( -- ) ( F: r1 -- r2 ) */ | |
246 | FP_TOS = (PF_FLOAT) fp_asin( FP_TOS ); | |
247 | break; | |
248 | ||
249 | case ID_FP_FASINH: /* ( -- ) ( F: r1 -- r2 ) */ | |
250 | /* asinh(x) = fp_log(y + fp_sqrt(y^2 + 1) */ | |
251 | FP_TOS = (PF_FLOAT) fp_log(FP_TOS + (fp_sqrt((FP_TOS * FP_TOS) + 1))); | |
252 | break; | |
253 | ||
254 | case ID_FP_FATAN: /* ( -- ) ( F: r1 -- r2 ) */ | |
255 | FP_TOS = (PF_FLOAT) fp_atan( FP_TOS ); | |
256 | break; | |
257 | ||
258 | case ID_FP_FATAN2: /* ( -- ) ( F: r1 r2 -- atan(r1/r2) ) */ | |
259 | fpTemp = M_FP_POP; | |
260 | FP_TOS = (PF_FLOAT) fp_atan2( fpTemp, FP_TOS ); | |
261 | break; | |
262 | ||
263 | case ID_FP_FATANH: /* ( -- ) ( F: r1 -- r2 ) */ | |
264 | FP_TOS = (PF_FLOAT) (0.5 * fp_log((1 + FP_TOS) / (1 - FP_TOS))); | |
265 | break; | |
266 | ||
267 | case ID_FP_FCOS: /* ( -- ) ( F: r1 -- r2 ) */ | |
268 | FP_TOS = (PF_FLOAT) fp_cos( FP_TOS ); | |
269 | break; | |
270 | ||
271 | case ID_FP_FCOSH: /* ( -- ) ( F: r1 -- r2 ) */ | |
272 | FP_TOS = (PF_FLOAT) fp_cosh( FP_TOS ); | |
273 | break; | |
274 | ||
275 | #ifndef PF_NO_SHELL | |
276 | case ID_FP_FLITERAL: | |
277 | ffFPLiteral( FP_TOS ); | |
278 | M_FP_DROP; | |
279 | endcase; | |
280 | #endif /* !PF_NO_SHELL */ | |
281 | ||
282 | case ID_FP_FLITERAL_P: | |
283 | PUSH_FP_TOS; | |
284 | #if 0 | |
285 | /* Some wimpy compilers can't handle this! */ | |
286 | FP_TOS = *(((PF_FLOAT *)InsPtr)++); | |
287 | #else | |
288 | { | |
289 | PF_FLOAT *fptr; | |
290 | fptr = (PF_FLOAT *)InsPtr; | |
291 | FP_TOS = READ_FLOAT_DIC( fptr++ ); | |
292 | InsPtr = (cell_t *) fptr; | |
293 | } | |
294 | #endif | |
295 | endcase; | |
296 | ||
297 | case ID_FP_FLN: /* ( -- ) ( F: r1 -- r2 ) */ | |
298 | FP_TOS = (PF_FLOAT) fp_log(FP_TOS); | |
299 | break; | |
300 | ||
301 | case ID_FP_FLNP1: /* ( -- ) ( F: r1 -- r2 ) */ | |
302 | FP_TOS = (PF_FLOAT) (fp_log(FP_TOS) + 1.0); | |
303 | break; | |
304 | ||
305 | case ID_FP_FLOG: /* ( -- ) ( F: r1 -- r2 ) */ | |
306 | FP_TOS = (PF_FLOAT) fp_log10( FP_TOS ); | |
307 | break; | |
308 | ||
309 | case ID_FP_FSIN: /* ( -- ) ( F: r1 -- r2 ) */ | |
310 | FP_TOS = (PF_FLOAT) fp_sin( FP_TOS ); | |
311 | break; | |
312 | ||
313 | case ID_FP_FSINCOS: /* ( -- ) ( F: r1 -- r2 r3 ) */ | |
314 | M_FP_PUSH((PF_FLOAT) fp_sin(FP_TOS)); | |
315 | FP_TOS = (PF_FLOAT) fp_cos(FP_TOS); | |
316 | break; | |
317 | ||
318 | case ID_FP_FSINH: /* ( -- ) ( F: r1 -- r2 ) */ | |
319 | FP_TOS = (PF_FLOAT) fp_sinh( FP_TOS ); | |
320 | break; | |
321 | ||
322 | case ID_FP_FSQRT: /* ( -- ) ( F: r1 -- r2 ) */ | |
323 | FP_TOS = (PF_FLOAT) fp_sqrt( FP_TOS ); | |
324 | break; | |
325 | ||
326 | case ID_FP_FTAN: /* ( -- ) ( F: r1 -- r2 ) */ | |
327 | FP_TOS = (PF_FLOAT) fp_tan( FP_TOS ); | |
328 | break; | |
329 | ||
330 | case ID_FP_FTANH: /* ( -- ) ( F: r1 -- r2 ) */ | |
331 | FP_TOS = (PF_FLOAT) fp_tanh( FP_TOS ); | |
332 | break; | |
333 | ||
334 | case ID_FP_FPICK: /* ( n -- ) ( F: -- f[n] ) */ | |
335 | PUSH_FP_TOS; /* push cached floats into RAM */ | |
336 | FP_TOS = FP_STKPTR[TOS]; /* 0 FPICK gets top of FP stack */ | |
337 | M_DROP; | |
338 | break; | |
339 | ||
340 | ||
341 | #endif |