char id_trapov[] = "@(#)trapov_.c 1.1";
* Fortran/C floating-point overflow handler
* The idea of these routines is to catch floating-point overflows
* and print an eror message. When we then get a reserved operand
* exception, we then fix up the value to the highest possible
* causes overflows to be trapped, with the first 'n'
* overflows getting an "Overflow!" message printed.
* causes 'k' to get the number of overflows since the
* Gary Klimowicz, April 17, 1981
* Integerated with libF77: David Wasley, UCB, July 1981.
# include "../libI77/fiodefs.h"
# define AUTO_INC_DEF 0x9
# define BYTE_DISP_DEF 0xb
# define WORD_DISP_DEF 0xd
# define LONG_DISP_DEF 0xf
* Potential operand values
typedef union operand_types
{
* GLOBAL VARIABLES (we need a few)
* Actual program counter and locations of registers.
static int total_overflows
;
static int sigill_default
= 0;
* the fortran unit control table
anyval
*get_operand_address(), *addr_of_reg();
* This routine sets up the signal handler for the floating-point
* and reserved operand interrupts.
extern got_overflow(), got_illegal_instruction();
signal(SIGFPE
, got_overflow
);
sigill_default
= (int)signal(SIGILL
, got_illegal_instruction
);
retrn
.v_double
= *rtnval
;
* got_overflow - routine called when overflow occurs
* This routine just prints a message about the overflow.
* It is impossible to find the bad result at this point.
* Instead, we wait until we get the reserved operand exception
* when we try to use it. This raises the SIGILL signal.
got_overflow(signo
, codeword
, myaddr
, pc
, ps
)
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");
signal(SIGFPE
, got_overflow
);
* got_illegal_instruction - handle "illegal instruction" signals.
* This really deals only with reserved operand exceptions.
* Since there is no way to check this directly, we look at the
* opcode of the instruction we are executing to see if it is a
* floating-point operation (with floating-point operands, not
* This is complicated by the fact that the registers that will
* eventually be restored are saved in two places. registers 7-11
* are saved by this routine, and are in its call frame. (we have
* to take special care that these registers are specified in
* the procedure entry mask here.)
* Registers 0-6 are saved at interrupt time, and are at a offset
* -8 from the 'signo' parameter below.
* There is ane extremely inimate connection between the value of
* the entry mask set by the 'makefile' script, and the constants
* used in the register offset calculations below.
* Can someone think of a better way to do this?
got_illegal_instruction(signo
, codeword
, myaddr
, trap_pc
, ps
)
int first_local
[1]; /* must be first */
int i
, opcode
, type
, o_no
, no_reserved
;
regs7t11
= &first_local
[0];
opcode
= fetch_byte() & 0xff;
if (!is_floating_operation(opcode
)) {
fprintf(units
[STDERR
].ufd
, "illegal instruction: 0x%02\n", opcode
);
if (opcode
== POLYD
|| opcode
== POLYF
) {
got_illegal_poly(opcode
);
if (opcode
== EMODD
|| opcode
== EMODF
) {
got_illegal_emod(opcode
);
* This opcode wasn't "unusual".
* Look at the operands to try and find a reserved operand.
for (o_no
= 1; o_no
<= no_operands(opcode
); ++o_no
) {
type
= operand_type(opcode
, o_no
);
if (type
!= F
&& type
!= D
) {
/* F or D operand. Check it out */
opnd
= get_operand_address(type
);
fprintf(units
[STDERR
].ufd
, "Can't get operand address: 0x%x, %d\n",
if (type
== F
&& opnd
->o_long
== 0x00008000) {
opnd
->o_long
= retrn
.v_long
[0];
} else if (type
== D
&& opnd
->o_long
== 0x00008000) {
/* found one here, too! */
opnd
->o_quad
[0] = retrn
.v_long
[0];
if (opnd
== addr_of_reg(6)) opnd
= addr_of_reg(7);
else opnd
= (anyval
*) ((char *) opnd
+ 4);
opnd
->o_quad
[0] = retrn
.v_long
[1];
fprintf(units
[STDERR
].ufd
, "Can't find any reserved operand!\n");
* is_floating_exception - was the operation code for a floating instruction?
is_floating_operation(opcode
)
case ACBD
: case ACBF
: case ADDD2
: case ADDD3
:
case ADDF2
: case ADDF3
: case CMPD
: case CMPF
:
case CVTDB
: case CVTDF
: case CVTDL
: case CVTDW
:
case CVTFB
: case CVTFD
: case CVTFL
: case CVTFW
:
case CVTRDL
: case CVTRFL
: case DIVD2
: case DIVD3
:
case DIVF2
: case DIVF3
: case EMODD
: case EMODF
:
case MNEGD
: case MNEGF
: case MOVD
: case MOVF
:
case MULD2
: case MULD3
: case MULF2
: case MULF3
:
case POLYD
: case POLYF
: case SUBD2
: case SUBD3
:
case SUBF2
: case SUBF3
: case TSTD
: case TSTF
:
* got_illegal_poly - handle an illegal POLY[DF] instruction.
* We don't do anything here yet.
fprintf(units
[STDERR
].ufd
, "Can't do 'poly' instructions yet\n");
* got_illegal_emod - handle illegal EMOD[DF] instruction.
* We don't do anything here yet.
fprintf(units
[STDERR
].ufd
, "Can't do 'emod' instructions yet\n");
* no_operands - determine the number of operands in this instruction.
* operand_type - is the operand a D or an F?
* We are only descriminating between Floats and Doubles here.
* Other operands may be possible on exotic instructions.
if (opcode
>= 0x40 && opcode
<= 0x56) return F
;
if (opcode
>= 0x60 && opcode
<= 0x76) return D
;
* advance_pc - Advance the program counter past an operand.
* We just bump the pc by the appropriate values.
mode
= (mode
>> 4) & 0xf;
if (type
== F
) (void) fetch_long();
fprintf(units
[STDERR
].ufd
, "Bad type %d in advance\n",
if (reg
== PC
) (void) fetch_long();
fprintf(units
[STDERR
].ufd
, "Bad mode 0x%x in op_length()\n", mode
);
get_operand_address(type
)
register int mode
, reg
, base
;
mode
= fetch_byte() & 0xff;
mode
= (mode
>> 4) & 0xf;
base
= (int) get_operand_address(type
);
if (base
== NULL
) return NULL
;
base
+= contents_of_reg(reg
)*type_length(type
);
return (anyval
*) contents_of_reg(reg
);
return (anyval
*) (contents_of_reg(reg
)
return (anyval
*) contents_of_reg(reg
);
return (anyval
*) * (long *) contents_of_reg(reg
);
base
+= contents_of_reg(reg
);
base
+= contents_of_reg(reg
);
return (anyval
*) * (long *) base
;
base
+= contents_of_reg(reg
);
base
+= contents_of_reg(reg
);
return (anyval
*) * (long *) base
;
base
+= contents_of_reg(reg
);
base
+= contents_of_reg(reg
);
return (anyval
*) * (long *) base
;
fprintf(units
[STDERR
].ufd
, "Bad mode 0x%x in get_addr()\n", mode
);
if (reg
== PC
) value
= (int) pc
;
else if (reg
== SP
) value
= (int) ®s0t6
[6];
else if (reg
== FP
) value
= regs0t6
[-2];
else if (reg
== AP
) value
= regs0t6
[-3];
else if (reg
>= 0 && reg
<= 6) value
= regs0t6
[reg
];
else if (reg
>= 7 && reg
<= 11) value
= regs7t11
[reg
];
fprintf(units
[STDERR
].ufd
, "Bad register 0x%x to contents_of()\n", reg
);
if (reg
>= 0 && reg
<= 6) {
return (anyval
*) ®s0t6
[reg
];
if (reg
>= 7 && reg
<= 11) {
return (anyval
*) ®s7t11
[reg
];
fprintf(units
[STDERR
].ufd
, "Bad reg 0x%x to addr_of()\n", reg
);
* fetch_{byte, word, long} - extract values from the PROGRAM area.
* These routines are used in the operand decoding to extract various
* fields from where the program counter points. This is because the
* addressing on the Vax is dynamic: the program counter advances
* while we are grabbing operands, as well as when we pass instructions.
* This makes things a bit messy, but I can't help it.
* force_abort - force us to abort.
* We have to change the signal handler for illegal instructions back,
* or we'll end up calling 'got_illegal_instruction()' again when
* abort() does it's dirty work.
signal(SIGILL
, sigill_default
);
fprintf(units
[STDERR
].ufd
, "Bad type 0x%x in type_length()\n", type
);
char *opcode_name(opcode
)
case ACBD
: return "ACBD";
case ACBF
: return "ACBF";
case ADDD2
: return "ADDD2";
case ADDD3
: return "ADDD3";
case ADDF2
: return "ADDF2";
case ADDF3
: return "ADDF3";
case CMPD
: return "CMPD";
case CMPF
: return "CMPF";
case CVTDB
: return "CVTDB";
case CVTDF
: return "CVTDF";
case CVTDL
: return "CVTDL";
case CVTDW
: return "CVTDW";
case CVTFB
: return "CVTFB";
case CVTFD
: return "CVTFD";
case CVTFL
: return "CVTFL";
case CVTFW
: return "CVTFW";
case CVTRDL
: return "CVTRDL";
case CVTRFL
: return "CVTRFL";
case DIVD2
: return "DIVD2";
case DIVD3
: return "DIVD3";
case DIVF2
: return "DIVF2";
case DIVF3
: return "DIVF3";
case EMODD
: return "EMODD";
case EMODF
: return "EMODF";
case MNEGD
: return "MNEGD";
case MNEGF
: return "MNEGF";
case MOVD
: return "MOVD";
case MOVF
: return "MOVF";
case MULD2
: return "MULD2";
case MULD3
: return "MULD3";
case MULF2
: return "MULF2";
case MULF3
: return "MULF3";
case POLYD
: return "POLYD";
case POLYF
: return "POLYF";
case SUBD2
: return "SUBD2";
case SUBD3
: return "SUBD3";
case SUBF2
: return "SUBF2";
case SUBF3
: return "SUBF3";
case TSTD
: return "TSTD";
case TSTF
: return "TSTF";