/*
 * Copyright 1/5/95 Zhishun Alex Liu.  All Rights Reserved.
 *
 ***************************
 * WORK IN PROGRESS
 ***************************
 *
 * Written by Zhishun Alex Liu under direction of Professor William Kahan.
 * The author's current electronic mail address as of December 1994 is
 * Alex.Liu@Eng.Sun.COM.
 *
 * Use of this software is granted with the understanding that all recipients
 * should regard themselves as participants in an ongoing research project and
 * hence should feel obligated to report their experiences (good or bad) with
 * this elementary functions test suite to the author.
 *
 * extern GENERIC er_atn(.), er_exp(.), er_em1(.), er_sin(.), er_cos(.), er_l1p(.);
 * extern void update(.);
 */
#ifndef lint
static char sccsid[] = "@(#)er_dfl.c	1.1 (BeEF) 1/5/95";
#endif
#ifdef __STDC__
#include <stdio.h>
extern void exit(int);
#endif
#include "sys.h"

#if BEEF_QA
#include <stdio.h>
#if MACHINE_PI
#define	hsin_	hSin_
#define	hcos_	hCos_
#define	hatan_	hAtan_
#endif
extern GENERIC getulp( );
extern void hsin_( ), hcos_( ), hatan_( ), hexp_( ), hexpm1_( ), hlog_( ), hlog1p_( );

static struct {
	void (*func)( );
} tbl[] = {
	hsin_,
	hcos_,
	hatan_,
	hexp_,
	hexpm1_,
	hlog_,
	hlog1p_,
};

static GENERIC
erfunc(fid, x, y)
GENERIC *x, *y;			/* input arguments */
{
	GENERIC qy[2], scale, ulp, error;

	if (fid < 0)
		fid = -fid;
	(*tbl[fid - 1].func)(qy, x);
	error = (*y - qy[0]) - qy[1];
	ulp = getulp(&qy[0], &scale);
	error *= scale;
#if GUARD_AGAINST_OVERFLOW
	if (GABS(error) / GHUGE > ulp)
		return ZERO;
#endif
	return error / ulp;
}

GENERIC
h_diff(fid, x, y, error)
GENERIC *x, *y, *error;		/* input arguments */
{
	GENERIC err, diff;
	static int ecount = 0;
	char *namep;

	err = erfunc(fid, x, y);
	diff = *error - err;
	if (GABS(diff) >= ONE) {
		switch (fid) {
#if TEST_SIN
		case CASE_SIN:
			namep = "SIN"; break;
#endif
#if TEST_COS
		case CASE_COS:
			namep = "COS"; break;
#endif
#if TEST_ATN
		case CASE_ATN:
			namep = "ATN"; break;
#endif
#if TEST_EXP
		case CASE_EXP:
			namep = "EXP"; break;
#endif
#if TEST_EM1
		case CASE_EM1:
			namep = "EM1"; break;
#endif
#if TEST_LOG
		case CASE_LOG:
			namep = "LOG"; break;
#endif
#if TEST_L1P
		case CASE_L1P:
			namep = "L1P"; break;
#endif
		default:
			(void) exit(1); break;
		}
		(void) fprintf(stderr,
			"%s: E=%8.0e x=%25.17e (0x%08.8x %08.8x)\n",
			namep, diff, *x,
#ifndef lint
			*x
#else	/* !defined(lint) */
			0, 0
#endif	/* !defined(lint) */
			);
		(void) fprintf(stderr, "............... H=%25.17e Z=%25.17e\n",
			err, *error);
		(void) fprintf(stderr, "............... y=%25.17e\n", *y);
		if (ecount < 1000)
			ecount++;
		else
			(void) exit(1);
	}
	return diff;
}
#endif

void
#ifdef __STDC__
er_dfl(int fid, int rid, GENERIC *xs, struct summary *s)
#else
er_dfl(fid, rid, xs, s)
int fid, rid;
GENERIC *xs;
struct summary *s;
#endif
{
	register int i, is=0, m=0;
#if TEST_SIN || TEST_COS
	int iord;
#endif
	GENERIC y=ZERO, prevy = ZERO, error;
#if TEST_SIN || TEST_COS || TEST_ATN
	GENERIC xn, yn;
#endif

	for (i = 0; i < 3; i++) {
		switch (fid) {
#if TEST_SIN
		case CASE_SIN:
			FUNC_SIN(y, xs[i])
			xn = -xs[i];
			FUNC_SIN(yn, xn)
			is = yn != -y;
			error = er_sin(rid, &xs[i], &y, &iord);
			m = i && (iord ? y < prevy : y > prevy);
			break;
#endif
#if TEST_COS
		case CASE_COS:
			FUNC_COS(y, xs[i])
			xn = -xs[i];
			FUNC_COS(yn, xn)
			is = yn != y;
			error = er_cos(rid, &xs[i], &y, &iord);
			m = i && (iord ? y < prevy : y > prevy);
			break;
#endif
#if TEST_ATN
		case CASE_ATN:
			FUNC_ATN(y, xs[i])
			xn = -xs[i];
			FUNC_ATN(yn, xn)
			is = yn != -y;
			error = er_atn(rid, &xs[i], &y);
			m = i && y < prevy;
			break;
#endif
#if TEST_EXP
		case CASE_EXP:
			FUNC_EXP(y, xs[i])
			is = 0;
			error = er_exp(rid, &xs[i], &y);
			m = i && y < prevy;
			break;
#endif
#if TEST_EM1
		case CASE_EM1:
			FUNC_EM1(y, xs[i])
			is = 0;
			error = er_em1(rid, &xs[i], &y);
			m = i && y < prevy;
			break;
#endif
#if TEST_L1P
		case CASE_L1P:
			FUNC_L1P(y, xs[i])
			is = 0;
			error = er_l1p(rid, &xs[i], &y);
			m = i && y < prevy;
			break;
#endif
		default:
			ucbfail( __FILE__ , __LINE__ );
			break;
		}
#if BEEF_QA
		error = h_diff(fid, &xs[i], &y, &error);
#endif
		update(0, m, is, &xs[i], &error, s);	/* update summary */
		prevy = y;
	}
}
