![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to trapov_.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.lib / libF77|
Return to trapov_.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.lib / libF77 |
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.