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