![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to trpfpe_.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 trpfpe_.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / lib / libF77 |
1.1 ! root 1: /* #define OLD_BSD if you're running < 4.2 bsd */ ! 2: /* ! 3: * Copyright (c) 1980 Regents of the University of California. ! 4: * All rights reserved. The Berkeley software License Agreement ! 5: * specifies the terms and conditions for redistribution. ! 6: * ! 7: * @(#)trpfpe_.c 5.6 2/14/90 ! 8: * ! 9: * ! 10: * Fortran floating-point error handler ! 11: * ! 12: * Synopsis: ! 13: * call trpfpe (n, retval) ! 14: * causes floating point faults to be trapped, with the ! 15: * first 'n' errors getting a message printed. ! 16: * 'retval' is put in place of the bad result. ! 17: * k = fpecnt() ! 18: * causes 'k' to get the number of errors since the ! 19: * last call to trpfpe(). ! 20: * ! 21: * common /fpeflt/ fpflag ! 22: * logical fpflag ! 23: * fpflag will become .true. on faults ! 24: * ! 25: * David Wasley, UCBerkeley, June 1983. ! 26: */ ! 27: ! 28: ! 29: #include <stdio.h> ! 30: #include <sys/signal.h> ! 31: #include "../libI77/fiodefs.h" ! 32: ! 33: #define SIG_VAL void (*)() ! 34: ! 35: #ifdef vax ! 36: #include "opcodes.h" ! 37: #include "operand.h" ! 38: ! 39: struct arglist { /* what AP points to */ ! 40: long al_numarg; /* only true in CALLS format */ ! 41: long al_arg[256]; ! 42: }; ! 43: ! 44: struct cframe { /* VAX call frame */ ! 45: long cf_handler; ! 46: unsigned short cf_psw; ! 47: unsigned short cf_mask; ! 48: struct arglist *cf_ap; ! 49: struct cframe *cf_fp; ! 50: char *cf_pc; ! 51: }; ! 52: ! 53: /* ! 54: * bits in the PSW ! 55: */ ! 56: #define PSW_V 0x2 ! 57: #define PSW_FU 0x40 ! 58: #define PSW_IV 0x20 ! 59: ! 60: /* ! 61: * where the registers are stored as we see them in the handler ! 62: */ ! 63: struct reg0_6 { ! 64: long reg[7]; ! 65: }; ! 66: ! 67: struct reg7_11 { ! 68: long reg[5]; ! 69: }; ! 70: ! 71: #define iR0 reg0_6->reg[0] ! 72: #define iR1 reg0_6->reg[1] ! 73: #define iR2 reg0_6->reg[2] ! 74: #define iR3 reg0_6->reg[3] ! 75: #define iR4 reg0_6->reg[4] ! 76: #define iR5 reg0_6->reg[5] ! 77: #define iR6 reg0_6->reg[6] ! 78: #define iR7 reg7_11->reg[0] ! 79: #define iR8 reg7_11->reg[1] ! 80: #define iR9 reg7_11->reg[2] ! 81: #define iR10 reg7_11->reg[3] ! 82: #define iR11 reg7_11->reg[4] ! 83: ! 84: union objects { /* for load/store */ ! 85: char ua_byte; ! 86: short ua_word; ! 87: long ua_long; ! 88: float ua_float; ! 89: double ua_double; ! 90: union objects *ua_anything; ! 91: }; ! 92: ! 93: typedef union objects anything; ! 94: enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN }; ! 95: ! 96: ! 97: /* ! 98: * assembly language assist ! 99: * There are some things you just can't do in C ! 100: */ ! 101: asm(".text"); ! 102: ! 103: struct cframe *myfp(); ! 104: asm("_myfp: .word 0x0"); ! 105: asm("movl 12(fp),r0"); ! 106: asm("ret"); ! 107: ! 108: struct arglist *myap(); ! 109: asm("_myap: .word 0x0"); ! 110: asm("movl 8(fp),r0"); ! 111: asm("ret"); ! 112: ! 113: char *mysp(); ! 114: asm("_mysp: .word 0x0"); ! 115: asm("extzv $30,$2,4(fp),r0"); ! 116: asm("addl2 ap,r0"); /* SP in caller is AP+4 here + SPA bits! */ ! 117: asm("addl2 $4,r0"); ! 118: asm("ret"); ! 119: ! 120: char *mypc(); ! 121: asm("_mypc: .word 0x0"); ! 122: asm("movl 16(fp),r0"); ! 123: asm("ret"); ! 124: ! 125: asm(".data"); ! 126: ! 127: ! 128: /* ! 129: * Where interrupted objects are ! 130: */ ! 131: static struct cframe **ifp; /* addr of saved FP */ ! 132: static struct arglist **iap; /* addr of saved AP */ ! 133: static char *isp; /* value of interrupted SP */ ! 134: static char **ipc; /* addr of saved PC */ ! 135: static struct reg0_6 *reg0_6;/* registers 0-6 are saved on the exception */ ! 136: static struct reg7_11 *reg7_11;/* we save 7-11 by our entry mask */ ! 137: static anything *result_addr; /* where the dummy result goes */ ! 138: static enum object_type result_type; /* what kind of object it is */ ! 139: ! 140: /* ! 141: * some globals ! 142: */ ! 143: static union { ! 144: long rv_long[2]; ! 145: float rv_float; ! 146: double rv_double; ! 147: } retval; /* the user specified dummy result */ ! 148: static int max_messages = 1; /* the user can tell us */ ! 149: static int fpe_count = 0; /* how bad is it ? */ ! 150: long fpeflt_ = 0; /* fortran "common /fpeflt/ flag" */ ! 151: static sig_t sigfpe_dfl = SIG_DFL; /* if we can't fix it ... */ ! 152: ! 153: /* ! 154: * The fortran unit control table ! 155: */ ! 156: extern unit units[]; ! 157: ! 158: /* ! 159: * Fortran message table is in main ! 160: */ ! 161: struct msgtbl { ! 162: char *mesg; ! 163: int dummy; ! 164: }; ! 165: extern struct msgtbl act_fpe[]; ! 166: ! 167: ! 168: /* ! 169: * Get the address of the (saved) next operand & update saved PC. ! 170: * The major purpose of this is to determine where to store the result. ! 171: * There is one case we can't deal with: -(SP) or (SP)+ ! 172: * since we can't change the size of the stack. ! 173: * Let's just hope compilers don't generate that for results. ! 174: */ ! 175: ! 176: anything * ! 177: get_operand (oper_size) ! 178: int oper_size; /* size of operand we expect */ ! 179: { ! 180: register int regnum; ! 181: register int operand_code; ! 182: int index; ! 183: anything *oper_addr; ! 184: anything *reg_addr; ! 185: ! 186: regnum = (**ipc & 0xf); ! 187: if (regnum == PC) ! 188: operand_code = (*(*ipc)++ & 0xff); ! 189: else ! 190: operand_code = (*(*ipc)++ & 0xf0); ! 191: if (regnum <= R6) ! 192: reg_addr = (anything *)®0_6->reg[regnum]; ! 193: else if (regnum <= R11) ! 194: reg_addr = (anything *)®7_11->reg[regnum]; ! 195: else if (regnum == AP) ! 196: reg_addr = (anything *)iap; ! 197: else if (regnum == FP) ! 198: reg_addr = (anything *)ifp; ! 199: else if (regnum == SP) ! 200: reg_addr = (anything *)&isp; /* We saved this ourselves */ ! 201: else if (regnum == PC) ! 202: reg_addr = (anything *)ipc; ! 203: ! 204: ! 205: switch (operand_code) ! 206: { ! 207: case IMMEDIATE: ! 208: oper_addr = (anything *)(*ipc); ! 209: *ipc += oper_size; ! 210: return(oper_addr); ! 211: ! 212: case ABSOLUTE: ! 213: oper_addr = (anything *)(**ipc); ! 214: *ipc += sizeof (anything *); ! 215: return(oper_addr); ! 216: ! 217: case LITERAL0: ! 218: case LITERAL1: ! 219: case LITERAL2: ! 220: case LITERAL3: ! 221: /* we don't care about the address of these */ ! 222: return((anything *)0); ! 223: ! 224: case INDEXED: ! 225: index = reg_addr->ua_long * oper_size; ! 226: oper_addr = (anything *)(get_operand(sizeof (long))->ua_long + index); ! 227: return(oper_addr); ! 228: ! 229: case REGISTER: ! 230: return(reg_addr); ! 231: ! 232: case REGDEFERED: ! 233: return(reg_addr->ua_anything); ! 234: ! 235: case AUTODEC: ! 236: if (regnum == SP) ! 237: { ! 238: fprintf(stderr, "trp: can't fix -(SP) operand\n"); ! 239: exit(1); ! 240: } ! 241: reg_addr->ua_long -= oper_size; ! 242: oper_addr = reg_addr->ua_anything; ! 243: return(oper_addr); ! 244: ! 245: case AUTOINC: ! 246: if (regnum == SP) ! 247: { ! 248: fprintf(stderr, "trp: can't fix (SP)+ operand\n"); ! 249: exit(1); ! 250: } ! 251: oper_addr = reg_addr->ua_anything; ! 252: reg_addr->ua_long += oper_size; ! 253: return(oper_addr); ! 254: ! 255: case AUTOINCDEF: ! 256: if (regnum == SP) ! 257: { ! 258: fprintf(stderr, "trp: can't fix @(SP)+ operand\n"); ! 259: exit(1); ! 260: } ! 261: oper_addr = (reg_addr->ua_anything)->ua_anything; ! 262: reg_addr->ua_long += sizeof (anything *); ! 263: return(oper_addr); ! 264: ! 265: case BYTEDISP: ! 266: case BYTEREL: ! 267: index = ((anything *)(*ipc))->ua_byte; ! 268: *ipc += sizeof (char); /* do it now in case reg==PC */ ! 269: oper_addr = (anything *)(index + reg_addr->ua_long); ! 270: return(oper_addr); ! 271: ! 272: case BYTEDISPDEF: ! 273: case BYTERELDEF: ! 274: index = ((anything *)(*ipc))->ua_byte; ! 275: *ipc += sizeof (char); /* do it now in case reg==PC */ ! 276: oper_addr = (anything *)(index + reg_addr->ua_long); ! 277: oper_addr = oper_addr->ua_anything; ! 278: return(oper_addr); ! 279: ! 280: case WORDDISP: ! 281: case WORDREL: ! 282: index = ((anything *)(*ipc))->ua_word; ! 283: *ipc += sizeof (short); /* do it now in case reg==PC */ ! 284: oper_addr = (anything *)(index + reg_addr->ua_long); ! 285: return(oper_addr); ! 286: ! 287: case WORDDISPDEF: ! 288: case WORDRELDEF: ! 289: index = ((anything *)(*ipc))->ua_word; ! 290: *ipc += sizeof (short); /* do it now in case reg==PC */ ! 291: oper_addr = (anything *)(index + reg_addr->ua_long); ! 292: oper_addr = oper_addr->ua_anything; ! 293: return(oper_addr); ! 294: ! 295: case LONGDISP: ! 296: case LONGREL: ! 297: index = ((anything *)(*ipc))->ua_long; ! 298: *ipc += sizeof (long); /* do it now in case reg==PC */ ! 299: oper_addr = (anything *)(index + reg_addr->ua_long); ! 300: return(oper_addr); ! 301: ! 302: case LONGDISPDEF: ! 303: case LONGRELDEF: ! 304: index = ((anything *)(*ipc))->ua_long; ! 305: *ipc += sizeof (long); /* do it now in case reg==PC */ ! 306: oper_addr = (anything *)(index + reg_addr->ua_long); ! 307: oper_addr = oper_addr->ua_anything; ! 308: return(oper_addr); ! 309: ! 310: /* NOTREACHED */ ! 311: } ! 312: } ! 313: ! 314: /* ! 315: * Trap & repair floating exceptions so that a program may proceed. ! 316: * There is no notion of "correctness" here; just the ability to continue. ! 317: * ! 318: * The on_fpe() routine first checks the type code to see if the ! 319: * exception is repairable. If so, it checks the opcode to see if ! 320: * it is one that it knows. If this is true, it then simulates the ! 321: * VAX cpu in retrieving operands in order to increment iPC correctly. ! 322: * It notes where the result of the operation would have been stored ! 323: * and substitutes a previously supplied value. ! 324: */ ! 325: ! 326: #ifdef OLD_BSD ! 327: on_fpe(signo, code, myaddr, pc, ps) ! 328: int signo, code, ps; ! 329: char *myaddr, *pc; ! 330: #else ! 331: void ! 332: on_fpe(signo, code, sc, grbg) ! 333: int signo, code; ! 334: struct sigcontext *sc; ! 335: #endif ! 336: { ! 337: /* ! 338: * There must be at least 5 register variables here ! 339: * so our entry mask will save R11-R7. ! 340: */ ! 341: register long *stk; ! 342: register long *sp; ! 343: register struct arglist *ap; ! 344: register struct cframe *fp; ! 345: register FILE *ef; ! 346: ! 347: ef = units[STDERR].ufd; /* fortran error stream */ ! 348: ! 349: switch (code) ! 350: { ! 351: case FPE_INTOVF_TRAP: /* integer overflow */ ! 352: case FPE_INTDIV_TRAP: /* integer divide by zero */ ! 353: case FPE_FLTOVF_TRAP: /* floating overflow */ ! 354: case FPE_FLTDIV_TRAP: /* floating/decimal divide by zero */ ! 355: case FPE_FLTUND_TRAP: /* floating underflow */ ! 356: case FPE_DECOVF_TRAP: /* decimal overflow */ ! 357: case FPE_SUBRNG_TRAP: /* subscript out of range */ ! 358: default: ! 359: cant_fix: ! 360: if (sigfpe_dfl > (SIG_VAL)7) /* user specified */ ! 361: #ifdef OLD_BSD ! 362: (*sigfpe_dfl)(signo, code, myaddr, pc, ps); ! 363: #else ! 364: (*sigfpe_dfl)(signo, code, sc, grbg); ! 365: #endif ! 366: else ! 367: #ifdef OLD_BSD ! 368: sigdie(signo, code, myaddr, pc, ps); ! 369: #else ! 370: sigdie(signo, code, sc, grbg); ! 371: #endif ! 372: /* NOTREACHED */ ! 373: ! 374: case FPE_FLTOVF_FAULT: /* floating overflow fault */ ! 375: case FPE_FLTDIV_FAULT: /* divide by zero floating fault */ ! 376: case FPE_FLTUND_FAULT: /* floating underflow fault */ ! 377: if (++fpe_count <= max_messages) { ! 378: fprintf(ef, "trpfpe: %s", ! 379: act_fpe[code-1].mesg); ! 380: if (fpe_count == max_messages) ! 381: fprintf(ef, ": No more messages will be printed.\n"); ! 382: else ! 383: fputc('\n', ef); ! 384: } ! 385: fpeflt_ = -1; ! 386: break; ! 387: } ! 388: ! 389: ap = myap(); /* my arglist pointer */ ! 390: fp = myfp(); /* my frame pointer */ ! 391: ifp = &(fp->cf_fp)->cf_fp; /* user's stored in next frame back */ ! 392: iap = &(fp->cf_fp)->cf_ap; ! 393: /* ! 394: * these are likely to be system dependent ! 395: */ ! 396: reg0_6 = (struct reg0_6 *)((char *)fp->cf_fp + sizeof (struct cframe)); ! 397: reg7_11 = (struct reg7_11 *)((char *)fp->cf_fp - sizeof (struct reg7_11)); ! 398: ! 399: #ifdef OLD_BSD ! 400: ipc = &pc; ! 401: isp = (char *)&ap->al_arg[ap->al_numarg + 2]; /* assumes 2 dummys */ ! 402: ps &= ~(PSW_V|PSW_FU); ! 403: #else ! 404: ipc = (char **)&sc->sc_pc; ! 405: isp = (char *)sc + sizeof (struct sigcontext); ! 406: sc->sc_ps &= ~(PSW_V|PSW_FU); ! 407: #endif ! 408: ! 409: ! 410: switch (*(*ipc)++) ! 411: { ! 412: case ADDD3: ! 413: case DIVD3: ! 414: case MULD3: ! 415: case SUBD3: ! 416: (void) get_operand(sizeof (double)); ! 417: /* intentional fall-thru */ ! 418: ! 419: case ADDD2: ! 420: case DIVD2: ! 421: case MULD2: ! 422: case SUBD2: ! 423: case MNEGD: ! 424: case MOVD: ! 425: (void) get_operand(sizeof (double)); ! 426: result_addr = get_operand(sizeof (double)); ! 427: result_type = DOUBLE; ! 428: break; ! 429: ! 430: case ADDF3: ! 431: case DIVF3: ! 432: case MULF3: ! 433: case SUBF3: ! 434: (void) get_operand(sizeof (float)); ! 435: /* intentional fall-thru */ ! 436: ! 437: case ADDF2: ! 438: case DIVF2: ! 439: case MULF2: ! 440: case SUBF2: ! 441: case MNEGF: ! 442: case MOVF: ! 443: (void) get_operand(sizeof (float)); ! 444: result_addr = get_operand(sizeof (float)); ! 445: result_type = FLOAT; ! 446: break; ! 447: ! 448: case CVTDF: ! 449: (void) get_operand(sizeof (double)); ! 450: result_addr = get_operand(sizeof (float)); ! 451: result_type = FLOAT; ! 452: break; ! 453: ! 454: case CVTFD: ! 455: (void) get_operand(sizeof (float)); ! 456: result_addr = get_operand(sizeof (double)); ! 457: result_type = DOUBLE; ! 458: break; ! 459: ! 460: case EMODF: ! 461: case EMODD: ! 462: fprintf(ef, "trpfpe: can't fix emod yet\n"); ! 463: goto cant_fix; ! 464: ! 465: case POLYF: ! 466: case POLYD: ! 467: fprintf(ef, "trpfpe: can't fix poly yet\n"); ! 468: goto cant_fix; ! 469: ! 470: case ACBD: ! 471: case ACBF: ! 472: case CMPD: ! 473: case CMPF: ! 474: case TSTD: ! 475: case TSTF: ! 476: case CVTDB: ! 477: case CVTDL: ! 478: case CVTDW: ! 479: case CVTFB: ! 480: case CVTFL: ! 481: case CVTFW: ! 482: case CVTRDL: ! 483: case CVTRFL: ! 484: /* These can generate only reserved operand faults */ ! 485: /* They are shown here for completeness */ ! 486: ! 487: default: ! 488: fprintf(stderr, "trp: opcode 0x%02x unknown\n", ! 489: *(--(*ipc)) & 0xff); ! 490: goto cant_fix; ! 491: /* NOTREACHED */ ! 492: } ! 493: ! 494: if (result_type == FLOAT) ! 495: result_addr->ua_float = retval.rv_float; ! 496: else ! 497: { ! 498: if (result_addr == (anything *)&iR6) ! 499: { /* ! 500: * special case - the R6/R7 pair is stored apart ! 501: */ ! 502: result_addr->ua_long = retval.rv_long[0]; ! 503: ((anything *)&iR7)->ua_long = retval.rv_long[1]; ! 504: } ! 505: else ! 506: result_addr->ua_double = retval.rv_double; ! 507: } ! 508: signal(SIGFPE, on_fpe); ! 509: } ! 510: ! 511: trpfpe_ (count, rval) ! 512: long *count; /* how many to announce */ ! 513: double *rval; /* dummy return value */ ! 514: { ! 515: max_messages = *count; ! 516: retval.rv_double = *rval; ! 517: sigfpe_dfl = signal(SIGFPE, on_fpe); ! 518: fpe_count = 0; ! 519: } ! 520: ! 521: long ! 522: fpecnt_ () ! 523: { ! 524: return (fpe_count); ! 525: } ! 526: #endif vax ! 527: ! 528: #ifdef tahoe ! 529: /* ! 530: * This handler just prints a message. It cannot fix anything ! 531: * on Power6 because of its fpp architecture. In any case, there ! 532: * are no arithmetic faults (only traps) around, so that no instruction ! 533: * is interrupted befor it completes, and PC points to the next floating ! 534: * point instruction (not necessarily next executable instr after the one ! 535: * that got the exception). ! 536: */ ! 537: ! 538: struct arglist { /* what AP points to */ ! 539: long al_arg[256]; ! 540: }; ! 541: ! 542: struct reg0_1 { ! 543: long reg[2]; ! 544: }; ! 545: struct reg2_12 { ! 546: long reg[11]; ! 547: }; ! 548: #include <sys/types.h> ! 549: #include <frame.h> ! 550: #include "sigframe.h" ! 551: ! 552: /* ! 553: * bits in the PSL ! 554: */ ! 555: #include <machine/psl.h> ! 556: ! 557: /* ! 558: * where the registers are stored as we see them in the handler ! 559: */ ! 560: ! 561: ! 562: #define iR0 reg0_1->reg[1] ! 563: #define iR1 reg0_1->reg[0] ! 564: ! 565: #define iR2 reg2_12->reg[0] ! 566: #define iR3 reg2_12->reg[1] ! 567: #define iR4 reg2_12->reg[2] ! 568: #define iR5 reg2_12->reg[3] ! 569: #define iR6 reg2_12->reg[4] ! 570: #define iR7 reg2_12->reg[5] ! 571: #define iR8 reg2_12->reg[6] ! 572: #define iR9 reg2_12->reg[7] ! 573: #define iR10 reg2_12->reg[8] ! 574: #define iR11 reg2_12->reg[9] ! 575: #define iR12 reg2_12->reg[10] ! 576: ! 577: union objects { /* for load/store */ ! 578: char ua_byte; ! 579: short ua_word; ! 580: long ua_long; ! 581: float ua_float; ! 582: double ua_double; ! 583: union objects *ua_anything; ! 584: }; ! 585: ! 586: typedef union objects anything; ! 587: enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN }; ! 588: ! 589: ! 590: /* ! 591: * assembly language assist ! 592: * There are some things you just can't do in C ! 593: */ ! 594: asm(".text"); ! 595: ! 596: long *myfp(); ! 597: asm("_myfp: .word 0"); ! 598: asm("movl (fp),r0"); ! 599: asm("ret"); ! 600: ! 601: struct frame *framep(p) ! 602: long *p; ! 603: { ! 604: return((struct frame *)(p-2)); ! 605: } ! 606: ! 607: struct arglist *argp(p) ! 608: long *p; ! 609: { ! 610: return((struct arglist *)(p+1)); ! 611: } ! 612: ! 613: char *mysp(); ! 614: asm("_mysp: .word 0"); ! 615: asm("addl3 $4,fp,r0"); ! 616: asm("ret"); ! 617: ! 618: char *mypc(); ! 619: asm("_mypc: .word 0"); ! 620: asm("movl -8(fp),r0"); ! 621: asm("ret"); ! 622: ! 623: asm(".data"); ! 624: ! 625: ! 626: /* ! 627: * Where interrupted objects are ! 628: */ ! 629: static struct frame *ifp; /* addr of saved FP */ ! 630: static struct arglist *iap; /* addr of saved AP */ ! 631: static char *isp; /* value of interrupted SP */ ! 632: static char **ipc; /* addr of saved PC */ ! 633: static struct reg0_1 *reg0_1;/* registers 0-1 are saved on the exception */ ! 634: static struct reg2_12 *reg2_12;/* we save 2-12 by our entry mask */ ! 635: static anything *result_addr; /* where the dummy result goes */ ! 636: static enum object_type result_type; /* what kind of object it is */ ! 637: ! 638: /* ! 639: * some globals ! 640: */ ! 641: static union { ! 642: long rv_long[2]; ! 643: float rv_float; ! 644: double rv_double; ! 645: } retval; /* the user specified dummy result */ ! 646: static int max_messages = 1; /* the user can tell us */ ! 647: static int fpe_count = 0; /* how bad is it ? */ ! 648: long fpeflt_ = 0; /* fortran "common /fpeflt/ flag" */ ! 649: static sig_t sigfpe_dfl = SIG_DFL; /* if we can't fix it ... */ ! 650: ! 651: /* ! 652: * The fortran unit control table ! 653: */ ! 654: extern unit units[]; ! 655: ! 656: /* ! 657: * Fortran message table is in main ! 658: */ ! 659: struct msgtbl { ! 660: char *mesg; ! 661: int dummy; ! 662: }; ! 663: extern struct msgtbl act_fpe[]; ! 664: ! 665: ! 666: /* VALID ONLY ON VAX !!! ! 667: * ! 668: * Get the address of the (saved) next operand & update saved PC. ! 669: * The major purpose of this is to determine where to store the result. ! 670: * There is one case we can't deal with: -(SP) or (SP)+ ! 671: * since we can't change the size of the stack. ! 672: * Let's just hope compilers don't generate that for results. ! 673: */ ! 674: ! 675: ! 676: /* ! 677: * Trap & repair floating exceptions so that a program may proceed. ! 678: * There is no notion of "correctness" here; just the ability to continue. ! 679: * ! 680: * The on_fpe() routine first checks the type code to see if the ! 681: * exception is repairable. If so, it checks the opcode to see if ! 682: * it is one that it knows. If this is true, it then simulates the ! 683: * VAX cpu in retrieving operands in order to increment iPC correctly. ! 684: * It notes where the result of the operation would have been stored ! 685: * and substitutes a previously supplied value. ! 686: * DOES NOT REPAIR ON TAHOE !!! ! 687: */ ! 688: void ! 689: on_fpe(signo, code, sc) ! 690: int signo, code; ! 691: struct sigcontext *sc; ! 692: { ! 693: /* ! 694: * There must be at least 11 register variables here ! 695: * so our entry mask will save R12-R2. ! 696: */ ! 697: register long *stk; ! 698: register long *sp, *rfp; ! 699: register struct arglist *ap; ! 700: register struct frame *fp; ! 701: register FILE *ef; ! 702: register struct sigframe *sfp; ! 703: register long dmy1, dmy2, dmy3, dmy4; ! 704: ! 705: dmy1 = dmy2 = dmy3 = dmy4 = 0; ! 706: ! 707: ef = units[STDERR].ufd; /* fortran error stream */ ! 708: ! 709: switch (code) ! 710: { ! 711: case FPE_INTOVF_TRAP: /* integer overflow */ ! 712: case FPE_INTDIV_TRAP: /* integer divide by zero */ ! 713: case FPE_FLTOVF_TRAP: /* floating overflow */ ! 714: case FPE_FLTDIV_TRAP: /* floating divide by zero */ ! 715: case FPE_FLTUND_TRAP: /* floating underflow */ ! 716: default: ! 717: cant_fix: ! 718: if (sigfpe_dfl > (SIG_VAL)7) /* user specified */ ! 719: (*sigfpe_dfl)(signo, code, sc); ! 720: else ! 721: if (++fpe_count <= max_messages) { ! 722: fprintf(ef, "trpfpe: %s", ! 723: act_fpe[code-1].mesg); ! 724: if (fpe_count == max_messages) ! 725: fprintf(ef, ": No more messages will be printed.\n"); ! 726: else ! 727: fputc('\n', ef); ! 728: } ! 729: fpeflt_ = -1; ! 730: break; ! 731: } ! 732: ! 733: /* ! 734: * Find all the registers just in case something better can be done. ! 735: */ ! 736: ! 737: rfp = myfp(); /* contents of fp register */ ! 738: ap = argp(rfp); /* my arglist pointer */ ! 739: fp = framep(rfp); /* my frame pointer */ ! 740: ifp = framep(*rfp); /* user's stored in next frame back */ ! 741: iap = argp(*rfp); ! 742: ! 743: sfp = (struct sigframe *)ap; /* sigframe contains at its bottom the ! 744: signal handler arguments */ ! 745: ! 746: reg0_1 = (struct reg0_1 *)&sfp->r1; ! 747: reg2_12 = (struct reg2_12 *)((char *)fp - sizeof (struct reg2_12)); ! 748: ! 749: ipc = (char **)&sc->sc_pc; ! 750: isp = (char *)sc + sizeof (struct sigcontext); ! 751: sc->sc_ps &= ~(PSL_V|PSL_FU); ! 752: ! 753: fprintf(ef, "Current PC = %X \n", sc->sc_pc); ! 754: ! 755: signal(SIGFPE, on_fpe); ! 756: sigdie(signo, code, sc); ! 757: } ! 758: ! 759: trpfpe_ (count, rval) ! 760: long *count; /* how many to announce */ ! 761: double *rval; /* dummy return value */ ! 762: { ! 763: max_messages = *count; ! 764: retval.rv_double = *rval; ! 765: sigfpe_dfl = signal(SIGFPE, on_fpe); ! 766: fpe_count = 0; ! 767: } ! 768: ! 769: long ! 770: fpecnt_ () ! 771: { ! 772: return (fpe_count); ! 773: } ! 774: ! 775: #endif tahoe
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.