]>
cvs.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxfmat.c
19d42c37534b61962c52dea4f388507bea0f5b52
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
)
124 switch (G_errorType
) {
129 errorMsg
= "singularity";
132 errorMsg
= "overflow";
135 errorMsg
= "underflow";
139 errorMsg
= "loss of significance";
142 Tcl_AppendResult (interp
, "floating point ", errorMsg
, " error",
144 G_gotTclFPMathErr
= FALSE
; /* Clear the flag. */
147 #endif /* NO_MATH_ERR */
150 *-----------------------------------------------------------------------------
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.
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.
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
170 *-----------------------------------------------------------------------------
173 Tcl_MathError (functionName
, errorType
)
179 G_gotTclFPMathErr
= TRUE
;
180 G_errorType
= errorType
;
188 *-----------------------------------------------------------------------------
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
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.
203 *-----------------------------------------------------------------------------
206 Tcl_UnaryFloatFunction(interp
, argc
, argv
, function
)
210 double (*function
)();
212 double dbVal
, dbResult
;
215 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr",
220 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
223 G_inTclFPMath
= TRUE
;
224 dbResult
= (*function
)(dbVal
);
225 G_inTclFPMath
= FALSE
;
227 #ifdef TCL_IEEE_FP_MATH
228 if ((dbResult
!= dbResult
) ||
229 (dbResult
< -MAXDOUBLE
) ||
230 (dbResult
> MAXDOUBLE
))
231 return ReturnIEEEMathError (interp
, dbResult
);
233 if (G_gotTclFPMathErr
)
234 return ReturnFPMathError (interp
);
237 Tcl_ReturnDouble (interp
, dbResult
);
242 *-----------------------------------------------------------------------------
245 * Implements the TCL arccosine command:
249 * Returns TCL_OK if number is present and conversion succeeds.
251 *-----------------------------------------------------------------------------
254 Tcl_AcosCmd(clientData
, interp
, argc
, argv
)
255 ClientData clientData
;
260 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, acos
);
264 *-----------------------------------------------------------------------------
267 * Implements the TCL arcsin command:
271 * Returns TCL_OK if number is present and conversion succeeds.
273 *-----------------------------------------------------------------------------
276 Tcl_AsinCmd(clientData
, interp
, argc
, argv
)
277 ClientData clientData
;
282 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, asin
);
286 *-----------------------------------------------------------------------------
289 * Implements the TCL arctangent command:
293 * Returns TCL_OK if number is present and conversion succeeds.
295 *-----------------------------------------------------------------------------
298 Tcl_AtanCmd(clientData
, interp
, argc
, argv
)
299 ClientData clientData
;
304 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, atan
);
308 *-----------------------------------------------------------------------------
311 * Implements the TCL cosine command:
315 * Returns TCL_OK if number is present and conversion succeeds.
317 *-----------------------------------------------------------------------------
320 Tcl_CosCmd(clientData
, interp
, argc
, argv
)
321 ClientData clientData
;
326 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, cos
);
330 *-----------------------------------------------------------------------------
333 * Implements the TCL sin command:
337 * Returns TCL_OK if number is present and conversion succeeds.
339 *-----------------------------------------------------------------------------
342 Tcl_SinCmd(clientData
, interp
, argc
, argv
)
343 ClientData clientData
;
348 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sin
);
352 *-----------------------------------------------------------------------------
355 * Implements the TCL tangent command:
359 * Returns TCL_OK if number is present and conversion succeeds.
361 *-----------------------------------------------------------------------------
364 Tcl_TanCmd(clientData
, interp
, argc
, argv
)
365 ClientData clientData
;
370 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, tan
);
374 *-----------------------------------------------------------------------------
377 * Implements the TCL hyperbolic cosine command:
381 * Returns TCL_OK if number is present and conversion succeeds.
383 *-----------------------------------------------------------------------------
386 Tcl_CoshCmd(clientData
, interp
, argc
, argv
)
387 ClientData clientData
;
392 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, cosh
);
396 *-----------------------------------------------------------------------------
399 * Implements the TCL hyperbolic sin command:
403 * Returns TCL_OK if number is present and conversion succeeds.
405 *-----------------------------------------------------------------------------
408 Tcl_SinhCmd(clientData
, interp
, argc
, argv
)
409 ClientData clientData
;
414 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sinh
);
418 *-----------------------------------------------------------------------------
421 * Implements the TCL hyperbolic tangent command:
425 * Returns TCL_OK if number is present and conversion succeeds.
427 *-----------------------------------------------------------------------------
430 Tcl_TanhCmd(clientData
, interp
, argc
, argv
)
431 ClientData clientData
;
436 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, tanh
);
440 *-----------------------------------------------------------------------------
443 * Implements the TCL exponent command:
447 * Returns TCL_OK if number is present and conversion succeeds.
449 *-----------------------------------------------------------------------------
452 Tcl_ExpCmd(clientData
, interp
, argc
, argv
)
453 ClientData clientData
;
458 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, exp
);
462 *-----------------------------------------------------------------------------
465 * Implements the TCL logarithm command:
469 * Returns TCL_OK if number is present and conversion succeeds.
471 *-----------------------------------------------------------------------------
474 Tcl_LogCmd(clientData
, interp
, argc
, argv
)
475 ClientData clientData
;
480 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, log
);
484 *-----------------------------------------------------------------------------
487 * Implements the TCL base-10 logarithm command:
491 * Returns TCL_OK if number is present and conversion succeeds.
493 *-----------------------------------------------------------------------------
496 Tcl_Log10Cmd(clientData
, interp
, argc
, argv
)
497 ClientData clientData
;
502 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, log10
);
506 *-----------------------------------------------------------------------------
509 * Implements the TCL square root command:
513 * Returns TCL_OK if number is present and conversion succeeds.
515 *-----------------------------------------------------------------------------
518 Tcl_SqrtCmd(clientData
, interp
, argc
, argv
)
519 ClientData clientData
;
524 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, sqrt
);
528 *-----------------------------------------------------------------------------
531 * Implements the TCL floating point absolute value command:
535 * Returns TCL_OK if number is present and conversion succeeds.
537 *-----------------------------------------------------------------------------
540 Tcl_FabsCmd(clientData
, interp
, argc
, argv
)
541 ClientData clientData
;
546 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, fabs
);
550 *-----------------------------------------------------------------------------
553 * Implements the TCL floor command:
557 * Returns TCL_OK if number is present and conversion succeeds.
559 *-----------------------------------------------------------------------------
562 Tcl_FloorCmd(clientData
, interp
, argc
, argv
)
563 ClientData clientData
;
568 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, floor
);
572 *-----------------------------------------------------------------------------
575 * Implements the TCL ceil command:
579 * Returns TCL_OK if number is present and conversion succeeds.
581 *-----------------------------------------------------------------------------
584 Tcl_CeilCmd(clientData
, interp
, argc
, argv
)
585 ClientData clientData
;
590 return Tcl_UnaryFloatFunction(interp
, argc
, argv
, ceil
);
594 *-----------------------------------------------------------------------------
597 * Implements the TCL floating modulo command:
601 * Returns TCL_OK if number is present and conversion succeeds.
603 *-----------------------------------------------------------------------------
606 Tcl_FmodCmd(clientData
, interp
, argc
, argv
)
607 ClientData clientData
;
612 double dbVal
, dbDivisor
, dbResult
;
615 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr divisor",
620 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
623 if (Tcl_ExprDouble (interp
, argv
[2], &dbDivisor
) != TCL_OK
)
626 G_inTclFPMath
= TRUE
;
627 dbResult
= fmod (dbVal
, dbDivisor
);
628 G_inTclFPMath
= FALSE
;
630 #ifdef TCL_IEEE_FP_MATH
631 if ((dbResult
!= dbResult
) ||
632 (dbResult
< -MAXDOUBLE
) ||
633 (dbResult
> MAXDOUBLE
))
634 return ReturnIEEEMathError (interp
, dbResult
);
636 if (G_gotTclFPMathErr
)
637 return ReturnFPMathError (interp
);
640 Tcl_ReturnDouble (interp
, dbResult
);
645 *-----------------------------------------------------------------------------
648 * Implements the TCL power (exponentiation) command:
652 * Returns TCL_OK if number is present and conversion succeeds.
654 *-----------------------------------------------------------------------------
657 Tcl_PowCmd(clientData
, interp
, argc
, argv
)
658 ClientData clientData
;
663 double dbVal
, dbExp
, dbResult
;
666 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0], " expr exp",
671 if (Tcl_ExprDouble (interp
, argv
[1], &dbVal
) != TCL_OK
)
674 if (Tcl_ExprDouble (interp
, argv
[2], &dbExp
) != TCL_OK
)
677 G_inTclFPMath
= TRUE
;
678 dbResult
= pow (dbVal
,dbExp
);
679 G_inTclFPMath
= FALSE
;
681 #ifdef TCL_IEEE_FP_MATH
682 if ((dbResult
!= dbResult
) ||
683 (dbResult
< -MAXDOUBLE
) ||
684 (dbResult
> MAXDOUBLE
))
685 return ReturnIEEEMathError (interp
, dbResult
);
687 if (G_gotTclFPMathErr
)
688 return ReturnFPMathError (interp
);
691 Tcl_ReturnDouble (interp
, dbResult
);