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

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

Defined functions

Defined variables

Defined struct's

Defined union's

Defined typedef's

Defined macros