xref: /original-bsd/usr.bin/f77/libF77/trpfpe_.c (revision b366b3c1)
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[] = "@(#)trpfpe_.c	5.7 (Berkeley) 04/12/91";
10 #endif /* not lint */
11 
12 /* #define OLD_BSD if you're running < 4.2 bsd */
13 
14 /*
15  *	Fortran floating-point error handler
16  *
17  *	Synopsis:
18  *		call trpfpe (n, retval)
19  *			causes floating point faults to be trapped, with the
20  *			first 'n' errors getting a message printed.
21  *			'retval' is put in place of the bad result.
22  *		k = fpecnt()
23  *			causes 'k' to get the number of errors since the
24  *			last call to trpfpe().
25  *
26  *		common /fpeflt/ fpflag
27  *		logical fpflag
28  *			fpflag will become .true. on faults
29  *
30  *	David Wasley, UCBerkeley, June 1983.
31  */
32 
33 
34 #include <stdio.h>
35 #include <sys/signal.h>
36 #include "../libI77/fiodefs.h"
37 
38 #define	SIG_VAL		void (*)()
39 
40 #ifdef vax
41 #include "opcodes.h"
42 #include "operand.h"
43 
44 struct arglist {		/* what AP points to */
45 	long	al_numarg;	/* only true in CALLS format */
46 	long	al_arg[256];
47 };
48 
49 struct cframe {			/* VAX call frame */
50 	long		cf_handler;
51 	unsigned short	cf_psw;
52 	unsigned short	cf_mask;
53 	struct arglist	*cf_ap;
54 	struct cframe	*cf_fp;
55 	char		*cf_pc;
56 };
57 
58 /*
59  * bits in the PSW
60  */
61 #define	PSW_V	0x2
62 #define	PSW_FU	0x40
63 #define	PSW_IV	0x20
64 
65 /*
66  * where the registers are stored as we see them in the handler
67  */
68 struct reg0_6 {
69 	long	reg[7];
70 };
71 
72 struct reg7_11 {
73 	long	reg[5];
74 };
75 
76 #define	iR0	reg0_6->reg[0]
77 #define	iR1	reg0_6->reg[1]
78 #define	iR2	reg0_6->reg[2]
79 #define	iR3	reg0_6->reg[3]
80 #define	iR4	reg0_6->reg[4]
81 #define	iR5	reg0_6->reg[5]
82 #define	iR6	reg0_6->reg[6]
83 #define	iR7	reg7_11->reg[0]
84 #define	iR8	reg7_11->reg[1]
85 #define	iR9	reg7_11->reg[2]
86 #define	iR10	reg7_11->reg[3]
87 #define	iR11	reg7_11->reg[4]
88 
89 union objects {		/* for load/store */
90 	char	ua_byte;
91 	short	ua_word;
92 	long	ua_long;
93 	float	ua_float;
94 	double	ua_double;
95 	union objects	*ua_anything;
96 };
97 
98 typedef union objects	anything;
99 enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN };
100 
101 
102 /*
103  * assembly language assist
104  * There are some things you just can't do in C
105  */
106 asm(".text");
107 
108 struct cframe	*myfp();
109 asm("_myfp: .word 0x0");
110 	asm("movl 12(fp),r0");
111 	asm("ret");
112 
113 struct arglist	*myap();
114 asm("_myap: .word 0x0");
115 	asm("movl 8(fp),r0");
116 	asm("ret");
117 
118 char	*mysp();
119 asm("_mysp: .word 0x0");
120 	asm("extzv $30,$2,4(fp),r0");
121 	asm("addl2 ap,r0");	/* SP in caller is AP+4 here + SPA bits! */
122 	asm("addl2 $4,r0");
123 	asm("ret");
124 
125 char	*mypc();
126 asm("_mypc: .word 0x0");
127 	asm("movl 16(fp),r0");
128 	asm("ret");
129 
130 asm(".data");
131 
132 
133 /*
134  * Where interrupted objects are
135  */
136 static struct cframe	**ifp;	/* addr of saved FP */
137 static struct arglist	**iap;	/* addr of saved AP */
138 static char		 *isp;	/* value of interrupted SP */
139 static char		**ipc;	/* addr of saved PC */
140 static struct reg0_6	*reg0_6;/* registers 0-6 are saved on the exception */
141 static struct reg7_11	*reg7_11;/* we save 7-11 by our entry mask */
142 static anything		*result_addr;	/* where the dummy result goes */
143 static enum object_type	 result_type;	/* what kind of object it is */
144 
145 /*
146  * some globals
147  */
148 static union {
149 	long	rv_long[2];
150 	float	rv_float;
151 	double	rv_double;
152 			} retval; /* the user specified dummy result */
153 static int	max_messages	= 1;		/* the user can tell us */
154 static int	fpe_count	= 0;		/* how bad is it ? */
155        long	fpeflt_		= 0;	/* fortran "common /fpeflt/ flag" */
156 static sig_t	sigfpe_dfl	= SIG_DFL;	/* if we can't fix it ... */
157 
158 /*
159  * The fortran unit control table
160  */
161 extern unit units[];
162 
163 /*
164  * Fortran message table is in main
165  */
166 struct msgtbl {
167 	char	*mesg;
168 	int	dummy;
169 };
170 extern struct msgtbl	act_fpe[];
171 
172 
173 /*
174  * Get the address of the (saved) next operand & update saved PC.
175  * The major purpose of this is to determine where to store the result.
176  * There is one case we can't deal with: -(SP) or (SP)+
177  * since we can't change the size of the stack.
178  * Let's just hope compilers don't generate that for results.
179  */
180 
181 anything *
182 get_operand (oper_size)
183 	int	oper_size;	/* size of operand we expect */
184 {
185 	register int	regnum;
186 	register int	operand_code;
187 	int		index;
188 	anything	*oper_addr;
189 	anything	*reg_addr;
190 
191 	regnum = (**ipc & 0xf);
192 	if (regnum == PC)
193 		operand_code = (*(*ipc)++ & 0xff);
194 	else
195 		operand_code = (*(*ipc)++ & 0xf0);
196 	if (regnum <= R6)
197 		reg_addr = (anything *)&reg0_6->reg[regnum];
198 	else if (regnum <= R11)
199 		reg_addr = (anything *)&reg7_11->reg[regnum];
200 	else if (regnum == AP)
201 		reg_addr = (anything *)iap;
202 	else if (regnum == FP)
203 		reg_addr = (anything *)ifp;
204 	else if (regnum == SP)
205 		reg_addr = (anything *)&isp;	/* We saved this ourselves */
206 	else if (regnum == PC)
207 		reg_addr = (anything *)ipc;
208 
209 
210 	switch (operand_code)
211 	{
212 		case IMMEDIATE:
213 			oper_addr = (anything *)(*ipc);
214 			*ipc += oper_size;
215 			return(oper_addr);
216 
217 		case ABSOLUTE:
218 			oper_addr = (anything *)(**ipc);
219 			*ipc += sizeof (anything *);
220 			return(oper_addr);
221 
222 		case LITERAL0:
223 		case LITERAL1:
224 		case LITERAL2:
225 		case LITERAL3:
226 			/* we don't care about the address of these */
227 			return((anything *)0);
228 
229 		case INDEXED:
230 			index = reg_addr->ua_long * oper_size;
231 			oper_addr = (anything *)(get_operand(sizeof (long))->ua_long + index);
232 			return(oper_addr);
233 
234 		case REGISTER:
235 			return(reg_addr);
236 
237 		case REGDEFERED:
238 			return(reg_addr->ua_anything);
239 
240 		case AUTODEC:
241 			if (regnum == SP)
242 			{
243 				fprintf(stderr, "trp: can't fix -(SP) operand\n");
244 				exit(1);
245 			}
246 			reg_addr->ua_long -= oper_size;
247 			oper_addr = reg_addr->ua_anything;
248 			return(oper_addr);
249 
250 		case AUTOINC:
251 			if (regnum == SP)
252 			{
253 				fprintf(stderr, "trp: can't fix (SP)+ operand\n");
254 				exit(1);
255 			}
256 			oper_addr = reg_addr->ua_anything;
257 			reg_addr->ua_long += oper_size;
258 			return(oper_addr);
259 
260 		case AUTOINCDEF:
261 			if (regnum == SP)
262 			{
263 				fprintf(stderr, "trp: can't fix @(SP)+ operand\n");
264 				exit(1);
265 			}
266 			oper_addr = (reg_addr->ua_anything)->ua_anything;
267 			reg_addr->ua_long += sizeof (anything *);
268 			return(oper_addr);
269 
270 		case BYTEDISP:
271 		case BYTEREL:
272 			index = ((anything *)(*ipc))->ua_byte;
273 			*ipc += sizeof (char);	/* do it now in case reg==PC */
274 			oper_addr = (anything *)(index + reg_addr->ua_long);
275 			return(oper_addr);
276 
277 		case BYTEDISPDEF:
278 		case BYTERELDEF:
279 			index = ((anything *)(*ipc))->ua_byte;
280 			*ipc += sizeof (char);	/* do it now in case reg==PC */
281 			oper_addr = (anything *)(index + reg_addr->ua_long);
282 			oper_addr = oper_addr->ua_anything;
283 			return(oper_addr);
284 
285 		case WORDDISP:
286 		case WORDREL:
287 			index = ((anything *)(*ipc))->ua_word;
288 			*ipc += sizeof (short);	/* do it now in case reg==PC */
289 			oper_addr = (anything *)(index + reg_addr->ua_long);
290 			return(oper_addr);
291 
292 		case WORDDISPDEF:
293 		case WORDRELDEF:
294 			index = ((anything *)(*ipc))->ua_word;
295 			*ipc += sizeof (short);	/* do it now in case reg==PC */
296 			oper_addr = (anything *)(index + reg_addr->ua_long);
297 			oper_addr = oper_addr->ua_anything;
298 			return(oper_addr);
299 
300 		case LONGDISP:
301 		case LONGREL:
302 			index = ((anything *)(*ipc))->ua_long;
303 			*ipc += sizeof (long);	/* do it now in case reg==PC */
304 			oper_addr = (anything *)(index + reg_addr->ua_long);
305 			return(oper_addr);
306 
307 		case LONGDISPDEF:
308 		case LONGRELDEF:
309 			index = ((anything *)(*ipc))->ua_long;
310 			*ipc += sizeof (long);	/* do it now in case reg==PC */
311 			oper_addr = (anything *)(index + reg_addr->ua_long);
312 			oper_addr = oper_addr->ua_anything;
313 			return(oper_addr);
314 
315 		/* NOTREACHED */
316 	}
317 }
318 
319 /*
320  * Trap & repair floating exceptions so that a program may proceed.
321  * There is no notion of "correctness" here; just the ability to continue.
322  *
323  * The on_fpe() routine first checks the type code to see if the
324  * exception is repairable. If so, it checks the opcode to see if
325  * it is one that it knows. If this is true, it then simulates the
326  * VAX cpu in retrieving operands in order to increment iPC correctly.
327  * It notes where the result of the operation would have been stored
328  * and substitutes a previously supplied value.
329  */
330 
331 #ifdef	OLD_BSD
332 on_fpe(signo, code, myaddr, pc, ps)
333 	int signo, code, ps;
334 	char *myaddr, *pc;
335 #else
336 void
337 on_fpe(signo, code, sc, grbg)
338 	int signo, code;
339 	struct sigcontext *sc;
340 #endif
341 {
342 	/*
343 	 * There must be at least 5 register variables here
344 	 * so our entry mask will save R11-R7.
345 	 */
346 	register long	*stk;
347 	register long	*sp;
348 	register struct arglist	*ap;
349 	register struct cframe	*fp;
350 	register FILE	*ef;
351 
352 	ef = units[STDERR].ufd;		/* fortran error stream */
353 
354 	switch (code)
355 	{
356 		case FPE_INTOVF_TRAP:	/* integer overflow */
357 		case FPE_INTDIV_TRAP:	/* integer divide by zero */
358 		case FPE_FLTOVF_TRAP:	/* floating overflow */
359 		case FPE_FLTDIV_TRAP:	/* floating/decimal divide by zero */
360 		case FPE_FLTUND_TRAP:	/* floating underflow */
361 		case FPE_DECOVF_TRAP:	/* decimal overflow */
362 		case FPE_SUBRNG_TRAP:	/* subscript out of range */
363 		default:
364 cant_fix:
365 			if (sigfpe_dfl > (SIG_VAL)7)	/* user specified */
366 #ifdef	OLD_BSD
367 				(*sigfpe_dfl)(signo, code, myaddr, pc, ps);
368 #else
369 				(*sigfpe_dfl)(signo, code, sc, grbg);
370 #endif
371 			else
372 #ifdef	OLD_BSD
373 				sigdie(signo, code, myaddr, pc, ps);
374 #else
375 				sigdie(signo, code, sc, grbg);
376 #endif
377 			/* NOTREACHED */
378 
379 		case FPE_FLTOVF_FAULT:	/* floating overflow fault */
380 		case FPE_FLTDIV_FAULT:	/* divide by zero floating fault */
381 		case FPE_FLTUND_FAULT:	/* floating underflow fault */
382 			if (++fpe_count <= max_messages) {
383 				fprintf(ef, "trpfpe: %s",
384 					act_fpe[code-1].mesg);
385 				if (fpe_count == max_messages)
386 					fprintf(ef, ": No more messages will be printed.\n");
387 				else
388 					fputc('\n', ef);
389 			}
390 			fpeflt_ = -1;
391 			break;
392 	}
393 
394 	ap = myap();			/* my arglist pointer */
395 	fp = myfp();			/* my frame pointer */
396 	ifp = &(fp->cf_fp)->cf_fp;	/* user's stored in next frame back */
397 	iap = &(fp->cf_fp)->cf_ap;
398 	/*
399 	 * these are likely to be system dependent
400 	 */
401 	reg0_6 = (struct reg0_6 *)((char *)fp->cf_fp + sizeof (struct cframe));
402 	reg7_11 = (struct reg7_11 *)((char *)fp->cf_fp - sizeof (struct reg7_11));
403 
404 #ifdef	OLD_BSD
405 	ipc = &pc;
406 	isp = (char *)&ap->al_arg[ap->al_numarg + 2];	/* assumes 2 dummys */
407 	ps &= ~(PSW_V|PSW_FU);
408 #else
409 	ipc = (char **)&sc->sc_pc;
410 	isp = (char *)sc + sizeof (struct sigcontext);
411 	sc->sc_ps &= ~(PSW_V|PSW_FU);
412 #endif
413 
414 
415 	switch (*(*ipc)++)
416 	{
417 		case ADDD3:
418 		case DIVD3:
419 		case MULD3:
420 		case SUBD3:
421 			(void) get_operand(sizeof (double));
422 			/* intentional fall-thru */
423 
424 		case ADDD2:
425 		case DIVD2:
426 		case MULD2:
427 		case SUBD2:
428 		case MNEGD:
429 		case MOVD:
430 			(void) get_operand(sizeof (double));
431 			result_addr = get_operand(sizeof (double));
432 			result_type = DOUBLE;
433 			break;
434 
435 		case ADDF3:
436 		case DIVF3:
437 		case MULF3:
438 		case SUBF3:
439 			(void) get_operand(sizeof (float));
440 			/* intentional fall-thru */
441 
442 		case ADDF2:
443 		case DIVF2:
444 		case MULF2:
445 		case SUBF2:
446 		case MNEGF:
447 		case MOVF:
448 			(void) get_operand(sizeof (float));
449 			result_addr = get_operand(sizeof (float));
450 			result_type = FLOAT;
451 			break;
452 
453 		case CVTDF:
454 			(void) get_operand(sizeof (double));
455 			result_addr = get_operand(sizeof (float));
456 			result_type = FLOAT;
457 			break;
458 
459 		case CVTFD:
460 			(void) get_operand(sizeof (float));
461 			result_addr = get_operand(sizeof (double));
462 			result_type = DOUBLE;
463 			break;
464 
465 		case EMODF:
466 		case EMODD:
467 			fprintf(ef, "trpfpe: can't fix emod yet\n");
468 			goto cant_fix;
469 
470 		case POLYF:
471 		case POLYD:
472 			fprintf(ef, "trpfpe: can't fix poly yet\n");
473 			goto cant_fix;
474 
475 		case ACBD:
476 		case ACBF:
477 		case CMPD:
478 		case CMPF:
479 		case TSTD:
480 		case TSTF:
481 		case CVTDB:
482 		case CVTDL:
483 		case CVTDW:
484 		case CVTFB:
485 		case CVTFL:
486 		case CVTFW:
487 		case CVTRDL:
488 		case CVTRFL:
489 			/* These can generate only reserved operand faults */
490 			/* They are shown here for completeness */
491 
492 		default:
493 			fprintf(stderr, "trp: opcode 0x%02x unknown\n",
494 				*(--(*ipc)) & 0xff);
495 			goto cant_fix;
496 			/* NOTREACHED */
497 	}
498 
499 	if (result_type == FLOAT)
500 		result_addr->ua_float = retval.rv_float;
501 	else
502 	{
503 		if (result_addr == (anything *)&iR6)
504 		{	/*
505 			 * special case - the R6/R7 pair is stored apart
506 			 */
507 			result_addr->ua_long = retval.rv_long[0];
508 			((anything *)&iR7)->ua_long = retval.rv_long[1];
509 		}
510 		else
511 			result_addr->ua_double = retval.rv_double;
512 	}
513 	signal(SIGFPE, on_fpe);
514 }
515 
516 trpfpe_ (count, rval)
517 	long	*count;	/* how many to announce */
518 	double	*rval;	/* dummy return value */
519 {
520 	max_messages = *count;
521 	retval.rv_double = *rval;
522 	sigfpe_dfl = signal(SIGFPE, on_fpe);
523 	fpe_count = 0;
524 }
525 
526 long
527 fpecnt_ ()
528 {
529 	return (fpe_count);
530 }
531 #endif vax
532 
533 #ifdef tahoe
534 /*
535  *	This handler just prints a message. It cannot fix anything
536  * 	on Power6 because of its fpp architecture. In any case, there
537  * 	are no arithmetic faults (only traps) around, so that no instruction
538  *	is interrupted befor it completes, and PC points to the next floating
539  *	point instruction (not necessarily next executable instr after the one
540  *	that got the exception).
541  */
542 
543 struct arglist {		/* what AP points to */
544 	long	al_arg[256];
545 };
546 
547 struct reg0_1 {
548 	long	reg[2];
549 };
550 struct reg2_12 {
551 	long	reg[11];
552 };
553 #include <sys/types.h>
554 #include <frame.h>
555 #include "sigframe.h"
556 
557 /*
558  * bits in the PSL
559  */
560 #include <machine/psl.h>
561 
562 /*
563  * where the registers are stored as we see them in the handler
564  */
565 
566 
567 #define	iR0	reg0_1->reg[1]
568 #define	iR1	reg0_1->reg[0]
569 
570 #define	iR2	reg2_12->reg[0]
571 #define	iR3	reg2_12->reg[1]
572 #define	iR4	reg2_12->reg[2]
573 #define	iR5	reg2_12->reg[3]
574 #define	iR6	reg2_12->reg[4]
575 #define	iR7	reg2_12->reg[5]
576 #define	iR8	reg2_12->reg[6]
577 #define	iR9	reg2_12->reg[7]
578 #define	iR10	reg2_12->reg[8]
579 #define	iR11	reg2_12->reg[9]
580 #define	iR12	reg2_12->reg[10]
581 
582 union objects {		/* for load/store */
583 	char	ua_byte;
584 	short	ua_word;
585 	long	ua_long;
586 	float	ua_float;
587 	double	ua_double;
588 	union objects	*ua_anything;
589 };
590 
591 typedef union objects	anything;
592 enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN };
593 
594 
595 /*
596  * assembly language assist
597  * There are some things you just can't do in C
598  */
599 asm(".text");
600 
601 long *myfp();
602 asm("_myfp: .word 0");
603 	asm("movl (fp),r0");
604 	asm("ret");
605 
606 struct frame *framep(p)
607 long *p;
608 {
609 	return((struct frame *)(p-2));
610 }
611 
612 struct arglist	*argp(p)
613 long *p;
614 {
615 	return((struct arglist *)(p+1));
616 }
617 
618 char	*mysp();
619 asm("_mysp: .word 0");
620 	asm("addl3 $4,fp,r0");
621 	asm("ret");
622 
623 char	*mypc();
624 asm("_mypc: .word 0");
625 	asm("movl -8(fp),r0");
626 	asm("ret");
627 
628 asm(".data");
629 
630 
631 /*
632  * Where interrupted objects are
633  */
634 static struct frame	*ifp;	/* addr of saved FP */
635 static struct arglist	*iap;	/* addr of saved AP */
636 static char		 *isp;	/* value of interrupted SP */
637 static char		**ipc;	/* addr of saved PC */
638 static struct reg0_1	*reg0_1;/* registers 0-1 are saved on the exception */
639 static struct reg2_12	*reg2_12;/* we save 2-12 by our entry mask */
640 static anything		*result_addr;	/* where the dummy result goes */
641 static enum object_type	 result_type;	/* what kind of object it is */
642 
643 /*
644  * some globals
645  */
646 static union {
647 	long	rv_long[2];
648 	float	rv_float;
649 	double	rv_double;
650 			} retval; /* the user specified dummy result */
651 static int	max_messages	= 1;		/* the user can tell us */
652 static int	fpe_count	= 0;		/* how bad is it ? */
653        long	fpeflt_		= 0;	/* fortran "common /fpeflt/ flag" */
654 static sig_t sigfpe_dfl		= SIG_DFL;	/* if we can't fix it ... */
655 
656 /*
657  * The fortran unit control table
658  */
659 extern unit units[];
660 
661 /*
662  * Fortran message table is in main
663  */
664 struct msgtbl {
665 	char	*mesg;
666 	int	dummy;
667 };
668 extern struct msgtbl	act_fpe[];
669 
670 
671 /* VALID ONLY ON VAX !!!
672  *
673  * Get the address of the (saved) next operand & update saved PC.
674  * The major purpose of this is to determine where to store the result.
675  * There is one case we can't deal with: -(SP) or (SP)+
676  * since we can't change the size of the stack.
677  * Let's just hope compilers don't generate that for results.
678  */
679 
680 
681 /*
682  * Trap & repair floating exceptions so that a program may proceed.
683  * There is no notion of "correctness" here; just the ability to continue.
684  *
685  * The on_fpe() routine first checks the type code to see if the
686  * exception is repairable. If so, it checks the opcode to see if
687  * it is one that it knows. If this is true, it then simulates the
688  * VAX cpu in retrieving operands in order to increment iPC correctly.
689  * It notes where the result of the operation would have been stored
690  * and substitutes a previously supplied value.
691  *  DOES NOT REPAIR ON TAHOE !!!
692  */
693 void
694 on_fpe(signo, code, sc)
695 	int signo, code;
696 	struct sigcontext *sc;
697 {
698 	/*
699 	 * There must be at least 11 register variables here
700 	 * so our entry mask will save R12-R2.
701 	 */
702 	register long	*stk;
703 	register long	*sp, *rfp;
704 	register struct arglist	*ap;
705 	register struct frame	*fp;
706 	register FILE	*ef;
707 	register struct sigframe *sfp;
708 	register long dmy1, dmy2, dmy3, dmy4;
709 
710 	dmy1 = dmy2 = dmy3 = dmy4 = 0;
711 
712 	ef = units[STDERR].ufd;		/* fortran error stream */
713 
714 	switch (code)
715 	{
716 		case FPE_INTOVF_TRAP:	/* integer overflow */
717 		case FPE_INTDIV_TRAP:	/* integer divide by zero */
718 		case FPE_FLTOVF_TRAP:	/* floating overflow */
719 		case FPE_FLTDIV_TRAP:	/* floating divide by zero */
720 		case FPE_FLTUND_TRAP:	/* floating underflow */
721 		default:
722 cant_fix:
723 			if (sigfpe_dfl > (SIG_VAL)7)	/* user specified */
724 				(*sigfpe_dfl)(signo, code, sc);
725 			else
726 			if (++fpe_count <= max_messages) {
727 				fprintf(ef, "trpfpe: %s",
728 					act_fpe[code-1].mesg);
729 				if (fpe_count == max_messages)
730 					fprintf(ef, ": No more messages will be printed.\n");
731 				else
732 					fputc('\n', ef);
733 			}
734 			fpeflt_ = -1;
735 			break;
736 	}
737 
738 /*
739  * Find all the registers just in case something better can be done.
740  */
741 
742 	rfp = myfp();			/* contents of fp register */
743 	ap = argp(rfp);			/* my arglist pointer */
744 	fp = framep(rfp);		/* my frame pointer */
745 	ifp = framep(*rfp);		/* user's stored in next frame back */
746 	iap = argp(*rfp);
747 
748 	sfp = (struct sigframe *)ap;	/* sigframe contains at its bottom the
749 					   signal handler arguments */
750 
751 	reg0_1 = (struct reg0_1 *)&sfp->r1;
752 	reg2_12 = (struct reg2_12 *)((char *)fp - sizeof (struct reg2_12));
753 
754 	ipc = (char **)&sc->sc_pc;
755 	isp = (char *)sc + sizeof (struct sigcontext);
756 	sc->sc_ps &= ~(PSL_V|PSL_FU);
757 
758 	fprintf(ef, "Current PC = %X \n", sc->sc_pc);
759 
760 	signal(SIGFPE, on_fpe);
761 	sigdie(signo, code, sc);
762 }
763 
764 trpfpe_ (count, rval)
765 	long	*count;	/* how many to announce */
766 	double	*rval;	/* dummy return value */
767 {
768 	max_messages = *count;
769 	retval.rv_double = *rval;
770 	sigfpe_dfl = signal(SIGFPE, on_fpe);
771 	fpe_count = 0;
772 }
773 
774 long
775 fpecnt_ ()
776 {
777 	return (fpe_count);
778 }
779 
780 #endif tahoe
781