Return to trapov_.c CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libF77

Power 6/32 Unix version 1.21

/*
 *	@(#)trapov_.c	1.1
 *
 *	Fortran/C floating-point overflow handler
 *
 *	The idea of these routines is to catch floating-point overflows
 *	and print an eror message.  When we then get a reserved operand
 *	exception, we then fix up the value to the highest possible
 *	number.  Keen, no?
 *	Messy, yes!
 *
 *	NO RESERVED OPERAND EXCEPTION ON RESULT OF FP OVERFLOW ON TAHOE.
 * 	JUST PRINT THE OVERFLOW MESSAGE. RESULT IS 0 (zero).
 *
 *	Synopsis:
 *		call trapov(n)
 *			causes overflows to be trapped, with the first 'n'
 *			overflows getting an "Overflow!" message printed.
 *		k = ovcnt(0)
 *			causes 'k' to get the number of overflows since the
 *			last call to trapov().
 *
 */

# include <stdio.h>
# include <signal.h>
# include "../libI77/fiodefs.h"
# define SIG_VAL	int (*)()

/*
 * trap type codes
 */
# define INT_OVF_T	1
# define INT_DIV_T	2
# define FLT_OVF_T	3
# define FLT_DIV_T	4
# define FLT_UND_T	5

/*
 *	Potential operand values
 */
typedef	union operand_types {
		char	o_byte;
		short	o_word;
		long	o_long;
		float	o_float;
		long	o_quad[2];
		double	o_double;
	} anyval;

/*
 *	GLOBAL VARIABLES (we need a few)
 *
 *	Actual program counter and locations of registers.
 */
static char	*pc;
static int	*regs0t1;
static int	*regs2t12;
static int	max_messages;
static int	total_overflows;
static union	{
	long	v_long[2];
	double	v_double;
	} retrn;
static int	(*sigill_default)() = (SIG_VAL)-1;
static int	(*sigfpe_default)();

/*
 *	the fortran unit control table
 */
extern unit units[];

/*
 * Fortran message table is in main
 */
struct msgtbl {
	char	*mesg;
	int	dummy;
};
extern struct msgtbl	act_fpe[];



anyval *get_operand_address(), *addr_of_reg();
char *opcode_name();

/*
 *	This routine sets up the signal handler for the floating-point
 *	and reserved operand interrupts.
 */

trapov_(count, rtnval)
	int *count;
	double *rtnval;
{
	extern got_overflow();

	sigfpe_default = signal(SIGFPE, got_overflow);
	total_overflows = 0;
	max_messages = *count;
	retrn.v_double = *rtnval;
}



/*
 *	got_overflow - routine called when overflow occurs
 *
 *	This routine just prints a message about the overflow.
 *	It is impossible to find the bad result at this point.
 * 	 NEXT 2 LINES DON'T HOLD FOR TAHOE !
 *	Instead, we wait until we get the reserved operand exception
 *	when we try to use it.  This raises the SIGILL signal.
 */

/*ARGSUSED*/
got_overflow(signo, codeword, sc)
	int signo, codeword;
	struct sigcontext *sc;
{
	int	*sp, i;
	FILE	*ef;

	signal(SIGFPE, got_overflow);
	ef = units[STDERR].ufd;
	switch (codeword) {
		case INT_OVF_T:
		case INT_DIV_T:
		case FLT_UND_T:
		case FLT_DIV_T:
				if (sigfpe_default > (SIG_VAL)7)
					return((*sigfpe_default)(signo, codeword, sc));
				else
					sigdie(signo, codeword, sc);
					/* NOTREACHED */

		case FLT_OVF_T:
				if (++total_overflows <= max_messages) {
					fprintf(ef, "trapov: %s",
						act_fpe[codeword-1].mesg);
					fprintf(ef, ": Current PC = %X", sc->sc_pc);
					if (total_overflows == max_messages)
						fprintf(ef, ": No more messages will be printed.\n");
					else
						fputc('\n', ef);
				}
				return;
	}
}
int 
ovcnt_()
{
	return total_overflows;
}

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.