![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to trpfpe_.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libF77|
Return to trpfpe_.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libF77 |
1.1 root 1: /*
2: * @(#)trpfpe_.c 1.1 6/7/85
3: *
4: *
5: * Fortran floating-point error handler
6: *
7: * Synopsis:
8: * call trpfpe (n, retval)
9: * causes floating point faults to be trapped, with the
10: * first 'n' errors getting a message printed.
11: * 'retval' is put in place of the bad result.
12: * k = fpecnt()
13: * causes 'k' to get the number of errors since the
14: * last call to trpfpe().
15: *
16: * common /fpeflt/ fpflag
17: * logical fpflag
18: * fpflag will become .true. on faults
19: *
20: * This handler just prints a message. It cannot fix anything
21: * on Power6 because of its fpp architecture. In any case, there
22: * are no arithmetic faults (only traps) around, so that no instruction
23: * is interrupted befor it completes, and PC points to the next floating
24: * point instruction (not necessarily next executable instr after the one
25: * that got the exception).
26: */
27:
28:
29: #include <stdio.h>
30: #include <signal.h>
31: #include "../libI77/fiodefs.h"
32:
33: #define SIG_VAL int (*)()
34:
35:
36: struct arglist { /* what AP points to */
37: long al_arg[256];
38: };
39:
40: struct reg0_1 {
41: long reg[2];
42: };
43: struct reg2_12 {
44: long reg[11];
45: };
46: #include <sys/types.h>
47: #include <frame.h>
48: #include "sigframe.h"
49:
50: /*
51: * bits in the PSL
52: */
53: #include <machine/psl.h>
54:
55: /*
56: * where the registers are stored as we see them in the handler
57: */
58:
59:
60: #define iR0 reg0_1->reg[1]
61: #define iR1 reg0_1->reg[0]
62:
63: #define iR2 reg2_12->reg[0]
64: #define iR3 reg2_12->reg[1]
65: #define iR4 reg2_12->reg[2]
66: #define iR5 reg2_12->reg[3]
67: #define iR6 reg2_12->reg[4]
68: #define iR7 reg2_12->reg[5]
69: #define iR8 reg2_12->reg[6]
70: #define iR9 reg2_12->reg[7]
71: #define iR10 reg2_12->reg[8]
72: #define iR11 reg2_12->reg[9]
73: #define iR12 reg2_12->reg[10]
74:
75: union objects { /* for load/store */
76: char ua_byte;
77: short ua_word;
78: long ua_long;
79: float ua_float;
80: double ua_double;
81: union objects *ua_anything;
82: };
83:
84: typedef union objects anything;
85: enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN };
86:
87:
88: /*
89: * assembly language assist
90: * There are some things you just can't do in C
91: */
92: asm(".text");
93:
94: long *myfp();
95: asm("_myfp: .word 0");
96: asm("movl (fp),r0");
97: asm("ret");
98:
99: struct frame *framep(p)
100: long *p;
101: {
102: return((struct frame *)(p-2));
103: }
104:
105: struct arglist *argp(p)
106: long *p;
107: {
108: return((struct arglist *)(p+1));
109: }
110:
111: char *mysp();
112: asm("_mysp: .word 0");
113: asm("addl3 $4,fp,r0");
114: asm("ret");
115:
116: char *mypc();
117: asm("_mypc: .word 0");
118: asm("movl -8(fp),r0");
119: asm("ret");
120:
121: asm(".data");
122:
123:
124: /*
125: * Where interrupted objects are
126: */
127: static struct frame *ifp; /* addr of saved FP */
128: static struct arglist *iap; /* addr of saved AP */
129: static char *isp; /* value of interrupted SP */
130: static char **ipc; /* addr of saved PC */
131: static struct reg0_1 *reg0_1;/* registers 0-1 are saved on the exception */
132: static struct reg2_12 *reg2_12;/* we save 2-12 by our entry mask */
133: static anything *result_addr; /* where the dummy result goes */
134: static enum object_type result_type; /* what kind of object it is */
135:
136: /*
137: * some globals
138: */
139: static union {
140: long rv_long[2];
141: float rv_float;
142: double rv_double;
143: } retval; /* the user specified dummy result */
144: static int max_messages = 1; /* the user can tell us */
145: static int fpe_count = 0; /* how bad is it ? */
146: long fpeflt_ = 0; /* fortran "common /fpeflt/ flag" */
147: static int (*sigfpe_dfl)() = SIG_DFL; /* if we can't fix it ... */
148:
149: /*
150: * The fortran unit control table
151: */
152: extern unit units[];
153:
154: /*
155: * Fortran message table is in main
156: */
157: struct msgtbl {
158: char *mesg;
159: int dummy;
160: };
161: extern struct msgtbl act_fpe[];
162:
163:
164: /* VALID ONLY ON VAX !!!
165: *
166: * Get the address of the (saved) next operand & update saved PC.
167: * The major purpose of this is to determine where to store the result.
168: * There is one case we can't deal with: -(SP) or (SP)+
169: * since we can't change the size of the stack.
170: * Let's just hope compilers don't generate that for results.
171: */
172:
173:
174: /*
175: * Trap & repair floating exceptions so that a program may proceed.
176: * There is no notion of "correctness" here; just the ability to continue.
177: *
178: * The on_fpe() routine first checks the type code to see if the
179: * exception is repairable. If so, it checks the opcode to see if
180: * it is one that it knows. If this is true, it then simulates the
181: * VAX cpu in retrieving operands in order to increment iPC correctly.
182: * It notes where the result of the operation would have been stored
183: * and substitutes a previously supplied value.
184: * DOES NOT REPAIR ON TAHOE !!!
185: */
186:
187: on_fpe(signo, code, sc)
188: int signo, code;
189: struct sigcontext *sc;
190: {
191: /*
192: * There must be at least 11 register variables here
193: * so our entry mask will save R12-R2.
194: */
195: register long *stk;
196: register long *sp, *rfp;
197: register struct arglist *ap;
198: register struct frame *fp;
199: register FILE *ef;
200: register struct sigframe *sfp;
201: register long dmy1, dmy2, dmy3, dmy4;
202:
203: dmy1 = dmy2 = dmy3 = dmy4 = 0;
204:
205: ef = units[STDERR].ufd; /* fortran error stream */
206:
207: switch (code)
208: {
209: case FPE_INTOVF_TRAP: /* integer overflow */
210: case FPE_INTDIV_TRAP: /* integer divide by zero */
211: case FPE_FLTOVF_TRAP: /* floating overflow */
212: case FPE_FLTDIV_TRAP: /* floating divide by zero */
213: case FPE_FLTUND_TRAP: /* floating underflow */
214: default:
215: cant_fix:
216: if (sigfpe_dfl > (SIG_VAL)7) /* user specified */
217: return((*sigfpe_dfl)(signo, code, sc));
218: else
219: if (++fpe_count <= max_messages) {
220: fprintf(ef, "trpfpe: %s",
221: act_fpe[code-1].mesg);
222: if (fpe_count == max_messages)
223: fprintf(ef, ": No more messages will be printed.\n");
224: else
225: fputc('\n', ef);
226: }
227: fpeflt_ = -1;
228: break;
229: }
230:
231: /*
232: * Find all the registers just in case something better can be done.
233: */
234:
235: rfp = myfp(); /* contents of fp register */
236: ap = argp(rfp); /* my arglist pointer */
237: fp = framep(rfp); /* my frame pointer */
238: ifp = framep(*rfp); /* user's stored in next frame back */
239: iap = argp(*rfp);
240:
241: sfp = (struct sigframe *)ap; /* sigframe contains at its bottom the
242: signal handler arguments */
243:
244: reg0_1 = (struct reg0_1 *)&sfp->r1;
245: reg2_12 = (struct reg2_12 *)((char *)fp - sizeof (struct reg2_12));
246:
247: ipc = (char **)&sc->sc_pc;
248: isp = (char *)sc + sizeof (struct sigcontext);
249: sc->sc_ps &= ~(PSL_V|PSL_FU);
250:
251: fprintf(ef, "Current PC = %X \n", sc->sc_pc);
252:
253: signal(SIGFPE, on_fpe);
254: sigdie(signo, code, sc);
255: }
256:
257: trpfpe_ (count, rval)
258: long *count; /* how many to announce */
259: double *rval; /* dummy return value */
260: {
261: max_messages = *count;
262: retval.rv_double = *rval;
263: sigfpe_dfl = signal(SIGFPE, on_fpe);
264: fpe_count = 0;
265: }
266:
267: long
268: fpecnt_ ()
269: {
270: return (fpe_count);
271: }
272:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.