Return to trapov_.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/trapov_.c, revision 1.1

1.1     ! root        1: /*
        !             2:  *     @(#)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:  *     NO RESERVED OPERAND EXCEPTION ON RESULT OF FP OVERFLOW ON TAHOE.
        !            13:  *     JUST PRINT THE OVERFLOW MESSAGE. RESULT IS 0 (zero).
        !            14:  *
        !            15:  *     Synopsis:
        !            16:  *             call trapov(n)
        !            17:  *                     causes overflows to be trapped, with the first 'n'
        !            18:  *                     overflows getting an "Overflow!" message printed.
        !            19:  *             k = ovcnt(0)
        !            20:  *                     causes 'k' to get the number of overflows since the
        !            21:  *                     last call to trapov().
        !            22:  *
        !            23:  */
        !            24: 
        !            25: # include <stdio.h>
        !            26: # include <signal.h>
        !            27: # include "../libI77/fiodefs.h"
        !            28: # define SIG_VAL       int (*)()
        !            29: 
        !            30: /*
        !            31:  * trap type codes
        !            32:  */
        !            33: # define INT_OVF_T     1
        !            34: # define INT_DIV_T     2
        !            35: # define FLT_OVF_T     3
        !            36: # define FLT_DIV_T     4
        !            37: # define FLT_UND_T     5
        !            38: 
        !            39: /*
        !            40:  *     Potential operand values
        !            41:  */
        !            42: typedef        union operand_types {
        !            43:                char    o_byte;
        !            44:                short   o_word;
        !            45:                long    o_long;
        !            46:                float   o_float;
        !            47:                long    o_quad[2];
        !            48:                double  o_double;
        !            49:        } anyval;
        !            50: 
        !            51: /*
        !            52:  *     GLOBAL VARIABLES (we need a few)
        !            53:  *
        !            54:  *     Actual program counter and locations of registers.
        !            55:  */
        !            56: static char    *pc;
        !            57: static int     *regs0t1;
        !            58: static int     *regs2t12;
        !            59: static int     max_messages;
        !            60: static int     total_overflows;
        !            61: static union   {
        !            62:        long    v_long[2];
        !            63:        double  v_double;
        !            64:        } retrn;
        !            65: static int     (*sigill_default)() = (SIG_VAL)-1;
        !            66: static int     (*sigfpe_default)();
        !            67: 
        !            68: /*
        !            69:  *     the fortran unit control table
        !            70:  */
        !            71: extern unit units[];
        !            72: 
        !            73: /*
        !            74:  * Fortran message table is in main
        !            75:  */
        !            76: struct msgtbl {
        !            77:        char    *mesg;
        !            78:        int     dummy;
        !            79: };
        !            80: extern struct msgtbl   act_fpe[];
        !            81: 
        !            82: 
        !            83: 
        !            84: anyval *get_operand_address(), *addr_of_reg();
        !            85: char *opcode_name();
        !            86: 
        !            87: /*
        !            88:  *     This routine sets up the signal handler for the floating-point
        !            89:  *     and reserved operand interrupts.
        !            90:  */
        !            91: 
        !            92: trapov_(count, rtnval)
        !            93:        int *count;
        !            94:        double *rtnval;
        !            95: {
        !            96:        extern got_overflow();
        !            97: 
        !            98:        sigfpe_default = signal(SIGFPE, got_overflow);
        !            99:        total_overflows = 0;
        !           100:        max_messages = *count;
        !           101:        retrn.v_double = *rtnval;
        !           102: }
        !           103: 
        !           104: 
        !           105: 
        !           106: /*
        !           107:  *     got_overflow - routine called when overflow occurs
        !           108:  *
        !           109:  *     This routine just prints a message about the overflow.
        !           110:  *     It is impossible to find the bad result at this point.
        !           111:  *      NEXT 2 LINES DON'T HOLD FOR TAHOE !
        !           112:  *     Instead, we wait until we get the reserved operand exception
        !           113:  *     when we try to use it.  This raises the SIGILL signal.
        !           114:  */
        !           115: 
        !           116: /*ARGSUSED*/
        !           117: got_overflow(signo, codeword, sc)
        !           118:        int signo, codeword;
        !           119:        struct sigcontext *sc;
        !           120: {
        !           121:        int     *sp, i;
        !           122:        FILE    *ef;
        !           123: 
        !           124:        signal(SIGFPE, got_overflow);
        !           125:        ef = units[STDERR].ufd;
        !           126:        switch (codeword) {
        !           127:                case INT_OVF_T:
        !           128:                case INT_DIV_T:
        !           129:                case FLT_UND_T:
        !           130:                case FLT_DIV_T:
        !           131:                                if (sigfpe_default > (SIG_VAL)7)
        !           132:                                        return((*sigfpe_default)(signo, codeword, sc));
        !           133:                                else
        !           134:                                        sigdie(signo, codeword, sc);
        !           135:                                        /* NOTREACHED */
        !           136: 
        !           137:                case FLT_OVF_T:
        !           138:                                if (++total_overflows <= max_messages) {
        !           139:                                        fprintf(ef, "trapov: %s",
        !           140:                                                act_fpe[codeword-1].mesg);
        !           141:                                        fprintf(ef, ": Current PC = %X", sc->sc_pc);
        !           142:                                        if (total_overflows == max_messages)
        !           143:                                                fprintf(ef, ": No more messages will be printed.\n");
        !           144:                                        else
        !           145:                                                fputc('\n', ef);
        !           146:                                }
        !           147:                                return;
        !           148:        }
        !           149: }
        !           150: int 
        !           151: ovcnt_()
        !           152: {
        !           153:        return total_overflows;
        !           154: }

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