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