home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tcl7.0b1 / tclMtherr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-06-03  |  3.0 KB  |  108 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.3 93/06/03 10:36:22 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. #include "tclInt.h"
  33. #ifndef TCL_NO_MATH
  34. #include <math.h>
  35. #endif
  36.  
  37. /*
  38.  * The stuff below is a bit of a hack so that this file can be used
  39.  * in environments that include no UNIX, i.e. no errno.  Just define
  40.  * errno here.
  41.  */
  42.  
  43. #ifndef TCL_GENERIC_ONLY
  44. #include "tclUnix.h"
  45. #else
  46. int errno;
  47. #define EDOM 33
  48. #define ERANGE 34
  49. #endif
  50.  
  51. /*
  52.  * The following variable is secretly shared with Tcl so we can
  53.  * tell if expression evaluation is in progress.  If not, matherr
  54.  * just emulates the default behavior, which includes printing
  55.  * a message.
  56.  */
  57.  
  58. extern int tcl_MathInProgress;
  59.  
  60. /*
  61.  * Define a dummy "struct exception" structure if none already exists.
  62.  * The "OVERFLOW" #define is tested to see whether matherr stuff has
  63.  * been defined in math.h (struct exception is only defined if the
  64.  * matherr stuff is defined).
  65.  */
  66.  
  67. #ifndef OVERFLOW
  68. struct exception {
  69.     int type;
  70. };
  71. #define DOMAIN 0
  72. #define SING 1
  73. #endif
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * matherr --
  79.  *
  80.  *    This procedure is invoked on Sys-V systems when certain
  81.  *    errors occur in mathematical functions.  Type "man matherr"
  82.  *    for more information on how this function works.
  83.  *
  84.  * Results:
  85.  *    Returns 1 to indicate that we've handled the error
  86.  *    locally.
  87.  *
  88.  * Side effects:
  89.  *    Sets errno based on what's in xPtr.
  90.  *
  91.  *----------------------------------------------------------------------
  92.  */
  93.  
  94. int
  95. matherr(xPtr)
  96.     struct exception *xPtr;    /* Describes error that occurred. */
  97. {
  98.     if (!tcl_MathInProgress) {
  99.     return 0;
  100.     }
  101.     if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
  102.     errno = EDOM;
  103.     } else {
  104.     errno = ERANGE;
  105.     }
  106.     return 1;
  107. }
  108.