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