home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcl2-73c.zip / tcl7.3 / tclMtherr.c < prev    next >
C/C++ Source or Header  |  1993-10-31  |  3KB  |  90 lines
  1. /* 
  2.  * tclMatherr.c --
  3.  *
  4.  *    This function provides a default implementation of the
  5.  *    "matherr" function, for SYS-V systems where it's needed.
  6.  *
  7.  * Copyright (c) 1993 The Regents of the University of California.
  8.  * All rights reserved.
  9.  *
  10.  * Permission is hereby granted, without written agreement and without
  11.  * license or royalty fees, to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose, provided that the
  13.  * above copyright notice and the following two paragraphs appear in
  14.  * all copies of this software.
  15.  * 
  16.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20.  *
  21.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26.  */
  27.  
  28. #ifndef lint
  29. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMtherr.c,v 1.7 93/10/31 16:19:31 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. #include "tclInt.h"
  33. #include <math.h>
  34.  
  35. #ifndef TCL_GENERIC_ONLY
  36. #include "tclUnix.h"
  37. #else
  38. #define NO_ERRNO_H
  39. #endif
  40.  
  41. #ifdef NO_ERRNO_H
  42. extern int errno;            /* Use errno from tclExpr.c. */
  43. #define EDOM 33
  44. #define ERANGE 34
  45. #endif
  46.  
  47. /*
  48.  * The following variable is secretly shared with Tcl so we can
  49.  * tell if expression evaluation is in progress.  If not, matherr
  50.  * just emulates the default behavior, which includes printing
  51.  * a message.
  52.  */
  53.  
  54. extern int tcl_MathInProgress;
  55.  
  56.  
  57. /*
  58.  *----------------------------------------------------------------------
  59.  *
  60.  * matherr --
  61.  *
  62.  *    This procedure is invoked on Sys-V systems when certain
  63.  *    errors occur in mathematical functions.  Type "man matherr"
  64.  *    for more information on how this function works.
  65.  *
  66.  * Results:
  67.  *    Returns 1 to indicate that we've handled the error
  68.  *    locally.
  69.  *
  70.  * Side effects:
  71.  *    Sets errno based on what's in xPtr.
  72.  *
  73.  *----------------------------------------------------------------------
  74.  */
  75.  
  76. int
  77. matherr(xPtr)
  78.     struct exception *xPtr;    /* Describes error that occurred. */
  79. {
  80.     if (!tcl_MathInProgress) {
  81.     return 0;
  82.     }
  83.     if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
  84.     errno = EDOM;
  85.     } else {
  86.     errno = ERANGE;
  87.     }
  88.     return 1;
  89. }
  90.