|
|
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.