xref: /csrg-svn/usr.bin/f77/libF77/traper_.c (revision 4154)
1*4154Sdlw /*
2*4154Sdlw char id_traper[] = "@(#)traper_.c	1.1";
3*4154Sdlw  * Arrange to trap integer overflow & floating underflow.
4*4154Sdlw  * Full of Magic! DON'T CHANGE ANYTHING !!
5*4154Sdlw  *
6*4154Sdlw  * To use from f77:
7*4154Sdlw  *	integer oldmsk, traper
8*4154Sdlw  *	oldmsk = traper (mask)
9*4154Sdlw  * where:
10*4154Sdlw  *	mask = 1 to trap integer overflow
11*4154Sdlw  *	mask = 2 to trap floating underflow
12*4154Sdlw  *	mask = 3 to trap both
13*4154Sdlw  *	These 2 bits will be set into the PSW.
14*4154Sdlw  *	The old state will be returned.
15*4154Sdlw  */
16*4154Sdlw 
17*4154Sdlw long traper_(msk)
18*4154Sdlw long	*msk;
19*4154Sdlw {
20*4154Sdlw 	int	old = 0;
21*4154Sdlw #if	vax
22*4154Sdlw #define IOV_MASK	0140
23*4154Sdlw 	int	**s = &msk;
24*4154Sdlw 	int	psw;
25*4154Sdlw 
26*4154Sdlw 	s -= 5;
27*4154Sdlw 	psw = (int)*s;
28*4154Sdlw 	old = (psw & IOV_MASK) >> 5;
29*4154Sdlw 	psw = (psw & ~IOV_MASK) | ((*msk << 5) & IOV_MASK);
30*4154Sdlw 	*s = (int *)psw;
31*4154Sdlw #endif	vax
32*4154Sdlw 	return((long)old);
33*4154Sdlw }
34