2.9BSD - /usr/src/lib/libF77/trapov_.c

   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) &regs0t6[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 *) &regs0t6[reg];
 566:     }
 567:     if (reg >= 7 && reg <= 11) {
 568:         return (anyval *) &regs7t11[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

Defined functions

Defined variables

Defined struct's

Defined union's

Defined typedef's

Defined macros