BSD 4_2 release

[unix-history] / usr / src / usr.lib / libF77 / trapov_.c

diff --git a/usr/src/usr.lib/libF77/trapov_.c b/usr/src/usr.lib/libF77/trapov_.c
index c349036..06e863c 100644 (file)
--- a/usr/src/usr.lib/libF77/trapov_.c
+++ b/usr/src/usr.lib/libF77/trapov_.c
@@ -1,4 +1,6 @@
 /*
 /*

+char   id_trapov[] = "@(#)trapov_.c    1.2";
+ *

  *     Fortran/C floating-point overflow handler
  *
  *     The idea of these routines is to catch floating-point overflows
  *     Fortran/C floating-point overflow handler
  *
  *     The idea of these routines is to catch floating-point overflows


@@ -23,6 +25,7 @@
 # include <signal.h>
 # include "opcodes.h"
 # include "../libI77/fiodefs.h"
 # include <signal.h>
 # include "opcodes.h"
 # include "../libI77/fiodefs.h"

+# define SIG_VAL       int (*)()

 
 /*
  *     Operand modes
 
 /*
  *     Operand modes


@@ -56,6 +59,24 @@
 # define FP    0xd
 # define AP    0xc
 
 # define FP    0xd
 # define AP    0xc
 

+/*
+ * trap type codes
+ */
+# define INT_OVF_T     1
+# define INT_DIV_T     2
+# define FLT_OVF_T     3
+# define FLT_DIV_T     4
+# define FLT_UND_T     5
+# define DEC_OVF_T     6
+# define SUB_RNG_T     7
+# define FLT_OVF_F     8
+# define FLT_DIV_F     9
+# define FLT_UND_F     10
+
+# define RES_ADR_F     0
+# define RES_OPC_F     1
+# define RES_OPR_F     2
+

 /*
  *     Potential operand values
  */
 /*
  *     Potential operand values
  */


@@ -73,7 +94,7 @@ typedef       union operand_types {
  *
  *     Actual program counter and locations of registers.
  */
  *
  *     Actual program counter and locations of registers.
  */

-
+#if    vax

 static char    *pc;
 static int     *regs0t6;
 static int     *regs7t11;
 static char    *pc;
 static int     *regs0t6;
 static int     *regs7t11;


@@ -83,13 +104,26 @@ static union       {
        long    v_long[2];
        double  v_double;
        } retrn;
        long    v_long[2];
        double  v_double;
        } retrn;

-static int     sigill_default = 0;
+static int     (*sigill_default)() = (SIG_VAL)-1;
+static int     (*sigfpe_default)();
+#endif vax

 
 /*
  *     the fortran unit control table
  */
 extern unit units[];
 
 
 /*
  *     the fortran unit control table
  */
 extern unit units[];
 

+/*
+ * Fortran message table is in main
+ */
+struct msgtbl {
+       char    *mesg;
+       int     dummy;
+};
+extern struct msgtbl   act_fpe[];
+
+
+

 anyval *get_operand_address(), *addr_of_reg();
 char *opcode_name();
 \f
 anyval *get_operand_address(), *addr_of_reg();
 char *opcode_name();
 \f


@@ -102,12 +136,12 @@ trapov_(count, rtnval)
        int *count;
        double *rtnval;
 {
        int *count;
        double *rtnval;
 {

-#ifdef VAX
+#if    vax

        extern got_overflow(), got_illegal_instruction();
 
        extern got_overflow(), got_illegal_instruction();
 

-       signal(SIGFPE, got_overflow);
-       if (sigill_default == 0)
-               sigill_default = (int)signal(SIGILL, got_illegal_instruction);
+       sigfpe_default = signal(SIGFPE, got_overflow);
+       if (sigill_default == (SIG_VAL)-1)
+               sigill_default = signal(SIGILL, got_illegal_instruction);

        total_overflows = 0;
        max_messages = *count;
        retrn.v_double = *rtnval;
        total_overflows = 0;
        max_messages = *count;
        retrn.v_double = *rtnval;


@@ -128,14 +162,39 @@ trapov_(count, rtnval)
 got_overflow(signo, codeword, myaddr, pc, ps)
        char *myaddr, *pc;
 {
 got_overflow(signo, codeword, myaddr, pc, ps)
        char *myaddr, *pc;
 {

-       if (++total_overflows <= max_messages) {
-               fprintf(units[STDERR].ufd, "Overflow!\n");
-               if (total_overflows == max_messages) {
-                       fprintf(units[STDERR].ufd, "No more overflow messages will be printed.\n");
-               }
-       }
+       int     *sp, i;
+       FILE    *ef;
+

        signal(SIGFPE, got_overflow);
        signal(SIGFPE, got_overflow);

-#endif
+       ef = units[STDERR].ufd;
+       switch (codeword) {
+               case INT_OVF_T:
+               case INT_DIV_T:
+               case FLT_UND_T:
+               case DEC_OVF_T:
+               case SUB_RNG_T:
+               case FLT_OVF_F:
+               case FLT_DIV_F:
+               case FLT_UND_F:
+                               if (sigfpe_default > (SIG_VAL)7)
+                                       return((*sigfpe_default)(signo, codeword, myaddr, pc, ps));
+                               else
+                                       sigdie(signo, codeword, myaddr, pc, ps);
+                                       /* NOTREACHED */
+
+               case FLT_OVF_T:
+               case FLT_DIV_T:
+                               if (++total_overflows <= max_messages) {
+                                       fprintf(ef, "trapov: %s",
+                                               act_fpe[codeword-1].mesg);
+                                       if (total_overflows == max_messages)
+                                               fprintf(ef, ": No more messages will be printed.\n");
+                                       else
+                                               fputc('\n', ef);
+                               }
+                               return;
+       }
+#endif vax

 }
 
 int 
 }
 
 int 


@@ -144,7 +203,7 @@ ovcnt_()
        return total_overflows;
 }
 \f
        return total_overflows;
 }
 \f

-#ifdef VAX
+#if    vax

 /*
  *     got_illegal_instruction - handle "illegal instruction" signals.
  *
 /*
  *     got_illegal_instruction - handle "illegal instruction" signals.
  *


@@ -181,9 +240,12 @@ got_illegal_instruction(signo, codeword, myaddr, trap_pc, ps)
 
        opcode = fetch_byte() & 0xff;
        no_reserved = 0;
 
        opcode = fetch_byte() & 0xff;
        no_reserved = 0;

-       if (!is_floating_operation(opcode)) {
-               fprintf(units[STDERR].ufd, "illegal instruction: 0x%02\n", opcode);
-               force_abort();
+       if (codeword != RES_OPR_F || !is_floating_operation(opcode)) {
+               if (sigill_default > (SIG_VAL)7)
+                       return((*sigill_default)(signo, codeword, myaddr, trap_pc, ps));
+               else
+                       sigdie(signo, codeword, myaddr, trap_pc, ps);
+                       /* NOTREACHED */

        }
 
        if (opcode == POLYD || opcode == POLYF) {
        }
 
        if (opcode == POLYD || opcode == POLYF) {


@@ -553,7 +615,7 @@ fetch_long()
  */
 force_abort()
 {
  */
 force_abort()
 {

-       signal(SIGILL, sigill_default);
+       signal(SIGILL, SIG_DFL);

        abort();
 }
 
        abort();
 }
 


@@ -614,4 +676,4 @@ char *opcode_name(opcode)
                case TSTF:      return "TSTF";
        }
 }
                case TSTF:      return "TSTF";
        }
 }

-#endif
+#endif vax