archie/tcl7.6/unix/tclMtherr.c

87 lines
1.9 KiB
C
Raw Normal View History

2024-05-27 16:13:40 +02:00
/*
* tclMatherr.c --
*
* This function provides a default implementation of the
* "matherr" function, for SYS-V systems where it's needed.
*
2024-05-27 16:40:40 +02:00
* Copyright (c) 1993-1994 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
2024-05-27 16:13:40 +02:00
*
2024-05-27 16:40:40 +02:00
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
2024-05-27 16:13:40 +02:00
*
2024-05-27 16:40:40 +02:00
* SCCS: @(#) tclMtherr.c 1.11 96/02/15 11:58:36
2024-05-27 16:13:40 +02:00
*/
#include "tclInt.h"
#include <math.h>
#ifndef TCL_GENERIC_ONLY
2024-05-27 16:40:40 +02:00
#include "tclPort.h"
2024-05-27 16:13:40 +02:00
#else
#define NO_ERRNO_H
#endif
#ifdef NO_ERRNO_H
extern int errno; /* Use errno from tclExpr.c. */
#define EDOM 33
#define ERANGE 34
#endif
/*
* The following variable is secretly shared with Tcl so we can
* tell if expression evaluation is in progress. If not, matherr
* just emulates the default behavior, which includes printing
* a message.
*/
extern int tcl_MathInProgress;
2024-05-27 16:40:40 +02:00
/*
* The following definitions allow matherr to compile on systems
* that don't really support it. The compiled procedure is bogus,
* but it will never be executed on these systems anyway.
*/
#ifndef NEED_MATHERR
struct exception {
int type;
};
#define DOMAIN 0
#define SING 0
#endif
2024-05-27 16:13:40 +02:00
/*
*----------------------------------------------------------------------
*
* matherr --
*
* This procedure is invoked on Sys-V systems when certain
* errors occur in mathematical functions. Type "man matherr"
* for more information on how this function works.
*
* Results:
* Returns 1 to indicate that we've handled the error
* locally.
*
* Side effects:
* Sets errno based on what's in xPtr.
*
*----------------------------------------------------------------------
*/
int
matherr(xPtr)
struct exception *xPtr; /* Describes error that occurred. */
{
if (!tcl_MathInProgress) {
return 0;
}
if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
errno = EDOM;
} else {
errno = ERANGE;
}
return 1;
}