![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to trapov_.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / usr.lib / libF77|
Return to trapov_.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.lib / libF77 |
1.1 root 1: /*
2: char id_trapov[] = "@(#)trapov_.c 1.2";
3: *
4: * Fortran/C floating-point overflow handler
5: *
6: * The idea of these routines is to catch floating-point overflows
7: * and print an eror message. When we then get a reserved operand
8: * exception, we then fix up the value to the highest possible
9: * number. Keen, no?
10: * Messy, yes!
11: *
12: * Synopsis:
13: * call trapov(n)
14: * causes overflows to be trapped, with the first 'n'
15: * overflows getting an "Overflow!" message printed.
16: * k = ovcnt(0)
17: * causes 'k' to get the number of overflows since the
18: * last call to trapov().
19: *
20: * Gary Klimowicz, April 17, 1981
21: * Integerated with libF77: David Wasley, UCB, July 1981.
22: */
23:
24: # include <stdio.h>
25: # include <signal.h>
26: # include "opcodes.h"
27: # include "../libI77/fiodefs.h"
28: # define SIG_VAL int (*)()
29:
30: /*
31: * Operand modes
32: */
33: # define LITERAL0 0x0
34: # define LITERAL1 0x1
35: # define LITERAL2 0x2
36: # define LITERAL3 0x3
37: # define INDEXED 0x4
38: # define REGISTER 0x5
39: # define REG_DEF 0x6
40: # define AUTO_DEC 0x7
41: # define AUTO_INC 0x8
42: # define AUTO_INC_DEF 0x9
43: # define BYTE_DISP 0xa
44: # define BYTE_DISP_DEF 0xb
45: # define WORD_DISP 0xc
46: # define WORD_DISP_DEF 0xd
47: # define LONG_DISP 0xe
48: # define LONG_DISP_DEF 0xf
49:
50: /*
51: * Operand value types
52: */
53: # define F 1
54: # define D 2
55: # define IDUNNO 3
56:
57: # define PC 0xf
58: # define SP 0xe
59: # define FP 0xd
60: # define AP 0xc
61:
62: /*
63: * trap type codes
64: */
65: # define INT_OVF_T 1
66: # define INT_DIV_T 2
67: # define FLT_OVF_T 3
68: # define FLT_DIV_T 4
69: # define FLT_UND_T 5
70: # define DEC_OVF_T 6
71: # define SUB_RNG_T 7
72: # define FLT_OVF_F 8
73: # define FLT_DIV_F 9
74: # define FLT_UND_F 10
75:
76: # define RES_ADR_F 0
77: # define RES_OPC_F 1
78: # define RES_OPR_F 2
79:
80: /*
81: * Potential operand values
82: */
83: typedef union operand_types {
84: char o_byte;
85: short o_word;
86: long o_long;
87: float o_float;
88: long o_quad[2];
89: double o_double;
90: } anyval;
91:
92: /*
93: * GLOBAL VARIABLES (we need a few)
94: *
95: * Actual program counter and locations of registers.
96: */
97: #if vax
98: static char *pc;
99: static int *regs0t6;
100: static int *regs7t11;
101: static int max_messages;
102: static int total_overflows;
103: static union {
104: long v_long[2];
105: double v_double;
106: } retrn;
107: static int (*sigill_default)() = (SIG_VAL)-1;
108: static int (*sigfpe_default)();
109: #endif vax
110:
111: /*
112: * the fortran unit control table
113: */
114: extern unit units[];
115:
116: /*
117: * Fortran message table is in main
118: */
119: struct msgtbl {
120: char *mesg;
121: int dummy;
122: };
123: extern struct msgtbl act_fpe[];
124:
125:
126:
127: anyval *get_operand_address(), *addr_of_reg();
128: char *opcode_name();
129:
130: /*
131: * This routine sets up the signal handler for the floating-point
132: * and reserved operand interrupts.
133: */
134:
135: trapov_(count, rtnval)
136: int *count;
137: double *rtnval;
138: {
139: #if vax
140: extern got_overflow(), got_illegal_instruction();
141:
142: sigfpe_default = signal(SIGFPE, got_overflow);
143: if (sigill_default == (SIG_VAL)-1)
144: sigill_default = signal(SIGILL, got_illegal_instruction);
145: total_overflows = 0;
146: max_messages = *count;
147: retrn.v_double = *rtnval;
148: }
149:
150:
151:
152: /*
153: * got_overflow - routine called when overflow occurs
154: *
155: * This routine just prints a message about the overflow.
156: * It is impossible to find the bad result at this point.
157: * Instead, we wait until we get the reserved operand exception
158: * when we try to use it. This raises the SIGILL signal.
159: */
160:
161: /*ARGSUSED*/
162: got_overflow(signo, codeword, myaddr, pc, ps)
163: char *myaddr, *pc;
164: {
165: int *sp, i;
166: FILE *ef;
167:
168: signal(SIGFPE, got_overflow);
169: ef = units[STDERR].ufd;
170: switch (codeword) {
171: case INT_OVF_T:
172: case INT_DIV_T:
173: case FLT_UND_T:
174: case DEC_OVF_T:
175: case SUB_RNG_T:
176: case FLT_OVF_F:
177: case FLT_DIV_F:
178: case FLT_UND_F:
179: if (sigfpe_default > (SIG_VAL)7)
180: return((*sigfpe_default)(signo, codeword, myaddr, pc, ps));
181: else
182: sigdie(signo, codeword, myaddr, pc, ps);
183: /* NOTREACHED */
184:
185: case FLT_OVF_T:
186: case FLT_DIV_T:
187: if (++total_overflows <= max_messages) {
188: fprintf(ef, "trapov: %s",
189: act_fpe[codeword-1].mesg);
190: if (total_overflows == max_messages)
191: fprintf(ef, ": No more messages will be printed.\n");
192: else
193: fputc('\n', ef);
194: }
195: return;
196: }
197: #endif vax
198: }
199:
200: int
201: ovcnt_()
202: {
203: return total_overflows;
204: }
205:
206: #if vax
207: /*
208: * got_illegal_instruction - handle "illegal instruction" signals.
209: *
210: * This really deals only with reserved operand exceptions.
211: * Since there is no way to check this directly, we look at the
212: * opcode of the instruction we are executing to see if it is a
213: * floating-point operation (with floating-point operands, not
214: * just results).
215: *
216: * This is complicated by the fact that the registers that will
217: * eventually be restored are saved in two places. registers 7-11
218: * are saved by this routine, and are in its call frame. (we have
219: * to take special care that these registers are specified in
220: * the procedure entry mask here.)
221: * Registers 0-6 are saved at interrupt time, and are at a offset
222: * -8 from the 'signo' parameter below.
223: * There is ane extremely inimate connection between the value of
224: * the entry mask set by the 'makefile' script, and the constants
225: * used in the register offset calculations below.
226: * Can someone think of a better way to do this?
227: */
228:
229: /*ARGSUSED*/
230: got_illegal_instruction(signo, codeword, myaddr, trap_pc, ps)
231: char *myaddr, *trap_pc;
232: {
233: int first_local[1]; /* must be first */
234: int i, opcode, type, o_no, no_reserved;
235: anyval *opnd;
236:
237: regs7t11 = &first_local[0];
238: regs0t6 = &signo - 8;
239: pc = trap_pc;
240:
241: opcode = fetch_byte() & 0xff;
242: no_reserved = 0;
243: if (codeword != RES_OPR_F || !is_floating_operation(opcode)) {
244: if (sigill_default > (SIG_VAL)7)
245: return((*sigill_default)(signo, codeword, myaddr, trap_pc, ps));
246: else
247: sigdie(signo, codeword, myaddr, trap_pc, ps);
248: /* NOTREACHED */
249: }
250:
251: if (opcode == POLYD || opcode == POLYF) {
252: got_illegal_poly(opcode);
253: return;
254: }
255:
256: if (opcode == EMODD || opcode == EMODF) {
257: got_illegal_emod(opcode);
258: return;
259: }
260:
261: /*
262: * This opcode wasn't "unusual".
263: * Look at the operands to try and find a reserved operand.
264: */
265: for (o_no = 1; o_no <= no_operands(opcode); ++o_no) {
266: type = operand_type(opcode, o_no);
267: if (type != F && type != D) {
268: advance_pc(type);
269: continue;
270: }
271:
272: /* F or D operand. Check it out */
273: opnd = get_operand_address(type);
274: if (opnd == NULL) {
275: fprintf(units[STDERR].ufd, "Can't get operand address: 0x%x, %d\n",
276: pc, o_no);
277: force_abort();
278: }
279: if (type == F && opnd->o_long == 0x00008000) {
280: /* found one */
281: opnd->o_long = retrn.v_long[0];
282: ++no_reserved;
283: } else if (type == D && opnd->o_long == 0x00008000) {
284: /* found one here, too! */
285: opnd->o_quad[0] = retrn.v_long[0];
286: /* Fix next pointer */
287: if (opnd == addr_of_reg(6)) opnd = addr_of_reg(7);
288: else opnd = (anyval *) ((char *) opnd + 4);
289: opnd->o_quad[0] = retrn.v_long[1];
290: ++no_reserved;
291: }
292:
293: }
294:
295: if (no_reserved == 0) {
296: fprintf(units[STDERR].ufd, "Can't find any reserved operand!\n");
297: force_abort();
298: }
299: }
300: /*
301: * is_floating_exception - was the operation code for a floating instruction?
302: */
303:
304: is_floating_operation(opcode)
305: int opcode;
306: {
307: switch (opcode) {
308: case ACBD: case ACBF: case ADDD2: case ADDD3:
309: case ADDF2: case ADDF3: case CMPD: case CMPF:
310: case CVTDB: case CVTDF: case CVTDL: case CVTDW:
311: case CVTFB: case CVTFD: case CVTFL: case CVTFW:
312: case CVTRDL: case CVTRFL: case DIVD2: case DIVD3:
313: case DIVF2: case DIVF3: case EMODD: case EMODF:
314: case MNEGD: case MNEGF: case MOVD: case MOVF:
315: case MULD2: case MULD3: case MULF2: case MULF3:
316: case POLYD: case POLYF: case SUBD2: case SUBD3:
317: case SUBF2: case SUBF3: case TSTD: case TSTF:
318: return 1;
319:
320: default:
321: return 0;
322: }
323: }
324: /*
325: * got_illegal_poly - handle an illegal POLY[DF] instruction.
326: *
327: * We don't do anything here yet.
328: */
329:
330: /*ARGSUSED*/
331: got_illegal_poly(opcode)
332: {
333: fprintf(units[STDERR].ufd, "Can't do 'poly' instructions yet\n");
334: force_abort();
335: }
336:
337:
338:
339: /*
340: * got_illegal_emod - handle illegal EMOD[DF] instruction.
341: *
342: * We don't do anything here yet.
343: */
344:
345: /*ARGSUSED*/
346: got_illegal_emod(opcode)
347: {
348: fprintf(units[STDERR].ufd, "Can't do 'emod' instructions yet\n");
349: force_abort();
350: }
351:
352:
353: /*
354: * no_operands - determine the number of operands in this instruction.
355: *
356: */
357:
358: no_operands(opcode)
359: {
360: switch (opcode) {
361: case ACBD:
362: case ACBF:
363: return 3;
364:
365: case MNEGD:
366: case MNEGF:
367: case MOVD:
368: case MOVF:
369: case TSTD:
370: case TSTF:
371: return 1;
372:
373: default:
374: return 2;
375: }
376: }
377:
378:
379:
380: /*
381: * operand_type - is the operand a D or an F?
382: *
383: * We are only descriminating between Floats and Doubles here.
384: * Other operands may be possible on exotic instructions.
385: */
386:
387: /*ARGSUSED*/
388: operand_type(opcode, no)
389: {
390: if (opcode >= 0x40 && opcode <= 0x56) return F;
391: if (opcode >= 0x60 && opcode <= 0x76) return D;
392: return IDUNNO;
393: }
394:
395:
396:
397: /*
398: * advance_pc - Advance the program counter past an operand.
399: *
400: * We just bump the pc by the appropriate values.
401: */
402:
403: advance_pc(type)
404: {
405: register int mode, reg;
406:
407: mode = fetch_byte();
408: reg = mode & 0xf;
409: mode = (mode >> 4) & 0xf;
410: switch (mode) {
411: case LITERAL0:
412: case LITERAL1:
413: case LITERAL2:
414: case LITERAL3:
415: return;
416:
417: case INDEXED:
418: advance_pc(type);
419: return;
420:
421: case REGISTER:
422: case REG_DEF:
423: case AUTO_DEC:
424: return;
425:
426: case AUTO_INC:
427: if (reg == PC) {
428: if (type == F) (void) fetch_long();
429: else if (type == D) {
430: (void) fetch_long();
431: (void) fetch_long();
432: } else {
433: fprintf(units[STDERR].ufd, "Bad type %d in advance\n",
434: type);
435: force_abort();
436: }
437: }
438: return;
439:
440: case AUTO_INC_DEF:
441: if (reg == PC) (void) fetch_long();
442: return;
443:
444: case BYTE_DISP:
445: case BYTE_DISP_DEF:
446: (void) fetch_byte();
447: return;
448:
449: case WORD_DISP:
450: case WORD_DISP_DEF:
451: (void) fetch_word();
452: return;
453:
454: case LONG_DISP:
455: case LONG_DISP_DEF:
456: (void) fetch_long();
457: return;
458:
459: default:
460: fprintf(units[STDERR].ufd, "Bad mode 0x%x in op_length()\n", mode);
461: force_abort();
462: }
463: }
464:
465:
466: anyval *
467: get_operand_address(type)
468: {
469: register int mode, reg, base;
470:
471: mode = fetch_byte() & 0xff;
472: reg = mode & 0xf;
473: mode = (mode >> 4) & 0xf;
474: switch (mode) {
475: case LITERAL0:
476: case LITERAL1:
477: case LITERAL2:
478: case LITERAL3:
479: return NULL;
480:
481: case INDEXED:
482: base = (int) get_operand_address(type);
483: if (base == NULL) return NULL;
484: base += contents_of_reg(reg)*type_length(type);
485: return (anyval *) base;
486:
487: case REGISTER:
488: return addr_of_reg(reg);
489:
490: case REG_DEF:
491: return (anyval *) contents_of_reg(reg);
492:
493: case AUTO_DEC:
494: return (anyval *) (contents_of_reg(reg)
495: - type_length(type));
496:
497: case AUTO_INC:
498: return (anyval *) contents_of_reg(reg);
499:
500: case AUTO_INC_DEF:
501: return (anyval *) * (long *) contents_of_reg(reg);
502:
503: case BYTE_DISP:
504: base = fetch_byte();
505: base += contents_of_reg(reg);
506: return (anyval *) base;
507:
508: case BYTE_DISP_DEF:
509: base = fetch_byte();
510: base += contents_of_reg(reg);
511: return (anyval *) * (long *) base;
512:
513: case WORD_DISP:
514: base = fetch_word();
515: base += contents_of_reg(reg);
516: return (anyval *) base;
517:
518: case WORD_DISP_DEF:
519: base = fetch_word();
520: base += contents_of_reg(reg);
521: return (anyval *) * (long *) base;
522:
523: case LONG_DISP:
524: base = fetch_long();
525: base += contents_of_reg(reg);
526: return (anyval *) base;
527:
528: case LONG_DISP_DEF:
529: base = fetch_long();
530: base += contents_of_reg(reg);
531: return (anyval *) * (long *) base;
532:
533: default:
534: fprintf(units[STDERR].ufd, "Bad mode 0x%x in get_addr()\n", mode);
535: force_abort();
536: }
537: return NULL;
538: }
539:
540:
541:
542: contents_of_reg(reg)
543: {
544: int value;
545:
546: if (reg == PC) value = (int) pc;
547: else if (reg == SP) value = (int) ®s0t6[6];
548: else if (reg == FP) value = regs0t6[-2];
549: else if (reg == AP) value = regs0t6[-3];
550: else if (reg >= 0 && reg <= 6) value = regs0t6[reg];
551: else if (reg >= 7 && reg <= 11) value = regs7t11[reg];
552: else {
553: fprintf(units[STDERR].ufd, "Bad register 0x%x to contents_of()\n", reg);
554: force_abort();
555: value = -1;
556: }
557: return value;
558: }
559:
560:
561: anyval *
562: addr_of_reg(reg)
563: {
564: if (reg >= 0 && reg <= 6) {
565: return (anyval *) ®s0t6[reg];
566: }
567: if (reg >= 7 && reg <= 11) {
568: return (anyval *) ®s7t11[reg];
569: }
570: fprintf(units[STDERR].ufd, "Bad reg 0x%x to addr_of()\n", reg);
571: force_abort();
572: return NULL;
573: }
574: /*
575: * fetch_{byte, word, long} - extract values from the PROGRAM area.
576: *
577: * These routines are used in the operand decoding to extract various
578: * fields from where the program counter points. This is because the
579: * addressing on the Vax is dynamic: the program counter advances
580: * while we are grabbing operands, as well as when we pass instructions.
581: * This makes things a bit messy, but I can't help it.
582: */
583: fetch_byte()
584: {
585: return *pc++;
586: }
587:
588:
589:
590: fetch_word()
591: {
592: int *old_pc;
593:
594: old_pc = (int *) pc;
595: pc += 2;
596: return *old_pc;
597: }
598:
599:
600:
601: fetch_long()
602: {
603: long *old_pc;
604:
605: old_pc = (long *) pc;
606: pc += 4;
607: return *old_pc;
608: }
609: /*
610: * force_abort - force us to abort.
611: *
612: * We have to change the signal handler for illegal instructions back,
613: * or we'll end up calling 'got_illegal_instruction()' again when
614: * abort() does it's dirty work.
615: */
616: force_abort()
617: {
618: signal(SIGILL, SIG_DFL);
619: abort();
620: }
621:
622:
623: type_length(type)
624: {
625: if (type == F) return 4;
626: if (type == D) return 8;
627: fprintf(units[STDERR].ufd, "Bad type 0x%x in type_length()\n", type);
628: force_abort();
629: return -1;
630: }
631:
632:
633:
634: char *opcode_name(opcode)
635: {
636: switch (opcode) {
637: case ACBD: return "ACBD";
638: case ACBF: return "ACBF";
639: case ADDD2: return "ADDD2";
640: case ADDD3: return "ADDD3";
641: case ADDF2: return "ADDF2";
642: case ADDF3: return "ADDF3";
643: case CMPD: return "CMPD";
644: case CMPF: return "CMPF";
645: case CVTDB: return "CVTDB";
646: case CVTDF: return "CVTDF";
647: case CVTDL: return "CVTDL";
648: case CVTDW: return "CVTDW";
649: case CVTFB: return "CVTFB";
650: case CVTFD: return "CVTFD";
651: case CVTFL: return "CVTFL";
652: case CVTFW: return "CVTFW";
653: case CVTRDL: return "CVTRDL";
654: case CVTRFL: return "CVTRFL";
655: case DIVD2: return "DIVD2";
656: case DIVD3: return "DIVD3";
657: case DIVF2: return "DIVF2";
658: case DIVF3: return "DIVF3";
659: case EMODD: return "EMODD";
660: case EMODF: return "EMODF";
661: case MNEGD: return "MNEGD";
662: case MNEGF: return "MNEGF";
663: case MOVD: return "MOVD";
664: case MOVF: return "MOVF";
665: case MULD2: return "MULD2";
666: case MULD3: return "MULD3";
667: case MULF2: return "MULF2";
668: case MULF3: return "MULF3";
669: case POLYD: return "POLYD";
670: case POLYF: return "POLYF";
671: case SUBD2: return "SUBD2";
672: case SUBD3: return "SUBD3";
673: case SUBF2: return "SUBF2";
674: case SUBF3: return "SUBF3";
675: case TSTD: return "TSTD";
676: case TSTF: return "TSTF";
677: }
678: }
679: #endif vax
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.