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