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

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.