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