xref: /original-bsd/usr.bin/f77/libF77/traper_.c (revision 7eb91141)
1 /*-
2  * Copyright (c) 1980 The Regents of the University of California.
3  * All rights reserved.
4  *
5  * %sccs.include.proprietary.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)traper_.c	5.4 (Berkeley) 04/12/91";
10 #endif /* not lint */
11 
12 /*
13  * Full of Magic! DON'T CHANGE ANYTHING !!
14  *
15  * To use from f77:
16  *	integer oldmsk, traper
17  *	oldmsk = traper (mask)
18  * where for vax:
19  *	mask = 1 to trap integer overflow
20  *	mask = 2 to trap floating underflow
21  *	mask = 3 to trap both
22  *	These 2 bits will be set into the PSW.
23  *	The old state will be returned.
24  *
25  * where for CCI:
26  *	mask = 0 to trap neither
27  *	mask = 1 to trap integer overflow
28  *	mask = 2 to trap floating underflow
29  *	mask = 3 to trap both
30  *	These 2 bits will be set into the PSL.
31  *	The old state will be returned.
32  */
33 
34 #ifdef vax
35 long traper_(msk)
36 long	*msk;
37 {
38 	int	old = 0;
39 #define IOV_MASK	0140
40 	int	**s = &msk;
41 	int	psw;
42 
43 	s -= 5;
44 	psw = (int)*s;
45 	old = (psw & IOV_MASK) >> 5;
46 	psw = (psw & ~IOV_MASK) | ((*msk << 5) & IOV_MASK);
47 	*s = (int *)psw;
48 	return((long)old);
49 }
50 #endif	vax
51 
52 /*
53  * Assumptions for CCI:
54  *	- the two bits are contiguous in PSL;
55  *	- integer overflow trap enable bit < floating underflow trap enable bit;
56  */
57 #ifdef tahoe
58 # include <machine/psl.h>
59 
60 unsigned long old_msk;
61 unsigned short new_msk;
62 unsigned long tst_msk;
63 
64 long traper_(msk)
65 long	*msk;
66 {
67 #define IOV_MASK (PSL_IV | PSL_FU)
68 #define IOV_DISP 5
69 
70 	asm("	movpsl _old_msk");
71 
72 	old_msk = (old_msk & IOV_MASK) >> IOV_DISP;
73 
74 	new_msk = (*msk << IOV_DISP) & IOV_MASK;
75 	asm("	bispsw _new_msk");
76 
77 	new_msk = ~(*msk << IOV_DISP) & IOV_MASK;
78 	asm("	bicpsw _new_msk");
79 
80 	return(old_msk);
81 }
82 #endif tahoe
83