/*
 *			c m a t h e . c
 */

/*)LIBRARY
*/

#ifdef	DOCUMENTATION
title	cmathe cmath error package
index	cmath error package
usage
	.s
	There are three function calls associated with this package.
	.s
	int ercode;
	.br
	cmathe(ercode);
	.s
	int erno;
	.br
	char *datap;
	.br
	cmemsg(erno, datap);
	.s
	cmelog();
	.s
description
	.s
	This set of functions provides an error reporting package for
	the floating point math package. For RT-11 it catches the FP error
	interrupts also.  It may be connected to any other function which
	needs to report errors (such as square root of negative number).
	It provides the option, present in Fortran, of reporting n
	errors and then either aborting or ignoring subsequent errors.
	In that case they are counted but no messages are printed.
	Unless there is an abort, control is returned to the calling function,
	which must be able to continue or else abort itself.
	.s
	The cmathe system is started or restarted by the call
	.s
		cmathe(n);
	.s
	where is n is usually a literal constant. If n is 0 all errors
	are reported and there is no aborting. If n > 0, n errors are
	reported then there is an abort, so cmathe(1) will abort after
	reporting the first error. If n < 0, n errors are reported
	then the reporting stops, though the errors are still counted.
	The errors are reported on stderr, and on an abort a calltrace
	is done to stderr. This produces a trace of function calls leading
	to the error if profiling has been enabled, otherwise it
	produces a sequence of base addresses of the functions called.
	The program then exits with exit code 4.  Cmathe sets all the error
	counts to zero.	 The cmath initialisation function cminit() calls
	cmathe with argument zero, so that if that argument is appropriate
	there is no need to call cmathe explicitly.  Cminit also calls
	fps, and under RT-11 takes over the FPU interrupt vector to deal
	with the FPU exceptions.  See the documentation on cminit for
	further details.
	.s
	The function which invokes the error reporting mechanism is
	.s
		cmemsg(erno, datap);
	.s
	where erno is a symbol which defines the error number.  These
	definitions are in math.h.
	Datap is a pointer to an object whose value might
	help to throw further light on the cause of the error.  Further
	information on both those items may be found in the internal
	section below.  
	.s
	The cumulative error list may be printed on stdout via the call
	.s
		cmelog();
	.s
	This call does not clear the error counts, to do that use cmathe.
	.s
diagnostics
	.s
	If cmemsg() is called with an error number which is undefined or
	out of range the message 'error code out of range' is written
	to stderr.
	.s
internal
	.s
	The error table currently looks like :-
	.s
	Error Caller  Sev Eno	Message			Argument
	.s
	FP_OPER	FPU	F  E	floating op code error 	PC
	.s
	FP_ZDIV	FPU	F  E	floating divide by zero	PC
	.s
	FP_FTOI	FPU	F  E	floating integer 	PC
	.br
				conversion error
	.s
	FP_OFLO	FPU	F  E	floating overflow	PC
	.s
	FP_UFLO	FPU	W  E	floating underflow	PC
	.s
	FP_UDEF	FPU	W  E	floating undefined 	PC
	.br
				variable
	.s
	FP_BIGI atof	F  R	atof input too large	string
	.s
	FP_BADC	atof	F  D	illegal character in	string
	.br
				floating input string
	.s
	FP_NESQ	sqrt	F  D	sqrt arg negative	value
	.s
	FP_LEXP	exp	F  R	exp overflow		value
	.s
	FP_SEXP	exp	W  R	exp underflow		value
	.s
	FP_NLOG	log	F  D	log arg negative or 	value
	.br
				zero 
	.s
	FP_TANE	tancot	F  D	tan, cot arg too large	value
	.s
	FP_TRIG	sincos	F  D	sin, cos arg too large	value
	.s
	FP_ATAN atan2	F  D	atan2 args both zero	value
	.s
	FP_COTE cotan	F  D	cotan arg too small	value
	.s
	FP_ARSC arsico	F  D	asin, acos arg bad 	value
	.s
	FP_SINH sinh	F  D	sinh arg too large	value
	.s
	FP_COSH cosh	F  D	cosh arg too large	value
	.s
	FP_POWN pow	F  D	pow arg negative 	value
	.s
	FP_POWO pow	F  R	pow overflow		value 
	.s
	FP_POWU pow	W  R	pow underflow		value
	.s
	Error is the error number as defined in the math.h file.  Caller
	is the name of the function in which the error was encountered,
	or it is FPU for floating point exceptions.  Sev is the severity
	of the error.
	Errors of severity W(arning) do not print their messages and
	their error counts do not count towards the abort limit. Their
	individual counts are updated and may be checked using cmelog().
	Eno is the error number for the perror() function.  Only three
	have been used E (SIGFPE) is the floating point exception error,
	D (EDOM) is a domain error (inadmissable argument) and R (ERANGE)
	is a range error (result out of range).  Message is the error
	message printed and argument is an argument of the function
	which encountered the error, or the PC in the case of FPU errors.
	.s
	To add a new error enter the error message in the error message
	table in the cmathe.c file, define the error code in math.h, then
	place a cmemsg(erno, datap); statement in
	the function which needs to call the error system. Erno is the
	index number of the error in the error table (the first col in
	the table above) and datap is a pointer to the argument passed
	back (the last col in the table above). For FPU generated errors
	(error nos up to FP_NFPU) it points to an int (value of PC), for
	bad string errors (error nos up to FP_NFPU + FP_NSTR) it points
	to a string and for all higher values it points to a double
	precision argument. That organisation allows the addition of
	new errors passing any of those argument types simply by adding
	to the error tables in this file and in math.h.
	.s
