home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tclMtherr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-12-18  |  2.0 KB  |  89 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-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  */
  13.  
  14. #ifndef lint
  15. static char sccsid[] = "@(#) tclMtherr.c 1.10 94/12/17 16:14:25";
  16. #endif /* not lint */
  17.  
  18. #include "tclInt.h"
  19. #include <math.h>
  20.  
  21. #ifndef TCL_GENERIC_ONLY
  22. #include "tclPort.h"
  23. #else
  24. #define NO_ERRNO_H
  25. #endif
  26.  
  27. #ifdef NO_ERRNO_H
  28. extern int errno;            /* Use errno from tclExpr.c. */
  29. #define EDOM 33
  30. #define ERANGE 34
  31. #endif
  32.  
  33. /*
  34.  * The following variable is secretly shared with Tcl so we can
  35.  * tell if expression evaluation is in progress.  If not, matherr
  36.  * just emulates the default behavior, which includes printing
  37.  * a message.
  38.  */
  39.  
  40. extern int tcl_MathInProgress;
  41.  
  42. /*
  43.  * The following definitions allow matherr to compile on systems
  44.  * that don't really support it.  The compiled procedure is bogus,
  45.  * but it will never be executed on these systems anyway.
  46.  */
  47.  
  48. #ifndef NEED_MATHERR
  49. struct exception {
  50.     int type;
  51. };
  52. #define DOMAIN 0
  53. #define SING 0
  54. #endif
  55.  
  56. /*
  57.  *----------------------------------------------------------------------
  58.  *
  59.  * matherr --
  60.  *
  61.  *    This procedure is invoked on Sys-V systems when certain
  62.  *    errors occur in mathematical functions.  Type "man matherr"
  63.  *    for more information on how this function works.
  64.  *
  65.  * Results:
  66.  *    Returns 1 to indicate that we've handled the error
  67.  *    locally.
  68.  *
  69.  * Side effects:
  70.  *    Sets errno based on what's in xPtr.
  71.  *
  72.  *----------------------------------------------------------------------
  73.  */
  74.  
  75. int
  76. matherr(xPtr)
  77.     struct exception *xPtr;    /* Describes error that occurred. */
  78. {
  79.     if (!tcl_MathInProgress) {
  80.     return 0;
  81.     }
  82.     if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
  83.     errno = EDOM;
  84.     } else {
  85.     errno = ERANGE;
  86.     }
  87.     return 1;
  88. }
  89.