]>
git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxfmat.c
4 * Contains the TCL trig and floating point math functions.
5 *-----------------------------------------------------------------------------
6 * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
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
14 *-----------------------------------------------------------------------------
15 * $Id: tclXfmath.c,v 2.5 1992/11/09 07:58:13 markd Exp $
16 *-----------------------------------------------------------------------------
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.
26 static int G_inTclFPMath
= FALSE
;
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.
35 static int G_gotTclFPMathErr
= FALSE
;
36 static int G_errorType
;
39 * Prototypes of internal functions.
41 #ifdef TCL_IEEE_FP_MATH
43 ReturnIEEEMathError
_ANSI_ARGS_((Tcl_Interp
*interp
,
47 ReturnFPMathError
_ANSI_ARGS_((Tcl_Interp
*interp
));
51 Tcl_UnaryFloatFunction
_ANSI_ARGS_((Tcl_Interp
*interp
,
54 double (*function
)()));
57 #ifdef TCL_IEEE_FP_MATH
60 *-----------------------------------------------------------------------------
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.
71 * o interp (I) - Error is returned in result.
72 * o dbResult (I) - Result of a function call that returned a special value.
74 * Always returns the value TCL_ERROR, so if can be called as the
75 * argument to `return'.
76 *-----------------------------------------------------------------------------
79 ReturnIEEEMathError (interp
, dbResult
)
85 if (dbResult
!= dbResult
)
87 else if (dbResult
> MAXDOUBLE
)
88 errorMsg
= "overflow";
89 else if (dbResult
< -MAXDOUBLE
)
90 errorMsg
= "underflow";
92 Tcl_AppendResult (interp
, "floating point ", errorMsg
, " error",
99 *-----------------------------------------------------------------------------
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'.
108 * o interp (I) - Error is returned in result.
110 * o G_gotTclFPMathErr (O) - Flag indicating an error occured, will be
112 * o G_errorType (I) - Type of error that occured.
114 * Always returns the value TCL_ERROR, so if can be called as the
115 * argument to `return'.
116 *-----------------------------------------------------------------------------
119 ReturnFPMathError (interp
)
123 Tcl_AppendResult (interp
, "floating point error",
125 G_gotTclFPMathErr
= FALSE
; /* Clear the flag. */
128 #endif /* NO_MATH_ERR */
131 *-----------------------------------------------------------------------------
134 * Tcl math error handler, should be called by an application `matherr'
135 * routine to determine if an error was caused by Tcl code or by other
136 * code in the application. If the error occured in Tcl code, flags will
137 * be set so that a standard Tcl interpreter error can be returned.
140 * o functionName (I) - The name of the function that got the error. From
141 * the exception structure supplied to matherr.
142 * o errorType (I) - The type of error that occured. From the exception
143 * structure supplied to matherr.
145 * Returns TRUE if the error was in Tcl code, in which case the
146 * matherr routine calling this function should return non-zero so no
147 * error message will be generated. FALSE if the error was not in Tcl
148 * code, in which case the matherr routine can handle the error in any
151 *-----------------------------------------------------------------------------
154 Tcl_MathError (functionName
, errorType
)
160 G_gotTclFPMathErr
= TRUE
;
161 G_errorType
= errorType
;
169 *-----------------------------------------------------------------------------
171 * Tcl_UnaryFloatFunction --
172 * Helper routine that implements Tcl unary floating point
173 * functions by validating parameters, converting the
174 * argument, applying the function (the address of which
175 * is passed as an argument), and converting the result to
176 * a string and storing it in the result buffer
179 * Returns TCL_OK if number is present, conversion succeeded,
180 * the function was performed, etc.
181 * Return TCL_ERROR for any error; an appropriate error message
182 * is placed in the result string in this case.
184 *-----------------------------------------------------------------------------
187 Tcl_UnaryFloatFunction(interp
, argc
, argv
, function
)
191 double (*function
)();
193 double dbVal
, dbResult
;
196 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr",
201 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
204 G_inTclFPMath
= TRUE
;
205 dbResult
= (*function
)(dbVal
);
206 G_inTclFPMath
= FALSE
;
208 #ifdef TCL_IEEE_FP_MATH
209 if ((dbResult
!= dbResult
) ||
210 (dbResult
< -MAXDOUBLE
) ||
211 (dbResult
> MAXDOUBLE
))
212 return ReturnIEEEMathError (interp
, dbResult
);
214 if (G_gotTclFPMathErr
)
215 return ReturnFPMathError (interp
);
218 Tcl_ReturnDouble (interp
, dbResult
);
223 *-----------------------------------------------------------------------------
226 * Implements the TCL arccosine command:
230 * Returns TCL_OK if number is present and conversion succeeds.
232 *-----------------------------------------------------------------------------
235 Tcl_AcosCmd(clientData
, interp
, argc
, argv
)
236 ClientData clientData
;
241 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, acos
);
245 *-----------------------------------------------------------------------------
248 * Implements the TCL arcsin command:
252 * Returns TCL_OK if number is present and conversion succeeds.
254 *-----------------------------------------------------------------------------
257 Tcl_AsinCmd(clientData
, interp
, argc
, argv
)
258 ClientData clientData
;
263 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, asin
);
267 *-----------------------------------------------------------------------------
270 * Implements the TCL arctangent command:
274 * Returns TCL_OK if number is present and conversion succeeds.
276 *-----------------------------------------------------------------------------
279 Tcl_AtanCmd(clientData
, interp
, argc
, argv
)
280 ClientData clientData
;
285 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, atan
);
289 *-----------------------------------------------------------------------------
292 * Implements the TCL cosine command:
296 * Returns TCL_OK if number is present and conversion succeeds.
298 *-----------------------------------------------------------------------------
301 Tcl_CosCmd(clientData
, interp
, argc
, argv
)
302 ClientData clientData
;
307 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, cos
);
311 *-----------------------------------------------------------------------------
314 * Implements the TCL sin command:
318 * Returns TCL_OK if number is present and conversion succeeds.
320 *-----------------------------------------------------------------------------
323 Tcl_SinCmd(clientData
, interp
, argc
, argv
)
324 ClientData clientData
;
329 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sin
);
333 *-----------------------------------------------------------------------------
336 * Implements the TCL tangent command:
340 * Returns TCL_OK if number is present and conversion succeeds.
342 *-----------------------------------------------------------------------------
345 Tcl_TanCmd(clientData
, interp
, argc
, argv
)
346 ClientData clientData
;
351 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, tan
);
355 *-----------------------------------------------------------------------------
358 * Implements the TCL hyperbolic cosine command:
362 * Returns TCL_OK if number is present and conversion succeeds.
364 *-----------------------------------------------------------------------------
367 Tcl_CoshCmd(clientData
, interp
, argc
, argv
)
368 ClientData clientData
;
373 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, cosh
);
377 *-----------------------------------------------------------------------------
380 * Implements the TCL hyperbolic sin command:
384 * Returns TCL_OK if number is present and conversion succeeds.
386 *-----------------------------------------------------------------------------
389 Tcl_SinhCmd(clientData
, interp
, argc
, argv
)
390 ClientData clientData
;
395 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sinh
);
399 *-----------------------------------------------------------------------------
402 * Implements the TCL hyperbolic tangent command:
406 * Returns TCL_OK if number is present and conversion succeeds.
408 *-----------------------------------------------------------------------------
411 Tcl_TanhCmd(clientData
, interp
, argc
, argv
)
412 ClientData clientData
;
417 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, tanh
);
421 *-----------------------------------------------------------------------------
424 * Implements the TCL exponent command:
428 * Returns TCL_OK if number is present and conversion succeeds.
430 *-----------------------------------------------------------------------------
433 Tcl_ExpCmd(clientData
, interp
, argc
, argv
)
434 ClientData clientData
;
439 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, exp
);
443 *-----------------------------------------------------------------------------
446 * Implements the TCL logarithm command:
450 * Returns TCL_OK if number is present and conversion succeeds.
452 *-----------------------------------------------------------------------------
455 Tcl_LogCmd(clientData
, interp
, argc
, argv
)
456 ClientData clientData
;
461 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, log
);
465 *-----------------------------------------------------------------------------
468 * Implements the TCL base-10 logarithm command:
472 * Returns TCL_OK if number is present and conversion succeeds.
474 *-----------------------------------------------------------------------------
477 Tcl_Log10Cmd(clientData
, interp
, argc
, argv
)
478 ClientData clientData
;
483 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, log10
);
487 *-----------------------------------------------------------------------------
490 * Implements the TCL square root command:
494 * Returns TCL_OK if number is present and conversion succeeds.
496 *-----------------------------------------------------------------------------
499 Tcl_SqrtCmd(clientData
, interp
, argc
, argv
)
500 ClientData clientData
;
505 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sqrt
);
509 *-----------------------------------------------------------------------------
512 * Implements the TCL floating point absolute value command:
516 * Returns TCL_OK if number is present and conversion succeeds.
518 *-----------------------------------------------------------------------------
521 Tcl_FabsCmd(clientData
, interp
, argc
, argv
)
522 ClientData clientData
;
527 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, fabs
);
531 *-----------------------------------------------------------------------------
534 * Implements the TCL floor command:
538 * Returns TCL_OK if number is present and conversion succeeds.
540 *-----------------------------------------------------------------------------
543 Tcl_FloorCmd(clientData
, interp
, argc
, argv
)
544 ClientData clientData
;
549 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, floor
);
553 *-----------------------------------------------------------------------------
556 * Implements the TCL ceil command:
560 * Returns TCL_OK if number is present and conversion succeeds.
562 *-----------------------------------------------------------------------------
565 Tcl_CeilCmd(clientData
, interp
, argc
, argv
)
566 ClientData clientData
;
571 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, ceil
);
575 *-----------------------------------------------------------------------------
578 * Implements the TCL floating modulo command:
582 * Returns TCL_OK if number is present and conversion succeeds.
584 *-----------------------------------------------------------------------------
587 Tcl_FmodCmd(clientData
, interp
, argc
, argv
)
588 ClientData clientData
;
593 double dbVal
, dbDivisor
, dbResult
;
596 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr divisor",
601 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
604 if (Tcl_ExprDouble (interp
, argv
[2], &dbDivisor
) != TCL_OK
)
607 G_inTclFPMath
= TRUE
;
608 dbResult
= fmod (dbVal
, dbDivisor
);
609 G_inTclFPMath
= FALSE
;
611 #ifdef TCL_IEEE_FP_MATH
612 if ((dbResult
!= dbResult
) ||
613 (dbResult
< -MAXDOUBLE
) ||
614 (dbResult
> MAXDOUBLE
))
615 return ReturnIEEEMathError (interp
, dbResult
);
617 if (G_gotTclFPMathErr
)
618 return ReturnFPMathError (interp
);
621 Tcl_ReturnDouble (interp
, dbResult
);
626 *-----------------------------------------------------------------------------
629 * Implements the TCL power (exponentiation) command:
633 * Returns TCL_OK if number is present and conversion succeeds.
635 *-----------------------------------------------------------------------------
638 Tcl_PowCmd(clientData
, interp
, argc
, argv
)
639 ClientData clientData
;
644 double dbVal
, dbExp
, dbResult
;
647 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr exp",
652 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
655 if (Tcl_ExprDouble (interp
, argv
[2], &dbExp
) != TCL_OK
)
658 G_inTclFPMath
= TRUE
;
659 dbResult
= pow (dbVal
,dbExp
);
660 G_inTclFPMath
= FALSE
;
662 #ifdef TCL_IEEE_FP_MATH
663 if ((dbResult
!= dbResult
) ||
664 (dbResult
< -MAXDOUBLE
) ||
665 (dbResult
> MAXDOUBLE
))
666 return ReturnIEEEMathError (interp
, dbResult
);
668 if (G_gotTclFPMathErr
)
669 return ReturnFPMathError (interp
);
672 Tcl_ReturnDouble (interp
, dbResult
);