/************************************************************************/
/*                                                                      */
/* Copyright (c) 1988 -                                                 */
/*     The Rector and Visitors of the University of Virginia            */
/*                                                                      */
/* This code may not be distributed further without permission          */
/*      from the University of Virginia.                                */
/* This code is distributed WITHOUT ANY WARRANTY.  No claims are        */
/*      made as to whether it serves any particular purpose or even     */
/*      works at all.                                                   */
/*                                                                      */
/************************************************************************/

#include <stdio.h>
#include <math.h>

extern int _STMTNO;
extern char *_FILENAME;

RT_abort(s)
	char *s;
{
	fprintf(stderr,
		"Execution halted: file \"%s\" line %d.  Reason:\n\t%s\n",
		_FILENAME, _STMTNO, s);
	abort();   /* causes core dump for debugging */
}

RT_warn(s)
	char *s;
{
	fprintf(stderr, "Warning: file \"%s\" line %d: %s\n",
		_FILENAME, _STMTNO, s);
}

void
RT_xfloat()
{
	RT_abort("arithmetic error (division by zero, overflow, underflow)");
}

void
RT_xpointer()
{
	RT_abort ("bad memory address (probably uninitialized/nil pointer)");
}

RT_range_err(expr)
{
	char buf[100];
	sprintf(buf, "array index or other value out of bounds.  ord(value)=%d",
		expr);
	RT_abort(buf);
}

/*
 * funcname maps unix math library function name to pascal name
 */

static char *
funcname(s)
	char *s;
{
	if (!strcmp(s, "log"))
		return("ln");
	if (!strcmp(s, "atan"))
		return("arctan");
	return(s);
}
	
matherr(x)
	struct exception *x;
{
	char buf[128];
	switch(x->type) {
	case DOMAIN:
	case SING:
		sprintf(buf, "illegal argument in function call %s(%e)",
			funcname(x->name), x->arg1);
		RT_abort(buf);
		break;
	case TLOSS:
	case PLOSS:
		sprintf(buf, "%s loss of significance in %s(%e) = %e",
			x->type == TLOSS ? "total" : "partial",
			funcname(x->name), x->arg1, x->retval);
		RT_warn(buf);
		break;
	case OVERFLOW:
	case UNDERFLOW:
		sprintf(buf, "%s(%e) resulted in an %s", funcname(x->name),
			x->arg1, x->type == OVERFLOW ? "overflow" : "underflow");
		RT_warn(buf);
		break;
	}
	return(1);
}
