Annotation of 43BSDTahoe/usr.lib/libF77/trpfpe_.c, revision 1.1.1.1

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.4     11/4/86
                      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 <signal.h>
                     31: #include "../libI77/fiodefs.h"
                     32: 
                     33: #define        SIG_VAL         int (*)()
                     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 int     (*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 *)&reg0_6->reg[regnum];
                    193:        else if (regnum <= R11)
                    194:                reg_addr = (anything *)&reg7_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: on_fpe(signo, code, sc, grbg)
                    332:        int signo, code;
                    333:        struct sigcontext *sc;
                    334: #endif
                    335: {
                    336:        /*
                    337:         * There must be at least 5 register variables here
                    338:         * so our entry mask will save R11-R7.
                    339:         */
                    340:        register long   *stk;
                    341:        register long   *sp;
                    342:        register struct arglist *ap;
                    343:        register struct cframe  *fp;
                    344:        register FILE   *ef;
                    345: 
                    346:        ef = units[STDERR].ufd;         /* fortran error stream */
                    347: 
                    348:        switch (code)
                    349:        {
                    350:                case FPE_INTOVF_TRAP:   /* integer overflow */
                    351:                case FPE_INTDIV_TRAP:   /* integer divide by zero */
                    352:                case FPE_FLTOVF_TRAP:   /* floating overflow */
                    353:                case FPE_FLTDIV_TRAP:   /* floating/decimal divide by zero */
                    354:                case FPE_FLTUND_TRAP:   /* floating underflow */
                    355:                case FPE_DECOVF_TRAP:   /* decimal overflow */
                    356:                case FPE_SUBRNG_TRAP:   /* subscript out of range */
                    357:                default:
                    358: cant_fix:
                    359:                        if (sigfpe_dfl > (SIG_VAL)7)    /* user specified */
                    360: #ifdef OLD_BSD
                    361:                                return((*sigfpe_dfl)(signo, code, myaddr, pc, ps));
                    362: #else
                    363:                                return((*sigfpe_dfl)(signo, code, sc, grbg));
                    364: #endif
                    365:                        else
                    366: #ifdef OLD_BSD
                    367:                                sigdie(signo, code, myaddr, pc, ps);
                    368: #else
                    369:                                sigdie(signo, code, sc, grbg);
                    370: #endif
                    371:                        /* NOTREACHED */
                    372: 
                    373:                case FPE_FLTOVF_FAULT:  /* floating overflow fault */
                    374:                case FPE_FLTDIV_FAULT:  /* divide by zero floating fault */
                    375:                case FPE_FLTUND_FAULT:  /* floating underflow fault */
                    376:                        if (++fpe_count <= max_messages) {
                    377:                                fprintf(ef, "trpfpe: %s",
                    378:                                        act_fpe[code-1].mesg);
                    379:                                if (fpe_count == max_messages)
                    380:                                        fprintf(ef, ": No more messages will be printed.\n");
                    381:                                else
                    382:                                        fputc('\n', ef);
                    383:                        }
                    384:                        fpeflt_ = -1;
                    385:                        break;
                    386:        }
                    387: 
                    388:        ap = myap();                    /* my arglist pointer */
                    389:        fp = myfp();                    /* my frame pointer */
                    390:        ifp = &(fp->cf_fp)->cf_fp;      /* user's stored in next frame back */
                    391:        iap = &(fp->cf_fp)->cf_ap;
                    392:        /*
                    393:         * these are likely to be system dependent
                    394:         */
                    395:        reg0_6 = (struct reg0_6 *)((char *)fp->cf_fp + sizeof (struct cframe));
                    396:        reg7_11 = (struct reg7_11 *)((char *)fp->cf_fp - sizeof (struct reg7_11));
                    397: 
                    398: #ifdef OLD_BSD
                    399:        ipc = &pc;
                    400:        isp = (char *)&ap->al_arg[ap->al_numarg + 2];   /* assumes 2 dummys */
                    401:        ps &= ~(PSW_V|PSW_FU);
                    402: #else
                    403:        ipc = (char **)&sc->sc_pc;
                    404:        isp = (char *)sc + sizeof (struct sigcontext);
                    405:        sc->sc_ps &= ~(PSW_V|PSW_FU);
                    406: #endif
                    407: 
                    408: 
                    409:        switch (*(*ipc)++)
                    410:        {
                    411:                case ADDD3:
                    412:                case DIVD3:
                    413:                case MULD3:
                    414:                case SUBD3:
                    415:                        (void) get_operand(sizeof (double));
                    416:                        /* intentional fall-thru */
                    417: 
                    418:                case ADDD2:
                    419:                case DIVD2:
                    420:                case MULD2:
                    421:                case SUBD2:
                    422:                case MNEGD:
                    423:                case MOVD:
                    424:                        (void) get_operand(sizeof (double));
                    425:                        result_addr = get_operand(sizeof (double));
                    426:                        result_type = DOUBLE;
                    427:                        break;
                    428: 
                    429:                case ADDF3:
                    430:                case DIVF3:
                    431:                case MULF3:
                    432:                case SUBF3:
                    433:                        (void) get_operand(sizeof (float));
                    434:                        /* intentional fall-thru */
                    435: 
                    436:                case ADDF2:
                    437:                case DIVF2:
                    438:                case MULF2:
                    439:                case SUBF2:
                    440:                case MNEGF:
                    441:                case MOVF:
                    442:                        (void) get_operand(sizeof (float));
                    443:                        result_addr = get_operand(sizeof (float));
                    444:                        result_type = FLOAT;
                    445:                        break;
                    446: 
                    447:                case CVTDF:
                    448:                        (void) get_operand(sizeof (double));
                    449:                        result_addr = get_operand(sizeof (float));
                    450:                        result_type = FLOAT;
                    451:                        break;
                    452: 
                    453:                case CVTFD:
                    454:                        (void) get_operand(sizeof (float));
                    455:                        result_addr = get_operand(sizeof (double));
                    456:                        result_type = DOUBLE;
                    457:                        break;
                    458: 
                    459:                case EMODF:
                    460:                case EMODD:
                    461:                        fprintf(ef, "trpfpe: can't fix emod yet\n");
                    462:                        goto cant_fix;
                    463: 
                    464:                case POLYF:
                    465:                case POLYD:
                    466:                        fprintf(ef, "trpfpe: can't fix poly yet\n");
                    467:                        goto cant_fix;
                    468: 
                    469:                case ACBD:
                    470:                case ACBF:
                    471:                case CMPD:
                    472:                case CMPF:
                    473:                case TSTD:
                    474:                case TSTF:
                    475:                case CVTDB:
                    476:                case CVTDL:
                    477:                case CVTDW:
                    478:                case CVTFB:
                    479:                case CVTFL:
                    480:                case CVTFW:
                    481:                case CVTRDL:
                    482:                case CVTRFL:
                    483:                        /* These can generate only reserved operand faults */
                    484:                        /* They are shown here for completeness */
                    485: 
                    486:                default:
                    487:                        fprintf(stderr, "trp: opcode 0x%02x unknown\n",
                    488:                                *(--(*ipc)) & 0xff);
                    489:                        goto cant_fix;
                    490:                        /* NOTREACHED */
                    491:        }
                    492: 
                    493:        if (result_type == FLOAT)
                    494:                result_addr->ua_float = retval.rv_float;
                    495:        else
                    496:        {
                    497:                if (result_addr == (anything *)&iR6)
                    498:                {       /*
                    499:                         * special case - the R6/R7 pair is stored apart
                    500:                         */
                    501:                        result_addr->ua_long = retval.rv_long[0];
                    502:                        ((anything *)&iR7)->ua_long = retval.rv_long[1];
                    503:                }
                    504:                else
                    505:                        result_addr->ua_double = retval.rv_double;
                    506:        }
                    507:        signal(SIGFPE, on_fpe);
                    508: }
                    509: 
                    510: trpfpe_ (count, rval)
                    511:        long    *count; /* how many to announce */
                    512:        double  *rval;  /* dummy return value */
                    513: {
                    514:        max_messages = *count;
                    515:        retval.rv_double = *rval;
                    516:        sigfpe_dfl = signal(SIGFPE, on_fpe);
                    517:        fpe_count = 0;
                    518: }
                    519: 
                    520: long
                    521: fpecnt_ ()
                    522: {
                    523:        return (fpe_count);
                    524: }
                    525: #endif vax
                    526: 
                    527: #ifdef tahoe
                    528: /*
                    529:  *     This handler just prints a message. It cannot fix anything
                    530:  *     on Power6 because of its fpp architecture. In any case, there
                    531:  *     are no arithmetic faults (only traps) around, so that no instruction
                    532:  *     is interrupted befor it completes, and PC points to the next floating
                    533:  *     point instruction (not necessarily next executable instr after the one
                    534:  *     that got the exception).
                    535:  */
                    536: 
                    537: struct arglist {               /* what AP points to */
                    538:        long    al_arg[256];
                    539: };
                    540: 
                    541: struct reg0_1 {
                    542:        long    reg[2];
                    543: };
                    544: struct reg2_12 {
                    545:        long    reg[11];
                    546: };
                    547: #include <sys/types.h>
                    548: #include <frame.h>
                    549: #include "sigframe.h"
                    550: 
                    551: /*
                    552:  * bits in the PSL
                    553:  */
                    554: #include <machine/psl.h>
                    555: 
                    556: /*
                    557:  * where the registers are stored as we see them in the handler
                    558:  */
                    559: 
                    560: 
                    561: #define        iR0     reg0_1->reg[1]
                    562: #define        iR1     reg0_1->reg[0]
                    563: 
                    564: #define        iR2     reg2_12->reg[0]
                    565: #define        iR3     reg2_12->reg[1]
                    566: #define        iR4     reg2_12->reg[2]
                    567: #define        iR5     reg2_12->reg[3]
                    568: #define        iR6     reg2_12->reg[4]
                    569: #define        iR7     reg2_12->reg[5]
                    570: #define        iR8     reg2_12->reg[6]
                    571: #define        iR9     reg2_12->reg[7]
                    572: #define        iR10    reg2_12->reg[8]
                    573: #define        iR11    reg2_12->reg[9]
                    574: #define        iR12    reg2_12->reg[10]
                    575: 
                    576: union objects {                /* for load/store */
                    577:        char    ua_byte;
                    578:        short   ua_word;
                    579:        long    ua_long;
                    580:        float   ua_float;
                    581:        double  ua_double;
                    582:        union objects   *ua_anything;
                    583: };
                    584: 
                    585: typedef union objects  anything;
                    586: enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN };
                    587: 
                    588: 
                    589: /*
                    590:  * assembly language assist
                    591:  * There are some things you just can't do in C
                    592:  */
                    593: asm(".text");
                    594: 
                    595: long *myfp();
                    596: asm("_myfp: .word 0");
                    597:        asm("movl (fp),r0");
                    598:        asm("ret");
                    599: 
                    600: struct frame *framep(p)
                    601: long *p;
                    602: {
                    603:        return((struct frame *)(p-2));
                    604: }
                    605: 
                    606: struct arglist *argp(p) 
                    607: long *p;
                    608: {
                    609:        return((struct arglist *)(p+1));
                    610: }
                    611: 
                    612: char   *mysp();
                    613: asm("_mysp: .word 0");
                    614:        asm("addl3 $4,fp,r0");
                    615:        asm("ret");
                    616: 
                    617: char   *mypc();
                    618: asm("_mypc: .word 0");
                    619:        asm("movl -8(fp),r0");
                    620:        asm("ret");
                    621: 
                    622: asm(".data");
                    623: 
                    624: 
                    625: /*
                    626:  * Where interrupted objects are
                    627:  */
                    628: static struct frame    *ifp;   /* addr of saved FP */
                    629: static struct arglist  *iap;   /* addr of saved AP */
                    630: static char             *isp;  /* value of interrupted SP */
                    631: static char            **ipc;  /* addr of saved PC */
                    632: static struct reg0_1   *reg0_1;/* registers 0-1 are saved on the exception */
                    633: static struct reg2_12  *reg2_12;/* we save 2-12 by our entry mask */
                    634: static anything                *result_addr;   /* where the dummy result goes */
                    635: static enum object_type         result_type;   /* what kind of object it is */
                    636: 
                    637: /*
                    638:  * some globals
                    639:  */
                    640: static union {
                    641:        long    rv_long[2];
                    642:        float   rv_float;
                    643:        double  rv_double;
                    644:                        } retval; /* the user specified dummy result */
                    645: static int     max_messages    = 1;            /* the user can tell us */
                    646: static int     fpe_count       = 0;            /* how bad is it ? */
                    647:        long    fpeflt_         = 0;    /* fortran "common /fpeflt/ flag" */
                    648: static int     (*sigfpe_dfl)() = SIG_DFL;      /* if we can't fix it ... */
                    649: 
                    650: /*
                    651:  * The fortran unit control table
                    652:  */
                    653: extern unit units[];
                    654: 
                    655: /*
                    656:  * Fortran message table is in main
                    657:  */
                    658: struct msgtbl {
                    659:        char    *mesg;
                    660:        int     dummy;
                    661: };
                    662: extern struct msgtbl   act_fpe[];
                    663: 
                    664: 
                    665: /* VALID ONLY ON VAX !!!
                    666:  *
                    667:  * Get the address of the (saved) next operand & update saved PC.
                    668:  * The major purpose of this is to determine where to store the result.
                    669:  * There is one case we can't deal with: -(SP) or (SP)+
                    670:  * since we can't change the size of the stack.
                    671:  * Let's just hope compilers don't generate that for results.
                    672:  */
                    673: 
                    674: 
                    675: /*
                    676:  * Trap & repair floating exceptions so that a program may proceed.
                    677:  * There is no notion of "correctness" here; just the ability to continue.
                    678:  *
                    679:  * The on_fpe() routine first checks the type code to see if the
                    680:  * exception is repairable. If so, it checks the opcode to see if
                    681:  * it is one that it knows. If this is true, it then simulates the
                    682:  * VAX cpu in retrieving operands in order to increment iPC correctly.
                    683:  * It notes where the result of the operation would have been stored
                    684:  * and substitutes a previously supplied value.
                    685:  *  DOES NOT REPAIR ON TAHOE !!!
                    686:  */
                    687: 
                    688: on_fpe(signo, code, sc)
                    689:        int signo, code;
                    690:        struct sigcontext *sc;
                    691: {
                    692:        /*
                    693:         * There must be at least 11 register variables here
                    694:         * so our entry mask will save R12-R2.
                    695:         */
                    696:        register long   *stk;
                    697:        register long   *sp, *rfp;
                    698:        register struct arglist *ap;
                    699:        register struct frame   *fp;
                    700:        register FILE   *ef;
                    701:        register struct sigframe *sfp;
                    702:        register long dmy1, dmy2, dmy3, dmy4;
                    703: 
                    704:        dmy1 = dmy2 = dmy3 = dmy4 = 0;
                    705: 
                    706:        ef = units[STDERR].ufd;         /* fortran error stream */
                    707: 
                    708:        switch (code)
                    709:        {
                    710:                case FPE_INTOVF_TRAP:   /* integer overflow */
                    711:                case FPE_INTDIV_TRAP:   /* integer divide by zero */
                    712:                case FPE_FLTOVF_TRAP:   /* floating overflow */
                    713:                case FPE_FLTDIV_TRAP:   /* floating divide by zero */
                    714:                case FPE_FLTUND_TRAP:   /* floating underflow */
                    715:                default:
                    716: cant_fix:
                    717:                        if (sigfpe_dfl > (SIG_VAL)7)    /* user specified */
                    718:                                return((*sigfpe_dfl)(signo, code, sc));
                    719:                        else
                    720:                        if (++fpe_count <= max_messages) {
                    721:                                fprintf(ef, "trpfpe: %s",
                    722:                                        act_fpe[code-1].mesg);
                    723:                                if (fpe_count == max_messages)
                    724:                                        fprintf(ef, ": No more messages will be printed.\n");
                    725:                                else
                    726:                                        fputc('\n', ef);
                    727:                        }
                    728:                        fpeflt_ = -1;
                    729:                        break;
                    730:        }
                    731: 
                    732: /*
                    733:  * Find all the registers just in case something better can be done.
                    734:  */
                    735: 
                    736:        rfp = myfp();                   /* contents of fp register */
                    737:        ap = argp(rfp);                 /* my arglist pointer */
                    738:        fp = framep(rfp);               /* my frame pointer */
                    739:        ifp = framep(*rfp);             /* user's stored in next frame back */
                    740:        iap = argp(*rfp);
                    741: 
                    742:        sfp = (struct sigframe *)ap;    /* sigframe contains at its bottom the
                    743:                                           signal handler arguments */
                    744: 
                    745:        reg0_1 = (struct reg0_1 *)&sfp->r1;
                    746:        reg2_12 = (struct reg2_12 *)((char *)fp - sizeof (struct reg2_12));
                    747: 
                    748:        ipc = (char **)&sc->sc_pc;
                    749:        isp = (char *)sc + sizeof (struct sigcontext);
                    750:        sc->sc_ps &= ~(PSL_V|PSL_FU);
                    751: 
                    752:        fprintf(ef, "Current PC = %X \n", sc->sc_pc);
                    753: 
                    754:        signal(SIGFPE, on_fpe);
                    755:        sigdie(signo, code, sc);
                    756: }
                    757: 
                    758: trpfpe_ (count, rval)
                    759:        long    *count; /* how many to announce */
                    760:        double  *rval;  /* dummy return value */
                    761: {
                    762:        max_messages = *count;
                    763:        retval.rv_double = *rval;
                    764:        sigfpe_dfl = signal(SIGFPE, on_fpe);
                    765:        fpe_count = 0;
                    766: }
                    767: 
                    768: long
                    769: fpecnt_ ()
                    770: {
                    771:        return (fpe_count);
                    772: }
                    773: 
                    774: #endif tahoe

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.