![[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] / 43BSDReno / lib / libF77|
Return to trapov_.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / 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.5 2/14/90
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 <sys/signal.h>
30: # include "opcodes.h"
31: # include "../libI77/fiodefs.h"
32: # define SIG_VAL void (*)()
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 sig_t sigill_default = (SIG_VAL)-1;
129: static sig_t 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: void 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: void
163: got_overflow(signo, codeword, myaddr, pc, ps)
164: char *myaddr, *pc;
165: {
166: int *sp, i;
167: FILE *ef;
168:
169: signal(SIGFPE, got_overflow);
170: ef = units[STDERR].ufd;
171: switch (codeword) {
172: case INT_OVF_T:
173: case INT_DIV_T:
174: case FLT_UND_T:
175: case DEC_OVF_T:
176: case SUB_RNG_T:
177: case FLT_OVF_F:
178: case FLT_DIV_F:
179: case FLT_UND_F:
180: if (sigfpe_default > (SIG_VAL)7)
181: (*sigfpe_default)(signo, codeword, myaddr,
182: pc, ps);
183: else
184: sigdie(signo, codeword, myaddr, pc, ps);
185: /* NOTREACHED */
186:
187: case FLT_OVF_T:
188: case FLT_DIV_T:
189: if (++total_overflows <= max_messages) {
190: fprintf(ef, "trapov: %s",
191: act_fpe[codeword-1].mesg);
192: if (total_overflows == max_messages)
193: fprintf(ef, ": No more messages will be printed.\n");
194: else
195: fputc('\n', ef);
196: }
197: return;
198: }
199: }
200:
201: int
202: ovcnt_()
203: {
204: return total_overflows;
205: }
206:
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: void
231: got_illegal_instruction(signo, codeword, myaddr, trap_pc, ps)
232: char *myaddr, *trap_pc;
233: {
234: int first_local[1]; /* must be first */
235: int i, opcode, type, o_no, no_reserved;
236: anyval *opnd;
237:
238: regs7t11 = &first_local[0];
239: regs0t6 = &signo - 8;
240: pc = trap_pc;
241:
242: opcode = fetch_byte() & 0xff;
243: no_reserved = 0;
244: if (codeword != RES_OPR_F || !is_floating_operation(opcode)) {
245: if (sigill_default > (SIG_VAL)7) {
246: (*sigill_default)(signo, codeword, myaddr, trap_pc, ps);
247: return;
248: } else
249: sigdie(signo, codeword, myaddr, trap_pc, ps);
250: /* NOTREACHED */
251: }
252:
253: if (opcode == POLYD || opcode == POLYF) {
254: got_illegal_poly(opcode);
255: return;
256: }
257:
258: if (opcode == EMODD || opcode == EMODF) {
259: got_illegal_emod(opcode);
260: return;
261: }
262:
263: /*
264: * This opcode wasn't "unusual".
265: * Look at the operands to try and find a reserved operand.
266: */
267: for (o_no = 1; o_no <= no_operands(opcode); ++o_no) {
268: type = operand_type(opcode, o_no);
269: if (type != F && type != D) {
270: advance_pc(type);
271: continue;
272: }
273:
274: /* F or D operand. Check it out */
275: opnd = get_operand_address(type);
276: if (opnd == NULL) {
277: fprintf(units[STDERR].ufd, "Can't get operand address: 0x%x, %d\n",
278: pc, o_no);
279: f77_abort();
280: }
281: if (type == F && opnd->o_long == 0x00008000) {
282: /* found one */
283: opnd->o_long = retrn.v_long[0];
284: ++no_reserved;
285: } else if (type == D && opnd->o_long == 0x00008000) {
286: /* found one here, too! */
287: opnd->o_quad[0] = retrn.v_long[0];
288: /* Fix next pointer */
289: if (opnd == addr_of_reg(6)) opnd = addr_of_reg(7);
290: else opnd = (anyval *) ((char *) opnd + 4);
291: opnd->o_quad[0] = retrn.v_long[1];
292: ++no_reserved;
293: }
294:
295: }
296:
297: if (no_reserved == 0) {
298: fprintf(units[STDERR].ufd, "Can't find any reserved operand!\n");
299: f77_abort();
300: }
301: }
302: /*
303: * is_floating_exception - was the operation code for a floating instruction?
304: */
305:
306: is_floating_operation(opcode)
307: int opcode;
308: {
309: switch (opcode) {
310: case ACBD: case ACBF: case ADDD2: case ADDD3:
311: case ADDF2: case ADDF3: case CMPD: case CMPF:
312: case CVTDB: case CVTDF: case CVTDL: case CVTDW:
313: case CVTFB: case CVTFD: case CVTFL: case CVTFW:
314: case CVTRDL: case CVTRFL: case DIVD2: case DIVD3:
315: case DIVF2: case DIVF3: case EMODD: case EMODF:
316: case MNEGD: case MNEGF: case MOVD: case MOVF:
317: case MULD2: case MULD3: case MULF2: case MULF3:
318: case POLYD: case POLYF: case SUBD2: case SUBD3:
319: case SUBF2: case SUBF3: case TSTD: case TSTF:
320: return 1;
321:
322: default:
323: return 0;
324: }
325: }
326: /*
327: * got_illegal_poly - handle an illegal POLY[DF] instruction.
328: *
329: * We don't do anything here yet.
330: */
331:
332: /*ARGSUSED*/
333: got_illegal_poly(opcode)
334: {
335: fprintf(units[STDERR].ufd, "Can't do 'poly' instructions yet\n");
336: f77_abort();
337: }
338:
339:
340:
341: /*
342: * got_illegal_emod - handle illegal EMOD[DF] instruction.
343: *
344: * We don't do anything here yet.
345: */
346:
347: /*ARGSUSED*/
348: got_illegal_emod(opcode)
349: {
350: fprintf(units[STDERR].ufd, "Can't do 'emod' instructions yet\n");
351: f77_abort();
352: }
353:
354:
355: /*
356: * no_operands - determine the number of operands in this instruction.
357: *
358: */
359:
360: no_operands(opcode)
361: {
362: switch (opcode) {
363: case ACBD:
364: case ACBF:
365: return 3;
366:
367: case MNEGD:
368: case MNEGF:
369: case MOVD:
370: case MOVF:
371: case TSTD:
372: case TSTF:
373: return 1;
374:
375: default:
376: return 2;
377: }
378: }
379:
380:
381:
382: /*
383: * operand_type - is the operand a D or an F?
384: *
385: * We are only descriminating between Floats and Doubles here.
386: * Other operands may be possible on exotic instructions.
387: */
388:
389: /*ARGSUSED*/
390: operand_type(opcode, no)
391: {
392: if (opcode >= 0x40 && opcode <= 0x56) return F;
393: if (opcode >= 0x60 && opcode <= 0x76) return D;
394: return IDUNNO;
395: }
396:
397:
398:
399: /*
400: * advance_pc - Advance the program counter past an operand.
401: *
402: * We just bump the pc by the appropriate values.
403: */
404:
405: advance_pc(type)
406: {
407: register int mode, reg;
408:
409: mode = fetch_byte();
410: reg = mode & 0xf;
411: mode = (mode >> 4) & 0xf;
412: switch (mode) {
413: case LITERAL0:
414: case LITERAL1:
415: case LITERAL2:
416: case LITERAL3:
417: return;
418:
419: case INDEXED:
420: advance_pc(type);
421: return;
422:
423: case REGISTER:
424: case REG_DEF:
425: case AUTO_DEC:
426: return;
427:
428: case AUTO_INC:
429: if (reg == PC) {
430: if (type == F) (void) fetch_long();
431: else if (type == D) {
432: (void) fetch_long();
433: (void) fetch_long();
434: } else {
435: fprintf(units[STDERR].ufd, "Bad type %d in advance\n",
436: type);
437: f77_abort();
438: }
439: }
440: return;
441:
442: case AUTO_INC_DEF:
443: if (reg == PC) (void) fetch_long();
444: return;
445:
446: case BYTE_DISP:
447: case BYTE_DISP_DEF:
448: (void) fetch_byte();
449: return;
450:
451: case WORD_DISP:
452: case WORD_DISP_DEF:
453: (void) fetch_word();
454: return;
455:
456: case LONG_DISP:
457: case LONG_DISP_DEF:
458: (void) fetch_long();
459: return;
460:
461: default:
462: fprintf(units[STDERR].ufd, "Bad mode 0x%x in op_length()\n", mode);
463: f77_abort();
464: }
465: }
466:
467:
468: anyval *
469: get_operand_address(type)
470: {
471: register int mode, reg, base;
472:
473: mode = fetch_byte() & 0xff;
474: reg = mode & 0xf;
475: mode = (mode >> 4) & 0xf;
476: switch (mode) {
477: case LITERAL0:
478: case LITERAL1:
479: case LITERAL2:
480: case LITERAL3:
481: return NULL;
482:
483: case INDEXED:
484: base = (int) get_operand_address(type);
485: if (base == NULL) return NULL;
486: base += contents_of_reg(reg)*type_length(type);
487: return (anyval *) base;
488:
489: case REGISTER:
490: return addr_of_reg(reg);
491:
492: case REG_DEF:
493: return (anyval *) contents_of_reg(reg);
494:
495: case AUTO_DEC:
496: return (anyval *) (contents_of_reg(reg)
497: - type_length(type));
498:
499: case AUTO_INC:
500: return (anyval *) contents_of_reg(reg);
501:
502: case AUTO_INC_DEF:
503: return (anyval *) * (long *) contents_of_reg(reg);
504:
505: case BYTE_DISP:
506: base = fetch_byte();
507: base += contents_of_reg(reg);
508: return (anyval *) base;
509:
510: case BYTE_DISP_DEF:
511: base = fetch_byte();
512: base += contents_of_reg(reg);
513: return (anyval *) * (long *) base;
514:
515: case WORD_DISP:
516: base = fetch_word();
517: base += contents_of_reg(reg);
518: return (anyval *) base;
519:
520: case WORD_DISP_DEF:
521: base = fetch_word();
522: base += contents_of_reg(reg);
523: return (anyval *) * (long *) base;
524:
525: case LONG_DISP:
526: base = fetch_long();
527: base += contents_of_reg(reg);
528: return (anyval *) base;
529:
530: case LONG_DISP_DEF:
531: base = fetch_long();
532: base += contents_of_reg(reg);
533: return (anyval *) * (long *) base;
534:
535: default:
536: fprintf(units[STDERR].ufd, "Bad mode 0x%x in get_addr()\n", mode);
537: f77_abort();
538: }
539: return NULL;
540: }
541:
542:
543:
544: contents_of_reg(reg)
545: {
546: int value;
547:
548: if (reg == PC) value = (int) pc;
549: else if (reg == SP) value = (int) ®s0t6[6];
550: else if (reg == FP) value = regs0t6[-2];
551: else if (reg == AP) value = regs0t6[-3];
552: else if (reg >= 0 && reg <= 6) value = regs0t6[reg];
553: else if (reg >= 7 && reg <= 11) value = regs7t11[reg];
554: else {
555: fprintf(units[STDERR].ufd, "Bad register 0x%x to contents_of()\n", reg);
556: f77_abort();
557: value = -1;
558: }
559: return value;
560: }
561:
562:
563: anyval *
564: addr_of_reg(reg)
565: {
566: if (reg >= 0 && reg <= 6) {
567: return (anyval *) ®s0t6[reg];
568: }
569: if (reg >= 7 && reg <= 11) {
570: return (anyval *) ®s7t11[reg];
571: }
572: fprintf(units[STDERR].ufd, "Bad reg 0x%x to addr_of()\n", reg);
573: f77_abort();
574: return NULL;
575: }
576: /*
577: * fetch_{byte, word, long} - extract values from the PROGRAM area.
578: *
579: * These routines are used in the operand decoding to extract various
580: * fields from where the program counter points. This is because the
581: * addressing on the Vax is dynamic: the program counter advances
582: * while we are grabbing operands, as well as when we pass instructions.
583: * This makes things a bit messy, but I can't help it.
584: */
585: fetch_byte()
586: {
587: return *pc++;
588: }
589:
590:
591:
592: fetch_word()
593: {
594: int *old_pc;
595:
596: old_pc = (int *) pc;
597: pc += 2;
598: return *old_pc;
599: }
600:
601:
602:
603: fetch_long()
604: {
605: long *old_pc;
606:
607: old_pc = (long *) pc;
608: pc += 4;
609: return *old_pc;
610: }
611:
612:
613: type_length(type)
614: {
615: if (type == F) return 4;
616: if (type == D) return 8;
617: fprintf(units[STDERR].ufd, "Bad type 0x%x in type_length()\n", type);
618: f77_abort();
619: return -1;
620: }
621:
622:
623:
624: char *opcode_name(opcode)
625: {
626: switch (opcode) {
627: case ACBD: return "ACBD";
628: case ACBF: return "ACBF";
629: case ADDD2: return "ADDD2";
630: case ADDD3: return "ADDD3";
631: case ADDF2: return "ADDF2";
632: case ADDF3: return "ADDF3";
633: case CMPD: return "CMPD";
634: case CMPF: return "CMPF";
635: case CVTDB: return "CVTDB";
636: case CVTDF: return "CVTDF";
637: case CVTDL: return "CVTDL";
638: case CVTDW: return "CVTDW";
639: case CVTFB: return "CVTFB";
640: case CVTFD: return "CVTFD";
641: case CVTFL: return "CVTFL";
642: case CVTFW: return "CVTFW";
643: case CVTRDL: return "CVTRDL";
644: case CVTRFL: return "CVTRFL";
645: case DIVD2: return "DIVD2";
646: case DIVD3: return "DIVD3";
647: case DIVF2: return "DIVF2";
648: case DIVF3: return "DIVF3";
649: case EMODD: return "EMODD";
650: case EMODF: return "EMODF";
651: case MNEGD: return "MNEGD";
652: case MNEGF: return "MNEGF";
653: case MOVD: return "MOVD";
654: case MOVF: return "MOVF";
655: case MULD2: return "MULD2";
656: case MULD3: return "MULD3";
657: case MULF2: return "MULF2";
658: case MULF3: return "MULF3";
659: case POLYD: return "POLYD";
660: case POLYF: return "POLYF";
661: case SUBD2: return "SUBD2";
662: case SUBD3: return "SUBD3";
663: case SUBF2: return "SUBF2";
664: case SUBF3: return "SUBF3";
665: case TSTD: return "TSTD";
666: case TSTF: return "TSTF";
667: }
668: }
669: #endif vax
670:
671: #ifdef tahoe
672: /*
673: * NO RESERVED OPERAND EXCEPTION ON RESULT OF FP OVERFLOW ON TAHOE.
674: * JUST PRINT THE OVERFLOW MESSAGE. RESULT IS 0 (zero).
675: */
676:
677: /*
678: * GLOBAL VARIABLES (we need a few)
679: *
680: * Actual program counter and locations of registers.
681: */
682: static char *pc;
683: static int *regs0t1;
684: static int *regs2t12;
685: static int max_messages;
686: static int total_overflows;
687: static union {
688: long v_long[2];
689: double v_double;
690: } retrn;
691: static sig_t sigill_default = (SIG_VAL)-1;
692: static sig_t sigfpe_default;
693:
694:
695: /*
696: * This routine sets up the signal handler for the floating-point
697: * and reserved operand interrupts.
698: */
699:
700: trapov_(count, rtnval)
701: int *count;
702: double *rtnval;
703: {
704: void got_overflow();
705:
706: sigfpe_default = signal(SIGFPE, got_overflow);
707: total_overflows = 0;
708: max_messages = *count;
709: retrn.v_double = *rtnval;
710: }
711:
712:
713:
714: /*
715: * got_overflow - routine called when overflow occurs
716: *
717: * This routine just prints a message about the overflow.
718: * It is impossible to find the bad result at this point.
719: * NEXT 2 LINES DON'T HOLD FOR TAHOE !
720: * Instead, we wait until we get the reserved operand exception
721: * when we try to use it. This raises the SIGILL signal.
722: */
723:
724: /*ARGSUSED*/
725: void
726: got_overflow(signo, codeword, sc)
727: int signo, codeword;
728: struct sigcontext *sc;
729: {
730: int *sp, i;
731: FILE *ef;
732:
733: signal(SIGFPE, got_overflow);
734: ef = units[STDERR].ufd;
735: switch (codeword) {
736: case INT_OVF_T:
737: case INT_DIV_T:
738: case FLT_UND_T:
739: case FLT_DIV_T:
740: if (sigfpe_default > (SIG_VAL)7)
741: (*sigfpe_default)(signo, codeword, sc);
742: else
743: sigdie(signo, codeword, sc);
744: /* NOTREACHED */
745:
746: case FLT_OVF_T:
747: if (++total_overflows <= max_messages) {
748: fprintf(ef, "trapov: %s",
749: act_fpe[codeword-1].mesg);
750: fprintf(ef, ": Current PC = %X", sc->sc_pc);
751: if (total_overflows == max_messages)
752: fprintf(ef, ": No more messages will be printed.\n");
753: else
754: fputc('\n', ef);
755: }
756: return;
757: }
758: }
759: int
760: ovcnt_()
761: {
762: return total_overflows;
763: }
764: #endif tahoe
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.