xref: /csrg-svn/usr.bin/f77/libF77/traper_.c (revision 29959)
14154Sdlw /*
222989Skre  * Copyright (c) 1980 Regents of the University of California.
322989Skre  * All rights reserved.  The Berkeley software License Agreement
422989Skre  * specifies the terms and conditions for redistribution.
522989Skre  *
6*29959Smckusick  *	@(#)traper_.c	5.3	11/03/86
722994Skre  *
84154Sdlw  * Full of Magic! DON'T CHANGE ANYTHING !!
94154Sdlw  *
104154Sdlw  * To use from f77:
114154Sdlw  *	integer oldmsk, traper
124154Sdlw  *	oldmsk = traper (mask)
13*29959Smckusick  * where for vax:
144154Sdlw  *	mask = 1 to trap integer overflow
154154Sdlw  *	mask = 2 to trap floating underflow
164154Sdlw  *	mask = 3 to trap both
174154Sdlw  *	These 2 bits will be set into the PSW.
184154Sdlw  *	The old state will be returned.
19*29959Smckusick  *
20*29959Smckusick  * where for CCI:
21*29959Smckusick  *	mask = 0 to trap neither
22*29959Smckusick  *	mask = 1 to trap integer overflow
23*29959Smckusick  *	mask = 2 to trap floating underflow
24*29959Smckusick  *	mask = 3 to trap both
25*29959Smckusick  *	These 2 bits will be set into the PSL.
26*29959Smckusick  *	The old state will be returned.
274154Sdlw  */
284154Sdlw 
29*29959Smckusick #ifdef vax
304154Sdlw long traper_(msk)
314154Sdlw long	*msk;
324154Sdlw {
334154Sdlw 	int	old = 0;
344154Sdlw #define IOV_MASK	0140
354154Sdlw 	int	**s = &msk;
364154Sdlw 	int	psw;
374154Sdlw 
384154Sdlw 	s -= 5;
394154Sdlw 	psw = (int)*s;
404154Sdlw 	old = (psw & IOV_MASK) >> 5;
414154Sdlw 	psw = (psw & ~IOV_MASK) | ((*msk << 5) & IOV_MASK);
424154Sdlw 	*s = (int *)psw;
434154Sdlw 	return((long)old);
444154Sdlw }
45*29959Smckusick #endif	vax
46*29959Smckusick 
47*29959Smckusick /*
48*29959Smckusick  * Assumptions for CCI:
49*29959Smckusick  *	- the two bits are contiguous in PSL;
50*29959Smckusick  *	- integer overflow trap enable bit < floating underflow trap enable bit;
51*29959Smckusick  */
52*29959Smckusick #ifdef tahoe
53*29959Smckusick # include <machine/psl.h>
54*29959Smckusick 
55*29959Smckusick unsigned long old_msk;
56*29959Smckusick unsigned short new_msk;
57*29959Smckusick unsigned long tst_msk;
58*29959Smckusick 
59*29959Smckusick long traper_(msk)
60*29959Smckusick long	*msk;
61*29959Smckusick {
62*29959Smckusick #define IOV_MASK (PSL_IV | PSL_FU)
63*29959Smckusick #define IOV_DISP 5
64*29959Smckusick 
65*29959Smckusick 	asm("	movpsl _old_msk");
66*29959Smckusick 
67*29959Smckusick 	old_msk = (old_msk & IOV_MASK) >> IOV_DISP;
68*29959Smckusick 
69*29959Smckusick 	new_msk = (*msk << IOV_DISP) & IOV_MASK;
70*29959Smckusick 	asm("	bispsw _new_msk");
71*29959Smckusick 
72*29959Smckusick 	new_msk = ~(*msk << IOV_DISP) & IOV_MASK;
73*29959Smckusick 	asm("	bicpsw _new_msk");
74*29959Smckusick 
75*29959Smckusick 	return(old_msk);
76*29959Smckusick }
77*29959Smckusick #endif tahoe
78