]>
Commit | Line | Data |
---|---|---|
1 | /* | |
2 | * tclXfmath.c -- | |
3 | * | |
4 | * Contains the TCL trig and floating point math functions. | |
5 | *----------------------------------------------------------------------------- | |
6 | * Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
7 | * | |
8 | * Permission to use, copy, modify, and distribute this software and its | |
9 | * documentation for any purpose and without fee is hereby granted, provided | |
10 | * that the above copyright notice appear in all copies. Karl Lehenbauer and | |
11 | * Mark Diekhans make no representations about the suitability of this | |
12 | * software for any purpose. It is provided "as is" without express or | |
13 | * implied warranty. | |
14 | *----------------------------------------------------------------------------- | |
15 | * $Id: tclXfmath.c,v 2.5 1992/11/09 07:58:13 markd Exp $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.h" | |
20 | #include <math.h> | |
21 | ||
22 | /* | |
23 | * Flag used to indicate if a floating point math routine is currently being | |
24 | * executed. Used to determine if a matherr belongs to Tcl. | |
25 | */ | |
26 | static int G_inTclFPMath = FALSE; | |
27 | ||
28 | /* | |
29 | * Flag indicating if a floating point math error occured during the execution | |
30 | * of a library routine called by a Tcl command. Will not be set by the trap | |
31 | * handler if the error did not occur while the `G_inTclFPMath' flag was | |
32 | * set. If the error did occur the error type and the name of the function | |
33 | * that got the error are save here. | |
34 | */ | |
35 | static int G_gotTclFPMathErr = FALSE; | |
36 | static int G_errorType; | |
37 | ||
38 | /* | |
39 | * Prototypes of internal functions. | |
40 | */ | |
41 | #ifdef TCL_IEEE_FP_MATH | |
42 | static int | |
43 | ReturnIEEEMathError _ANSI_ARGS_((Tcl_Interp *interp, | |
44 | double dbResult)); | |
45 | #else | |
46 | static int | |
47 | ReturnFPMathError _ANSI_ARGS_((Tcl_Interp *interp)); | |
48 | #endif | |
49 | ||
50 | static int | |
51 | Tcl_UnaryFloatFunction _ANSI_ARGS_((Tcl_Interp *interp, | |
52 | int argc, | |
53 | char **argv, | |
54 | double (*function)())); | |
55 | ||
56 | ||
57 | #ifdef TCL_IEEE_FP_MATH | |
58 | \f | |
59 | /* | |
60 | *----------------------------------------------------------------------------- | |
61 | * | |
62 | * ReturnIEEEMathError -- | |
63 | * Handle return of floating point errors on machines that use IEEE 745-1985 | |
64 | * error reporting instead of Unix matherr. Some machines support both and | |
65 | * on these, either option may be used. | |
66 | * Various tests are used to determine if a number is one of the special | |
67 | * values. Not-a-number is tested by comparing the number against itself | |
68 | * (x != x if x is NaN). Infinity is tested for by comparing against MAXDOUBLE. | |
69 | * | |
70 | * Parameters: | |
71 | * o interp (I) - Error is returned in result. | |
72 | * o dbResult (I) - Result of a function call that returned a special value. | |
73 | * Returns: | |
74 | * Always returns the value TCL_ERROR, so if can be called as the | |
75 | * argument to `return'. | |
76 | *----------------------------------------------------------------------------- | |
77 | */ | |
78 | static int | |
79 | ReturnIEEEMathError (interp, dbResult) | |
80 | Tcl_Interp *interp; | |
81 | double dbResult; | |
82 | { | |
83 | char *errorMsg; | |
84 | ||
85 | if (dbResult != dbResult) | |
86 | errorMsg = "domain"; | |
87 | else if (dbResult > MAXDOUBLE) | |
88 | errorMsg = "overflow"; | |
89 | else if (dbResult < -MAXDOUBLE) | |
90 | errorMsg = "underflow"; | |
91 | ||
92 | Tcl_AppendResult (interp, "floating point ", errorMsg, " error", | |
93 | (char *) NULL); | |
94 | return TCL_ERROR; | |
95 | } | |
96 | #else | |
97 | \f | |
98 | /* | |
99 | *----------------------------------------------------------------------------- | |
100 | * | |
101 | * ReturnFPMathError -- | |
102 | * Routine to set an interpreter result to contain a floating point | |
103 | * math error message. Will clear the `G_gotTclFPMathErr' flag. | |
104 | * This routine always returns the value TCL_ERROR, so if can be called | |
105 | * as the argument to `return'. | |
106 | * | |
107 | * Parameters: | |
108 | * o interp (I) - Error is returned in result. | |
109 | * Globals: | |
110 | * o G_gotTclFPMathErr (O) - Flag indicating an error occured, will be | |
111 | * cleared. | |
112 | * o G_errorType (I) - Type of error that occured. | |
113 | * Returns: | |
114 | * Always returns the value TCL_ERROR, so if can be called as the | |
115 | * argument to `return'. | |
116 | *----------------------------------------------------------------------------- | |
117 | */ | |
118 | static int | |
119 | ReturnFPMathError (interp) | |
120 | Tcl_Interp *interp; | |
121 | { | |
122 | char *errorMsg; | |
123 | ||
124 | switch (G_errorType) { | |
125 | case DOMAIN: | |
126 | errorMsg = "domain"; | |
127 | break; | |
128 | case SING: | |
129 | errorMsg = "singularity"; | |
130 | break; | |
131 | case OVERFLOW: | |
132 | errorMsg = "overflow"; | |
133 | break; | |
134 | case UNDERFLOW: | |
135 | errorMsg = "underflow"; | |
136 | break; | |
137 | case TLOSS: | |
138 | case PLOSS: | |
139 | errorMsg = "loss of significance"; | |
140 | break; | |
141 | } | |
142 | Tcl_AppendResult (interp, "floating point ", errorMsg, " error", | |
143 | (char *) NULL); | |
144 | G_gotTclFPMathErr = FALSE; /* Clear the flag. */ | |
145 | return TCL_ERROR; | |
146 | } | |
147 | #endif /* NO_MATH_ERR */ | |
148 | \f | |
149 | /* | |
150 | *----------------------------------------------------------------------------- | |
151 | * | |
152 | * Tcl_MathError -- | |
153 | * Tcl math error handler, should be called by an application `matherr' | |
154 | * routine to determine if an error was caused by Tcl code or by other | |
155 | * code in the application. If the error occured in Tcl code, flags will | |
156 | * be set so that a standard Tcl interpreter error can be returned. | |
157 | * | |
158 | * Paramenter: | |
159 | * o functionName (I) - The name of the function that got the error. From | |
160 | * the exception structure supplied to matherr. | |
161 | * o errorType (I) - The type of error that occured. From the exception | |
162 | * structure supplied to matherr. | |
163 | * Results: | |
164 | * Returns TRUE if the error was in Tcl code, in which case the | |
165 | * matherr routine calling this function should return non-zero so no | |
166 | * error message will be generated. FALSE if the error was not in Tcl | |
167 | * code, in which case the matherr routine can handle the error in any | |
168 | * manner it choses. | |
169 | * | |
170 | *----------------------------------------------------------------------------- | |
171 | */ | |
172 | int | |
173 | Tcl_MathError (functionName, errorType) | |
174 | char *functionName; | |
175 | int errorType; | |
176 | { | |
177 | ||
178 | if (G_inTclFPMath) { | |
179 | G_gotTclFPMathErr = TRUE; | |
180 | G_errorType = errorType; | |
181 | return TRUE; | |
182 | } else | |
183 | return FALSE; | |
184 | ||
185 | } | |
186 | \f | |
187 | /* | |
188 | *----------------------------------------------------------------------------- | |
189 | * | |
190 | * Tcl_UnaryFloatFunction -- | |
191 | * Helper routine that implements Tcl unary floating point | |
192 | * functions by validating parameters, converting the | |
193 | * argument, applying the function (the address of which | |
194 | * is passed as an argument), and converting the result to | |
195 | * a string and storing it in the result buffer | |
196 | * | |
197 | * Results: | |
198 | * Returns TCL_OK if number is present, conversion succeeded, | |
199 | * the function was performed, etc. | |
200 | * Return TCL_ERROR for any error; an appropriate error message | |
201 | * is placed in the result string in this case. | |
202 | * | |
203 | *----------------------------------------------------------------------------- | |
204 | */ | |
205 | static int | |
206 | Tcl_UnaryFloatFunction(interp, argc, argv, function) | |
207 | Tcl_Interp *interp; | |
208 | int argc; | |
209 | char **argv; | |
210 | double (*function)(); | |
211 | { | |
212 | double dbVal, dbResult; | |
213 | ||
214 | if (argc != 2) { | |
215 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " expr", | |
216 | (char *) NULL); | |
217 | return TCL_ERROR; | |
218 | } | |
219 | ||
220 | if (Tcl_ExprDouble (interp, argv [1], &dbVal) != TCL_OK) | |
221 | return TCL_ERROR; | |
222 | ||
223 | G_inTclFPMath = TRUE; | |
224 | dbResult = (*function)(dbVal); | |
225 | G_inTclFPMath = FALSE; | |
226 | ||
227 | #ifdef TCL_IEEE_FP_MATH | |
228 | if ((dbResult != dbResult) || | |
229 | (dbResult < -MAXDOUBLE) || | |
230 | (dbResult > MAXDOUBLE)) | |
231 | return ReturnIEEEMathError (interp, dbResult); | |
232 | #else | |
233 | if (G_gotTclFPMathErr) | |
234 | return ReturnFPMathError (interp); | |
235 | #endif | |
236 | ||
237 | Tcl_ReturnDouble (interp, dbResult); | |
238 | return TCL_OK; | |
239 | } | |
240 | \f | |
241 | /* | |
242 | *----------------------------------------------------------------------------- | |
243 | * | |
244 | * Tcl_AcosCmd -- | |
245 | * Implements the TCL arccosine command: | |
246 | * acos num | |
247 | * | |
248 | * Results: | |
249 | * Returns TCL_OK if number is present and conversion succeeds. | |
250 | * | |
251 | *----------------------------------------------------------------------------- | |
252 | */ | |
253 | int | |
254 | Tcl_AcosCmd(clientData, interp, argc, argv) | |
255 | ClientData clientData; | |
256 | Tcl_Interp *interp; | |
257 | int argc; | |
258 | char **argv; | |
259 | { | |
260 | return Tcl_UnaryFloatFunction(interp, argc, argv, acos); | |
261 | } | |
262 | \f | |
263 | /* | |
264 | *----------------------------------------------------------------------------- | |
265 | * | |
266 | * Tcl_AsinCmd -- | |
267 | * Implements the TCL arcsin command: | |
268 | * asin num | |
269 | * | |
270 | * Results: | |
271 | * Returns TCL_OK if number is present and conversion succeeds. | |
272 | * | |
273 | *----------------------------------------------------------------------------- | |
274 | */ | |
275 | int | |
276 | Tcl_AsinCmd(clientData, interp, argc, argv) | |
277 | ClientData clientData; | |
278 | Tcl_Interp *interp; | |
279 | int argc; | |
280 | char **argv; | |
281 | { | |
282 | return Tcl_UnaryFloatFunction(interp, argc, argv, asin); | |
283 | } | |
284 | \f | |
285 | /* | |
286 | *----------------------------------------------------------------------------- | |
287 | * | |
288 | * Tcl_AtanCmd -- | |
289 | * Implements the TCL arctangent command: | |
290 | * atan num | |
291 | * | |
292 | * Results: | |
293 | * Returns TCL_OK if number is present and conversion succeeds. | |
294 | * | |
295 | *----------------------------------------------------------------------------- | |
296 | */ | |
297 | int | |
298 | Tcl_AtanCmd(clientData, interp, argc, argv) | |
299 | ClientData clientData; | |
300 | Tcl_Interp *interp; | |
301 | int argc; | |
302 | char **argv; | |
303 | { | |
304 | return Tcl_UnaryFloatFunction(interp, argc, argv, atan); | |
305 | } | |
306 | \f | |
307 | /* | |
308 | *----------------------------------------------------------------------------- | |
309 | * | |
310 | * Tcl_CosCmd -- | |
311 | * Implements the TCL cosine command: | |
312 | * cos num | |
313 | * | |
314 | * Results: | |
315 | * Returns TCL_OK if number is present and conversion succeeds. | |
316 | * | |
317 | *----------------------------------------------------------------------------- | |
318 | */ | |
319 | int | |
320 | Tcl_CosCmd(clientData, interp, argc, argv) | |
321 | ClientData clientData; | |
322 | Tcl_Interp *interp; | |
323 | int argc; | |
324 | char **argv; | |
325 | { | |
326 | return Tcl_UnaryFloatFunction(interp, argc, argv, cos); | |
327 | } | |
328 | \f | |
329 | /* | |
330 | *----------------------------------------------------------------------------- | |
331 | * | |
332 | * Tcl_SinCmd -- | |
333 | * Implements the TCL sin command: | |
334 | * sin num | |
335 | * | |
336 | * Results: | |
337 | * Returns TCL_OK if number is present and conversion succeeds. | |
338 | * | |
339 | *----------------------------------------------------------------------------- | |
340 | */ | |
341 | int | |
342 | Tcl_SinCmd(clientData, interp, argc, argv) | |
343 | ClientData clientData; | |
344 | Tcl_Interp *interp; | |
345 | int argc; | |
346 | char **argv; | |
347 | { | |
348 | return Tcl_UnaryFloatFunction(interp, argc, argv, sin); | |
349 | } | |
350 | \f | |
351 | /* | |
352 | *----------------------------------------------------------------------------- | |
353 | * | |
354 | * Tcl_TanCmd -- | |
355 | * Implements the TCL tangent command: | |
356 | * tan num | |
357 | * | |
358 | * Results: | |
359 | * Returns TCL_OK if number is present and conversion succeeds. | |
360 | * | |
361 | *----------------------------------------------------------------------------- | |
362 | */ | |
363 | int | |
364 | Tcl_TanCmd(clientData, interp, argc, argv) | |
365 | ClientData clientData; | |
366 | Tcl_Interp *interp; | |
367 | int argc; | |
368 | char **argv; | |
369 | { | |
370 | return Tcl_UnaryFloatFunction(interp, argc, argv, tan); | |
371 | } | |
372 | \f | |
373 | /* | |
374 | *----------------------------------------------------------------------------- | |
375 | * | |
376 | * Tcl_CoshCmd -- | |
377 | * Implements the TCL hyperbolic cosine command: | |
378 | * cosh num | |
379 | * | |
380 | * Results: | |
381 | * Returns TCL_OK if number is present and conversion succeeds. | |
382 | * | |
383 | *----------------------------------------------------------------------------- | |
384 | */ | |
385 | int | |
386 | Tcl_CoshCmd(clientData, interp, argc, argv) | |
387 | ClientData clientData; | |
388 | Tcl_Interp *interp; | |
389 | int argc; | |
390 | char **argv; | |
391 | { | |
392 | return Tcl_UnaryFloatFunction(interp, argc, argv, cosh); | |
393 | } | |
394 | \f | |
395 | /* | |
396 | *----------------------------------------------------------------------------- | |
397 | * | |
398 | * Tcl_SinhCmd -- | |
399 | * Implements the TCL hyperbolic sin command: | |
400 | * sinh num | |
401 | * | |
402 | * Results: | |
403 | * Returns TCL_OK if number is present and conversion succeeds. | |
404 | * | |
405 | *----------------------------------------------------------------------------- | |
406 | */ | |
407 | int | |
408 | Tcl_SinhCmd(clientData, interp, argc, argv) | |
409 | ClientData clientData; | |
410 | Tcl_Interp *interp; | |
411 | int argc; | |
412 | char **argv; | |
413 | { | |
414 | return Tcl_UnaryFloatFunction(interp, argc, argv, sinh); | |
415 | } | |
416 | \f | |
417 | /* | |
418 | *----------------------------------------------------------------------------- | |
419 | * | |
420 | * Tcl_TanhCmd -- | |
421 | * Implements the TCL hyperbolic tangent command: | |
422 | * tanh num | |
423 | * | |
424 | * Results: | |
425 | * Returns TCL_OK if number is present and conversion succeeds. | |
426 | * | |
427 | *----------------------------------------------------------------------------- | |
428 | */ | |
429 | int | |
430 | Tcl_TanhCmd(clientData, interp, argc, argv) | |
431 | ClientData clientData; | |
432 | Tcl_Interp *interp; | |
433 | int argc; | |
434 | char **argv; | |
435 | { | |
436 | return Tcl_UnaryFloatFunction(interp, argc, argv, tanh); | |
437 | } | |
438 | \f | |
439 | /* | |
440 | *----------------------------------------------------------------------------- | |
441 | * | |
442 | * Tcl_ExpCmd -- | |
443 | * Implements the TCL exponent command: | |
444 | * exp num | |
445 | * | |
446 | * Results: | |
447 | * Returns TCL_OK if number is present and conversion succeeds. | |
448 | * | |
449 | *----------------------------------------------------------------------------- | |
450 | */ | |
451 | int | |
452 | Tcl_ExpCmd(clientData, interp, argc, argv) | |
453 | ClientData clientData; | |
454 | Tcl_Interp *interp; | |
455 | int argc; | |
456 | char **argv; | |
457 | { | |
458 | return Tcl_UnaryFloatFunction(interp, argc, argv, exp); | |
459 | } | |
460 | \f | |
461 | /* | |
462 | *----------------------------------------------------------------------------- | |
463 | * | |
464 | * Tcl_LogCmd -- | |
465 | * Implements the TCL logarithm command: | |
466 | * log num | |
467 | * | |
468 | * Results: | |
469 | * Returns TCL_OK if number is present and conversion succeeds. | |
470 | * | |
471 | *----------------------------------------------------------------------------- | |
472 | */ | |
473 | int | |
474 | Tcl_LogCmd(clientData, interp, argc, argv) | |
475 | ClientData clientData; | |
476 | Tcl_Interp *interp; | |
477 | int argc; | |
478 | char **argv; | |
479 | { | |
480 | return Tcl_UnaryFloatFunction(interp, argc, argv, log); | |
481 | } | |
482 | \f | |
483 | /* | |
484 | *----------------------------------------------------------------------------- | |
485 | * | |
486 | * Tcl_Log10Cmd -- | |
487 | * Implements the TCL base-10 logarithm command: | |
488 | * log10 num | |
489 | * | |
490 | * Results: | |
491 | * Returns TCL_OK if number is present and conversion succeeds. | |
492 | * | |
493 | *----------------------------------------------------------------------------- | |
494 | */ | |
495 | int | |
496 | Tcl_Log10Cmd(clientData, interp, argc, argv) | |
497 | ClientData clientData; | |
498 | Tcl_Interp *interp; | |
499 | int argc; | |
500 | char **argv; | |
501 | { | |
502 | return Tcl_UnaryFloatFunction(interp, argc, argv, log10); | |
503 | } | |
504 | \f | |
505 | /* | |
506 | *----------------------------------------------------------------------------- | |
507 | * | |
508 | * Tcl_SqrtCmd -- | |
509 | * Implements the TCL square root command: | |
510 | * sqrt num | |
511 | * | |
512 | * Results: | |
513 | * Returns TCL_OK if number is present and conversion succeeds. | |
514 | * | |
515 | *----------------------------------------------------------------------------- | |
516 | */ | |
517 | int | |
518 | Tcl_SqrtCmd(clientData, interp, argc, argv) | |
519 | ClientData clientData; | |
520 | Tcl_Interp *interp; | |
521 | int argc; | |
522 | char **argv; | |
523 | { | |
524 | return Tcl_UnaryFloatFunction(interp, argc, argv, sqrt); | |
525 | } | |
526 | \f | |
527 | /* | |
528 | *----------------------------------------------------------------------------- | |
529 | * | |
530 | * Tcl_FabsCmd -- | |
531 | * Implements the TCL floating point absolute value command: | |
532 | * fabs num | |
533 | * | |
534 | * Results: | |
535 | * Returns TCL_OK if number is present and conversion succeeds. | |
536 | * | |
537 | *----------------------------------------------------------------------------- | |
538 | */ | |
539 | int | |
540 | Tcl_FabsCmd(clientData, interp, argc, argv) | |
541 | ClientData clientData; | |
542 | Tcl_Interp *interp; | |
543 | int argc; | |
544 | char **argv; | |
545 | { | |
546 | return Tcl_UnaryFloatFunction(interp, argc, argv, fabs); | |
547 | } | |
548 | \f | |
549 | /* | |
550 | *----------------------------------------------------------------------------- | |
551 | * | |
552 | * Tcl_FloorCmd -- | |
553 | * Implements the TCL floor command: | |
554 | * floor num | |
555 | * | |
556 | * Results: | |
557 | * Returns TCL_OK if number is present and conversion succeeds. | |
558 | * | |
559 | *----------------------------------------------------------------------------- | |
560 | */ | |
561 | int | |
562 | Tcl_FloorCmd(clientData, interp, argc, argv) | |
563 | ClientData clientData; | |
564 | Tcl_Interp *interp; | |
565 | int argc; | |
566 | char **argv; | |
567 | { | |
568 | return Tcl_UnaryFloatFunction(interp, argc, argv, floor); | |
569 | } | |
570 | \f | |
571 | /* | |
572 | *----------------------------------------------------------------------------- | |
573 | * | |
574 | * Tcl_CeilCmd -- | |
575 | * Implements the TCL ceil command: | |
576 | * ceil num | |
577 | * | |
578 | * Results: | |
579 | * Returns TCL_OK if number is present and conversion succeeds. | |
580 | * | |
581 | *----------------------------------------------------------------------------- | |
582 | */ | |
583 | int | |
584 | Tcl_CeilCmd(clientData, interp, argc, argv) | |
585 | ClientData clientData; | |
586 | Tcl_Interp *interp; | |
587 | int argc; | |
588 | char **argv; | |
589 | { | |
590 | return Tcl_UnaryFloatFunction(interp, argc, argv, ceil); | |
591 | } | |
592 | \f | |
593 | /* | |
594 | *----------------------------------------------------------------------------- | |
595 | * | |
596 | * Tcl_FmodCmd -- | |
597 | * Implements the TCL floating modulo command: | |
598 | * fmod num1 num2 | |
599 | * | |
600 | * Results: | |
601 | * Returns TCL_OK if number is present and conversion succeeds. | |
602 | * | |
603 | *----------------------------------------------------------------------------- | |
604 | */ | |
605 | int | |
606 | Tcl_FmodCmd(clientData, interp, argc, argv) | |
607 | ClientData clientData; | |
608 | Tcl_Interp *interp; | |
609 | int argc; | |
610 | char **argv; | |
611 | { | |
612 | double dbVal, dbDivisor, dbResult; | |
613 | ||
614 | if (argc != 3) { | |
615 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " expr divisor", | |
616 | (char *) NULL); | |
617 | return TCL_ERROR; | |
618 | } | |
619 | ||
620 | if (Tcl_ExprDouble (interp, argv [1], &dbVal) != TCL_OK) | |
621 | return TCL_ERROR; | |
622 | ||
623 | if (Tcl_ExprDouble (interp, argv [2], &dbDivisor) != TCL_OK) | |
624 | return TCL_ERROR; | |
625 | ||
626 | G_inTclFPMath = TRUE; | |
627 | dbResult = fmod (dbVal, dbDivisor); | |
628 | G_inTclFPMath = FALSE; | |
629 | ||
630 | #ifdef TCL_IEEE_FP_MATH | |
631 | if ((dbResult != dbResult) || | |
632 | (dbResult < -MAXDOUBLE) || | |
633 | (dbResult > MAXDOUBLE)) | |
634 | return ReturnIEEEMathError (interp, dbResult); | |
635 | #else | |
636 | if (G_gotTclFPMathErr) | |
637 | return ReturnFPMathError (interp); | |
638 | #endif | |
639 | ||
640 | Tcl_ReturnDouble (interp, dbResult); | |
641 | return TCL_OK; | |
642 | } | |
643 | \f | |
644 | /* | |
645 | *----------------------------------------------------------------------------- | |
646 | * | |
647 | * Tcl_PowCmd -- | |
648 | * Implements the TCL power (exponentiation) command: | |
649 | * pow num1 num2 | |
650 | * | |
651 | * Results: | |
652 | * Returns TCL_OK if number is present and conversion succeeds. | |
653 | * | |
654 | *----------------------------------------------------------------------------- | |
655 | */ | |
656 | int | |
657 | Tcl_PowCmd(clientData, interp, argc, argv) | |
658 | ClientData clientData; | |
659 | Tcl_Interp *interp; | |
660 | int argc; | |
661 | char **argv; | |
662 | { | |
663 | double dbVal, dbExp, dbResult; | |
664 | ||
665 | if (argc != 3) { | |
666 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " expr exp", | |
667 | (char *) NULL); | |
668 | return TCL_ERROR; | |
669 | } | |
670 | ||
671 | if (Tcl_ExprDouble (interp, argv [1], &dbVal) != TCL_OK) | |
672 | return TCL_ERROR; | |
673 | ||
674 | if (Tcl_ExprDouble (interp, argv [2], &dbExp) != TCL_OK) | |
675 | return TCL_ERROR; | |
676 | ||
677 | G_inTclFPMath = TRUE; | |
678 | dbResult = pow (dbVal,dbExp); | |
679 | G_inTclFPMath = FALSE; | |
680 | ||
681 | #ifdef TCL_IEEE_FP_MATH | |
682 | if ((dbResult != dbResult) || | |
683 | (dbResult < -MAXDOUBLE) || | |
684 | (dbResult > MAXDOUBLE)) | |
685 | return ReturnIEEEMathError (interp, dbResult); | |
686 | #else | |
687 | if (G_gotTclFPMathErr) | |
688 | return ReturnFPMathError (interp); | |
689 | #endif | |
690 | ||
691 | Tcl_ReturnDouble (interp, dbResult); | |
692 | return TCL_OK; | |
693 | } |