archie/tcl7.3/tclMtherr.c
2024-05-27 16:13:40 +02:00

90 lines
2.6 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/*
* tclMatherr.c --
*
* This function provides a default implementation of the
* "matherr" function, for SYS-V systems where it's needed.
*
* Copyright (c) 1993 The Regents of the University of California.
* All rights reserved.
*
* Permission is hereby granted, without written agreement and without
* license or royalty fees, to use, copy, modify, and distribute this
* software and its documentation for any purpose, provided that the
* above copyright notice and the following two paragraphs appear in
* all copies of this software.
*
* IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
* OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
* CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMtherr.c,v 1.7 93/10/31 16:19:31 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
#include <math.h>
#ifndef TCL_GENERIC_ONLY
#include "tclUnix.h"
#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;
/*
*----------------------------------------------------------------------
*
* 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;
}