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/03/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 760