Return to trpfpe_.c CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.lib / libF77

Annotation of cci/usr/src/usr.lib/libF77/trpfpe_.c, revision 1.1

1.1     ! root        1: /*
        !             2:  *     @(#)trpfpe_.c   1.1     6/7/85
        !             3:  *
        !             4:  *
        !             5:  *     Fortran floating-point error handler
        !             6:  *
        !             7:  *     Synopsis:
        !             8:  *             call trpfpe (n, retval)
        !             9:  *                     causes floating point faults to be trapped, with the
        !            10:  *                     first 'n' errors getting a message printed.
        !            11:  *                     'retval' is put in place of the bad result.
        !            12:  *             k = fpecnt()
        !            13:  *                     causes 'k' to get the number of errors since the
        !            14:  *                     last call to trpfpe().
        !            15:  *
        !            16:  *             common /fpeflt/ fpflag
        !            17:  *             logical fpflag
        !            18:  *                     fpflag will become .true. on faults
        !            19:  *
        !            20:  *     This handler just prints a message. It cannot fix anything
        !            21:  *     on Power6 because of its fpp architecture. In any case, there
        !            22:  *     are no arithmetic faults (only traps) around, so that no instruction
        !            23:  *     is interrupted befor it completes, and PC points to the next floating
        !            24:  *     point instruction (not necessarily next executable instr after the one
        !            25:  *     that got the exception).
        !            26:  */
        !            27: 
        !            28: 
        !            29: #include <stdio.h>
        !            30: #include <signal.h>
        !            31: #include "../libI77/fiodefs.h"
        !            32: 
        !            33: #define        SIG_VAL         int (*)()
        !            34: 
        !            35: 
        !            36: struct arglist {               /* what AP points to */
        !            37:        long    al_arg[256];
        !            38: };
        !            39: 
        !            40: struct reg0_1 {
        !            41:        long    reg[2];
        !            42: };
        !            43: struct reg2_12 {
        !            44:        long    reg[11];
        !            45: };
        !            46: #include <sys/types.h>
        !            47: #include <frame.h>
        !            48: #include "sigframe.h"
        !            49: 
        !            50: /*
        !            51:  * bits in the PSL
        !            52:  */
        !            53: #include <machine/psl.h>
        !            54: 
        !            55: /*
        !            56:  * where the registers are stored as we see them in the handler
        !            57:  */
        !            58: 
        !            59: 
        !            60: #define        iR0     reg0_1->reg[1]
        !            61: #define        iR1     reg0_1->reg[0]
        !            62: 
        !            63: #define        iR2     reg2_12->reg[0]
        !            64: #define        iR3     reg2_12->reg[1]
        !            65: #define        iR4     reg2_12->reg[2]
        !            66: #define        iR5     reg2_12->reg[3]
        !            67: #define        iR6     reg2_12->reg[4]
        !            68: #define        iR7     reg2_12->reg[5]
        !            69: #define        iR8     reg2_12->reg[6]
        !            70: #define        iR9     reg2_12->reg[7]
        !            71: #define        iR10    reg2_12->reg[8]
        !            72: #define        iR11    reg2_12->reg[9]
        !            73: #define        iR12    reg2_12->reg[10]
        !            74: 
        !            75: union objects {                /* for load/store */
        !            76:        char    ua_byte;
        !            77:        short   ua_word;
        !            78:        long    ua_long;
        !            79:        float   ua_float;
        !            80:        double  ua_double;
        !            81:        union objects   *ua_anything;
        !            82: };
        !            83: 
        !            84: typedef union objects  anything;
        !            85: enum object_type { BYTE, WORD, LONG, FLOAT, QUAD, DOUBLE, UNKNOWN };
        !            86: 
        !            87: 
        !            88: /*
        !            89:  * assembly language assist
        !            90:  * There are some things you just can't do in C
        !            91:  */
        !            92: asm(".text");
        !            93: 
        !            94: long *myfp();
        !            95: asm("_myfp: .word 0");
        !            96:        asm("movl (fp),r0");
        !            97:        asm("ret");
        !            98: 
        !            99: struct frame *framep(p)
        !           100: long *p;
        !           101: {
        !           102:        return((struct frame *)(p-2));
        !           103: }
        !           104: 
        !           105: struct arglist *argp(p) 
        !           106: long *p;
        !           107: {
        !           108:        return((struct arglist *)(p+1));
        !           109: }
        !           110: 
        !           111: char   *mysp();
        !           112: asm("_mysp: .word 0");
        !           113:        asm("addl3 $4,fp,r0");
        !           114:        asm("ret");
        !           115: 
        !           116: char   *mypc();
        !           117: asm("_mypc: .word 0");
        !           118:        asm("movl -8(fp),r0");
        !           119:        asm("ret");
        !           120: 
        !           121: asm(".data");
        !           122: 
        !           123: 
        !           124: /*
        !           125:  * Where interrupted objects are
        !           126:  */
        !           127: static struct frame    *ifp;   /* addr of saved FP */
        !           128: static struct arglist  *iap;   /* addr of saved AP */
        !           129: static char             *isp;  /* value of interrupted SP */
        !           130: static char            **ipc;  /* addr of saved PC */
        !           131: static struct reg0_1   *reg0_1;/* registers 0-1 are saved on the exception */
        !           132: static struct reg2_12  *reg2_12;/* we save 2-12 by our entry mask */
        !           133: static anything                *result_addr;   /* where the dummy result goes */
        !           134: static enum object_type         result_type;   /* what kind of object it is */
        !           135: 
        !           136: /*
        !           137:  * some globals
        !           138:  */
        !           139: static union {
        !           140:        long    rv_long[2];
        !           141:        float   rv_float;
        !           142:        double  rv_double;
        !           143:                        } retval; /* the user specified dummy result */
        !           144: static int     max_messages    = 1;            /* the user can tell us */
        !           145: static int     fpe_count       = 0;            /* how bad is it ? */
        !           146:        long    fpeflt_         = 0;    /* fortran "common /fpeflt/ flag" */
        !           147: static int     (*sigfpe_dfl)() = SIG_DFL;      /* if we can't fix it ... */
        !           148: 
        !           149: /*
        !           150:  * The fortran unit control table
        !           151:  */
        !           152: extern unit units[];
        !           153: 
        !           154: /*
        !           155:  * Fortran message table is in main
        !           156:  */
        !           157: struct msgtbl {
        !           158:        char    *mesg;
        !           159:        int     dummy;
        !           160: };
        !           161: extern struct msgtbl   act_fpe[];
        !           162: 
        !           163: 
        !           164: /* VALID ONLY ON VAX !!!
        !           165:  *
        !           166:  * Get the address of the (saved) next operand & update saved PC.
        !           167:  * The major purpose of this is to determine where to store the result.
        !           168:  * There is one case we can't deal with: -(SP) or (SP)+
        !           169:  * since we can't change the size of the stack.
        !           170:  * Let's just hope compilers don't generate that for results.
        !           171:  */
        !           172: 
        !           173: 
        !           174: /*
        !           175:  * Trap & repair floating exceptions so that a program may proceed.
        !           176:  * There is no notion of "correctness" here; just the ability to continue.
        !           177:  *
        !           178:  * The on_fpe() routine first checks the type code to see if the
        !           179:  * exception is repairable. If so, it checks the opcode to see if
        !           180:  * it is one that it knows. If this is true, it then simulates the
        !           181:  * VAX cpu in retrieving operands in order to increment iPC correctly.
        !           182:  * It notes where the result of the operation would have been stored
        !           183:  * and substitutes a previously supplied value.
        !           184:  *  DOES NOT REPAIR ON TAHOE !!!
        !           185:  */
        !           186: 
        !           187: on_fpe(signo, code, sc)
        !           188:        int signo, code;
        !           189:        struct sigcontext *sc;
        !           190: {
        !           191:        /*
        !           192:         * There must be at least 11 register variables here
        !           193:         * so our entry mask will save R12-R2.
        !           194:         */
        !           195:        register long   *stk;
        !           196:        register long   *sp, *rfp;
        !           197:        register struct arglist *ap;
        !           198:        register struct frame   *fp;
        !           199:        register FILE   *ef;
        !           200:        register struct sigframe *sfp;
        !           201:        register long dmy1, dmy2, dmy3, dmy4;
        !           202: 
        !           203:        dmy1 = dmy2 = dmy3 = dmy4 = 0;
        !           204: 
        !           205:        ef = units[STDERR].ufd;         /* fortran error stream */
        !           206: 
        !           207:        switch (code)
        !           208:        {
        !           209:                case FPE_INTOVF_TRAP:   /* integer overflow */
        !           210:                case FPE_INTDIV_TRAP:   /* integer divide by zero */
        !           211:                case FPE_FLTOVF_TRAP:   /* floating overflow */
        !           212:                case FPE_FLTDIV_TRAP:   /* floating divide by zero */
        !           213:                case FPE_FLTUND_TRAP:   /* floating underflow */
        !           214:                default:
        !           215: cant_fix:
        !           216:                        if (sigfpe_dfl > (SIG_VAL)7)    /* user specified */
        !           217:                                return((*sigfpe_dfl)(signo, code, sc));
        !           218:                        else
        !           219:                        if (++fpe_count <= max_messages) {
        !           220:                                fprintf(ef, "trpfpe: %s",
        !           221:                                        act_fpe[code-1].mesg);
        !           222:                                if (fpe_count == max_messages)
        !           223:                                        fprintf(ef, ": No more messages will be printed.\n");
        !           224:                                else
        !           225:                                        fputc('\n', ef);
        !           226:                        }
        !           227:                        fpeflt_ = -1;
        !           228:                        break;
        !           229:        }
        !           230: 
        !           231: /*
        !           232:  * Find all the registers just in case something better can be done.
        !           233:  */
        !           234: 
        !           235:        rfp = myfp();                   /* contents of fp register */
        !           236:        ap = argp(rfp);                 /* my arglist pointer */
        !           237:        fp = framep(rfp);               /* my frame pointer */
        !           238:        ifp = framep(*rfp);             /* user's stored in next frame back */
        !           239:        iap = argp(*rfp);
        !           240: 
        !           241:        sfp = (struct sigframe *)ap;    /* sigframe contains at its bottom the
        !           242:                                           signal handler arguments */
        !           243: 
        !           244:        reg0_1 = (struct reg0_1 *)&sfp->r1;
        !           245:        reg2_12 = (struct reg2_12 *)((char *)fp - sizeof (struct reg2_12));
        !           246: 
        !           247:        ipc = (char **)&sc->sc_pc;
        !           248:        isp = (char *)sc + sizeof (struct sigcontext);
        !           249:        sc->sc_ps &= ~(PSL_V|PSL_FU);
        !           250: 
        !           251:        fprintf(ef, "Current PC = %X \n", sc->sc_pc);
        !           252: 
        !           253:        signal(SIGFPE, on_fpe);
        !           254:        sigdie(signo, code, sc);
        !           255: }
        !           256: 
        !           257: trpfpe_ (count, rval)
        !           258:        long    *count; /* how many to announce */
        !           259:        double  *rval;  /* dummy return value */
        !           260: {
        !           261:        max_messages = *count;
        !           262:        retval.rv_double = *rval;
        !           263:        sigfpe_dfl = signal(SIGFPE, on_fpe);
        !           264:        fpe_count = 0;
        !           265: }
        !           266: 
        !           267: long
        !           268: fpecnt_ ()
        !           269: {
        !           270:        return (fpe_count);
        !           271: }
        !           272: 

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