author
	.s
	Hamish Ross.
	.s
date
	.s
	10-Feb-85
#endif

#include <stdio.h>
#include <math.h>
static int allcnt;
static int abrt = TRUE;
struct errdef {
    char un_erno;
    char sever;
    int errcnt;
    char *ermes;
} static erlist[] = {
    EDOM, 'F', 0, "error code out of range",
    SIGFPE, 'F', 0, "floating op code error",
    SIGFPE, 'F', 0, "floating divide by zero",
    SIGFPE, 'F', 0, "floating integer conversion error",
    SIGFPE, 'F', 0, "floating overflow",
    SIGFPE, 'W', 0, "floating underflow",
    SIGFPE, 'W', 0, "floating undefined variable",
    ERANGE, 'F', 0, "floating input too large",
    EDOM, 'F', 0, "illegal character in floating input string",
    EDOM, 'F', 0, "sqrt arg negative",
    ERANGE, 'F', 0, "exp overflow",
    ERANGE, 'W', 0, "exp underflow",
    EDOM, 'F', 0, "log arg negative or zero",
    EDOM, 'F', 0, "tan, cot arg too large",
    EDOM, 'F', 0, "sin, cos arg too large",
    EDOM, 'F', 0, "atan2 args both zero",
    EDOM, 'F', 0, "cotan arg too small",
    EDOM, 'F', 0, "asin, acos arg bad",
    EDOM, 'F', 0, "sinh arg too large",
    EDOM, 'F', 0, "cosh arg too large",
    EDOM, 'F', 0, "pow arg negative",
    ERANGE, 'F', 0, "pow overflow",
    ERANGE, 'W', 0, "pow underflow,"
};
#define NERTYPE (sizeof(erlist)/sizeof(struct errdef))

cmathe(ercode)
int ercode;
{

    if (ercode > 0){
	abrt = TRUE;
	allcnt = -ercode;
    }
    else {
	abrt = FALSE;
	allcnt = ercode;
    }
    if (ercode == 0)
	allcnt = 1;
}

cmemsg(erno, datap)
int erno;
char *datap;
{
    double *d;
    unsigned int *u;
    extern int $$ferr;

    erno = (erno < 1 || erno > NERTYPE) ? 0 : erno;
    erlist[erno].errcnt++;
    $$ferr = erlist[erno].un_erno;
    if (allcnt != 0 && erlist[erno].sever == 'F') {
	fprintf(stderr, "?CMATH-F-%s", erlist[erno].ermes);
	if (erno > 0 && erno <= FP_NFPU) {
	    u = datap;
	    fprintf(stderr, " PC = %o\n", *u);
	}
	else if (erno <= (FP_NFPU + FP_NSTR))
	    fprintf(stderr, " %s\n", datap);
	else if (erno <= (FP_NFPU + FP_NSTR + FP_NMAR)) {
	    d = datap;
	    fprintf(stderr, " %18.10G\n", *d);
	}
	else
	    fprintf(stderr, "\n");
    }
    if (allcnt == -1 && abrt && erlist[erno].sever == 'F') {
	calltrace(stderr);
	exit(4);
    }
    if (allcnt < 0) allcnt++;
    return;
}

cmelog()
{
    int erno;

    for (erno = 0; erno < NERTYPE; erno++)
	if (erlist[erno].errcnt > 0){
	    printf("%s %d times\n", erlist[erno].ermes, erlist[erno].errcnt);
	    erlist[erno].errcnt = 0;
	}
}