/* hp2100_cpu4.c: HP 1000 FPP and SIS microcode simulator

   Copyright (c) 2006-2018, J. David Bryan

   Permission is hereby granted, free of charge, to any person obtaining a
   copy of this software and associated documentation files (the "Software"),
   to deal in the Software without restriction, including without limitation
   the rights to use, copy, modify, merge, publish, distribute, sublicense,
   and/or sell copies of the Software, and to permit persons to whom the
   Software is furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in
   all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
   THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
   IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
   CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

   Except as contained in this notice, the name of the author shall not be
   used in advertising or otherwise to promote the sale, use or other dealings
   in this Software without prior written authorization from the author.

   CPU4         Floating Point Processor and Scientific Instruction Set
                instructions

   28-Jul-18    JDB     Renamed hp2100_fp1.h to hp2100_cpu_fp.h
   07-Sep-17    JDB     Replaced "uint16" cast with "HP_WORD" for FPK assignment
   05-Aug-16    JDB     Renamed the P register from "PC" to "PR"
   24-Dec-14    JDB     Added casts for explicit downward conversions
   09-May-12    JDB     Separated assignments from conditional expressions
   06-Feb-12    JDB     Added OPSIZE casts to fp_accum calls in .FPWR/.TPWR
   11-Sep-08    JDB     Moved microcode function prototypes to hp2100_cpu1.h
   05-Sep-08    JDB     Removed option-present tests (now in UIG dispatchers)
   18-Mar-08    JDB     Fixed B register return bug in /CMRT
   01-Dec-06    JDB     Substitutes FPP for firmware FP if HAVE_INT64

   Primary references:
     - HP 1000 M/E/F-Series Computers Technical Reference Handbook
         (5955-0282, March 1980)
     - HP 1000 M/E/F-Series Computers Engineering and Reference Documentation
         (92851-90001, March 1981)
     - Macro/1000 Reference Manual
         (92059-90001, December 1992)

   Additional references are listed with the associated firmware
   implementations, as are the HP option model numbers pertaining to the
   applicable CPUs.
*/



#include "hp2100_defs.h"
#include "hp2100_cpu.h"
#include "hp2100_cpu_dmm.h"

#if defined (HAVE_INT64)                                /* int64 support available */

#include "hp2100_cpu_fp.h"


/* Floating-Point Processor.

   The 1000 F-Series replaces the six 2100/1000-M/E single-precision firmware
   floating-point instructions with a hardware floating-point processor (FPP).
   The FPP executes single-, extended-, and double-precision floating-point
   instructions, as well as double-integer instructions.  All of the
   floating-point instructions, as well as the single- and double-integer fix
   and float instructions, are handled here.  Pure double-integer instructions
   are dispatched to the double-integer handler for simulation.

   Option implementation by CPU was as follows:

      2114    2115    2116    2100   1000-M  1000-E  1000-F
     ------  ------  ------  ------  ------  ------  ------
      N/A     N/A     N/A     N/A     N/A     N/A     std

   For the F-Series, the instruction codes are mapped to routines as follows:

     Instr.  1000-F  Description
     ------  ------  -------------------------------------
     105000   FAD    Single real add
     105001  .XADD   Extended real add
     105002  .TADD   Double real add
     105003  [EAD]   [5-word add]
     105004  [tst]   [Floating Point Processor self test]
     105005  [xpd]   [Expand exponent]
     105006  [rst]   [Floating Point Processor reset]
     105007  [stk]   [Process stack of operands]
     105010  [chk]   [FPP addressing check]
     105014  .DAD    Double integer add
     105020   FSB    Single real subtract
     105021  .XSUB   Extended real subtract
     105022  .TSUB   Double real subtract
     105023  [ESB]   [5-word subtract]
     105034  .DSB    Double integer subtract
     105040   FMP    Single real multiply
     105041  .XMPY   Extended real multiply
     105042  .TMPY   Double real multiply
     105043  [EMP]   [5-word multiply]
     105054  .DMP    Double integer multiply
     105060   FDV    Single real divide
     105061  .XDIV   Extended real divide
     105062  .TDIV   Double real divide
     105063  [EDV]   [5-word divide]
     105074  .DDI    Double integer divide
     105100   FIX    Single real to integer fix
     105101  .XFXS   Extended real to integer fix (.DINT)
     105102  .TXFS   Double real to integer fix (.TINT)
     105103  [EFS]   [5-word FIXS]
     105104  .FIXD   Real to double integer fix
     105105  .XFXD   Extended real to double integer fix
     105106  .TFXD   Double real to double integer fix
     105107  [EFD]   [5-word FIXD]
     105114  .DSBR   Double integer subtraction (reversed)
     105120   FLT    Integer to single real float
     105121  .XFTS   Integer to extended real float (.IDBL)
     105122  .TFTS   Integer to double real float (.ITBL)
     105123  [ELS]   [5-word FLTS]
     105124  .FLTD   Double integer to real float
     105125  .XFTD   Double integer to extended real float
     105126  .TFTD   Double integer to double real float
     105127  [ELD]   [5-word FLTD]
     105134  .DDIR   Double integer divide (reversed)

   Implementation note: rather than have two simulators that each executes the
   single-precision FP instruction set, we compile conditionally, based on the
   availability of 64-bit integer support in the host compiler.  64-bit integers
   are required for the FPP, so if they are available, then we handle the
   single-precision instructions for the 2100 and M/E-Series here, and the
   firmware simulation is omitted.  If support is unavailable, then the firmware
   function is used instead.

   Notes:

     1. Single-precision arithmetic instructions (.FAD, etc.) and extended- and
        double-precision F-Series FPP arithmetic instructions (.XADD, .TADD,
        etc.) return positive infinity on both positive and negative overflow.
        The equivalent extended-precision M/E-Series FFP instructions return
        negative infinity on negative overflow and positive infinity on positive
        overflow.

     2. The items in brackets above are undocumented instructions that are used
        by the 12740 FPP-SIS-FFP diagnostic only.

     3. The five-word arithmetic instructions (e.g., 105003) use an expanded
        operand format that dedicates a separate word to the exponent.  See the
        implementation notes in the hardware floating-point processor simulation
        for details.

     4. The "self test" instruction (105004) returned to P+1 for early F-Series
        units without double-integer support.  Units incorporating such support
        returned to P+2.

     5. The "expand exponent" instruction (105005) is used as a "prefix"
        instruction to enable a 10-bit exponent range.  It is placed immediately
        before a 5-word arithmetic instruction sequence, e.g., immediately
        preceding an EAD instruction sequence.  The arithmetic instruction
        executes normally, except that under/overflow is not indicated unless
        the exponent exceeds the 10-bit range, instead of the normal 8-bit
        range.  If overflow is indicated, the exponent is still set to +128.

        Note that as 2-, 3-, and 4-word packed numbers only have room for 8-bit
        exponents, the Expand Exponent instruction serves no useful purpose in
        conjunction with instructions associated with these precisions.  If
        used, the resulting values may be in error, as overflow from the 8-bit
        exponents will not be indicated.

     6. The "FPP reset" instruction (105006) is provided to reset a hung box,
        e.g., in cases where an improper number of parameters is supplied.  The
        hardware resets its internal state machine in response to this
        instruction.  Under simulation, the instruction has no effect, as the
        simulated FPP cannot hang.

     7. The "process stack" instruction (105007) executes a series of FPP
        instruction sets in sequence.  Each set consists of a single FPP
        instruction and associated operands that specifies the operation,
        followed by a "result" instruction and operand.  The result instruction
        is optional and is only used to specify the result precision; the
        instruction itself is not executed.  If the result instruction is NOP,
        then the result precision is that of the executed FPP instruction.  If
        the result operand is null, then the result is kept in the internal FPP
        accumulator for later use.

        The calling sequence is as follows:

                  STK               Process stack instruction
                  DEF ERRTN         Address of error return
                  DEF SET1          Address of first instruction set
                  DEF SET2          Address of second instruction set
                   .
                   .
                   .
            ERRTN EQU *             Return here if execution in error
            OKRTN EQU *             Return here if execution OK

        Instruction sets are specified as follows (e.g.):

            SET1  .TADD             Operation instruction (NOP to terminate series)
                  DEC 4             Number of words in first operand (or 0 if accum)
                  DEF OP1           Address of first operand
                  DEC 4             Number of words in second operand (or 0 if accum)
                  DEF OP2           Address of second operand
                  .XADD             Result precision conversion instruction (or NOP)
                  DEC 3             Number of words to store (or 0 if no store)
                  DEF RSLT          Address of buffer to hold value

        The primary use of the "process stack" instruction is to enable chained
        operations employing the FPP accumulator for intermediate results and to
        enable expanded exponent usage across multiple instructions.

     8. The "addressing check" instruction sets bit 0 of the L register to 1,
        copies the X register value to the FPP, and then reads the FPP and
        stores the result in the Y register.  Setting the L register bit 0 to 1
        normally deselects the FPP, so that the value in Y is 177777.  However,
        the FPP box has a strap that inverts the selection logic, even though
        the box will not work with the base-set firmware if this is done.  The
        "addressing check" instruction is provided to test whether the strap is
        in the alternate location.  Under simulation, the return value is always
        177777, indicating that the strap is correctly set.

   Additional references:
    - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)
    - FPP-SIS-FFP Diagnostic Source (12740-18001, Rev. 1926)
*/

static const OP_PAT op_fpp[96] = {
  OP_RF,   OP_AXX,  OP_ATT,  OP_AEE,                    /*  FAD   .XADD  .TADD  .EADD */
  OP_N,    OP_C,    OP_N,    OP_A,                      /* [tst]  [xpd]  [rst]  [stk] */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* [chk]   ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* .DAD    ---    ---    ---  */
  OP_RF,   OP_AXX,  OP_ATT,  OP_AEE,                    /*  FSB   .XSUB  .TSUB  .ESUB */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* .DSB    ---    ---    ---  */
  OP_RF,   OP_AXX,  OP_ATT,  OP_AEE,                    /*  FMP   .XMPY  .TMPY  .EMPY */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* .DMP    ---    ---    ---  */
  OP_RF,   OP_AXX,  OP_ATT,  OP_AEE,                    /*  FDV   .XDIV  .TDIV  .EDIV */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* .DDI    ---    ---    ---  */
  OP_R,    OP_X,    OP_T,    OP_E,                      /*  FIX   .XFXS  .TFXS  .EFXS */
  OP_R,    OP_X,    OP_T,    OP_E,                      /* .FIXD  .XFXD  .TFXD  .EFXD */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N,                      /* .DSBR   ---    ---    ---  */
  OP_I,    OP_IA,   OP_IA,   OP_IA,                     /*  FLT   .XFTS  .TFTS  .EFTS */
  OP_J,    OP_JA,   OP_JA,   OP_JA,                     /* .FLTD  .XFTD  .TFTD  .EFTD */
  OP_N,    OP_N,    OP_N,    OP_N,                      /*  ---    ---    ---    ---  */
  OP_N,    OP_N,    OP_N,    OP_N                       /* .DDIR   ---    ---    ---  */
  };

t_stat cpu_fpp (HP_WORD IR)
{
OP fpop;
OPS op;
OPSIZE op1_prec, op2_prec, rslt_prec, cvt_prec;
HP_WORD rtn_addr, stk_ptr;
uint16 opcode;
uint32 entry;
t_stat reason = SCPE_OK;

if (cpu_configuration & CPU_1000_F)                     /* F-Series? */
    opcode = (uint16) (IR & 0377);                      /* yes, use full opcode */
else
    opcode = (uint16) (IR & 0160);                      /* no, use 6 SP FP opcodes */

entry = opcode & 0177;                                  /* map to <6:0> */

if (op_fpp [entry] != OP_N) {
    reason = cpu_ops (op_fpp [entry], op);              /* get instruction operands */

    if (reason != SCPE_OK)                              /* evaluation failed? */
        return reason;                                  /* return reason for failure */
    }

switch (entry) {                                        /* decode IR<6:0> */
    case 0000:                                          /* FAD 105000 (OP_RF) */
    case 0020:                                          /* FSB 105020 (OP_RF) */
    case 0040:                                          /* FMP 105040 (OP_RF) */
    case 0060:                                          /* FDV 105060 (OP_RF) */
        O = fp_exec (opcode, &fpop, op[0], op[1]);      /* execute operation */
        AR = fpop.fpk[0];                               /* return result to A/B */
        BR = fpop.fpk[1];
        break;

    case 0001:                                          /* .XADD 105001 (OP_AXX) */
    case 0002:                                          /* .TADD 105002 (OP_ATT) */
    case 0003:                                          /* .EADD 105003 (OP_AEE) */

    case 0021:                                          /* .XSUB 105021 (OP_AXX) */
    case 0022:                                          /* .TSUB 105022 (OP_ATT) */
    case 0023:                                          /* .ESUB 105023 (OP_AEE) */

    case 0041:                                          /* .XMPY 105041 (OP_AXX) */
    case 0042:                                          /* .TMPY 105042 (OP_ATT) */
    case 0043:                                          /* .EMPY 105043 (OP_AEE) */

    case 0061:                                          /* .XDIV 105061 (OP_AXX) */
    case 0062:                                          /* .TDIV 105062 (OP_ATT) */
    case 0063:                                          /* .EDIV 105063 (OP_AEE) */
        O = fp_exec (opcode, &fpop, op[1], op[2]);      /* execute operation */
        fp_prec (opcode, NULL, NULL, &rslt_prec);       /* determine result precision */
        WriteOp (op[0].word, fpop, rslt_prec);          /* write result */
        break;

    case 0004:                                          /* [tst] 105004 (OP_N) */
        XR = 3;                                         /* firmware revision */
        SR = 0102077;                                   /* test passed code */
        PR = (PR + 1) & LA_MASK;                        /* P+2 return for firmware w/DBI */
        break;

    case 0005:                                          /* [xpd] 105005 (OP_C) */
        return cpu_fpp (op[0].word | 0200);             /* set bit 7, execute instr */

    case 0006:                                          /* [rst] 105006 (OP_N) */
        break;                                          /* do nothing for FPP reset */

    case 0007:                                          /* [stk] 105007 (OP_A) */
        O = 0;                                          /* clear overflow */
        stk_ptr = PR;                                   /* save ptr to next buf */
        rtn_addr = op[0].word;                          /* save return address */

        while (TRUE) {
            PR = ReadW (stk_ptr) & LA_MASK;             /* point at next instruction set */
            stk_ptr = (stk_ptr + 1) & LA_MASK;

            reason = cpu_ops (OP_CCACACCA, op);         /* get instruction set */

            if (reason) {
                PR = err_PR;                            /* irq restarts */
                break;
                }

            if (op[0].word == 0) {                      /* opcode = NOP? */
                PR = (rtn_addr + 1) & LA_MASK;          /* bump to good return */
                break;                                  /* done */
                }

            fp_prec ((uint16) (op[0].word & 0377),      /* determine operand precisions */
                     &op1_prec, &op2_prec, &rslt_prec);

            if (TO_COUNT(op1_prec) != op[1].word) {     /* first operand precisions agree? */
                PR = rtn_addr;                          /* no, so take error return */
                break;
                }

            else if (op1_prec != fp_a)                  /* operand in accumulator? */
                op[1] = ReadOp (op[2].word, op1_prec);  /* no, so get operand 1 */

            if (TO_COUNT(op2_prec) != op[3].word) {     /* second operand precisions agree? */
                PR = rtn_addr;                          /* no, so take error return */
                break;
                }

            else if (op2_prec != fp_a)                  /* operand in accumulator? */
                op[2] = ReadOp (op[4].word, op2_prec);  /* no, so get operand 2 */

            O = O |                                     /* execute instruction */
                fp_exec ((uint16) (op[0].word & 0377),  /* and accumulate overflow */
                                  &fpop, op[1], op[2]);

            if (op[5].word) {                           /* precision conversion? */
                fp_prec ((uint16) (op[5].word & 0377),  /* determine conversion precision */
                         NULL, NULL, &cvt_prec);

                fpop = fp_accum (NULL, cvt_prec);       /* convert result */
                }
            else                                        /* no conversion specified */
                cvt_prec = rslt_prec;                   /* so use original precision */

            if (op[6].word)                             /* store result? */
                WriteOp (op[7].word, fpop, cvt_prec);   /* yes, so write it */
            }

        break;

    case 0010:                                          /* [chk] 105010 (OP_N) */
        YR = 0177777;                                   /* -1 if selection strap OK */
        break;

    case 0014:                                          /* .DAD 105014 (OP_N) */
        return cpu_dbi (0105321u);                      /* remap to double int handler */

    case 0034:                                          /* .DSB 105034 (OP_N) */
        return cpu_dbi (0105327u);                      /* remap to double int handler */

    case 0054:                                          /* .DMP 105054 (OP_N) */
        return cpu_dbi (0105322u);                      /* remap to double int handler */

    case 0074:                                          /* .DDI 105074 (OP_N) */
        return cpu_dbi (0105325u);                      /* remap to double int handler */

    case 0100:                                          /*  FIX  105100 (OP_R) */
    case 0101:                                          /* .XFXS 105101 (OP_X) */
    case 0102:                                          /* .TFXS 105102 (OP_T) */
    case 0103:                                          /* .EFXS 105103 (OP_E) */
        O = fp_exec (opcode, &fpop, op[0], NOP);        /* fix to integer */
        AR = fpop.fpk[0];                               /* save result */
        break;

    case 0104:                                          /* .FIXD 105104 (OP_R) */
    case 0105:                                          /* .XFXD 105105 (OP_X) */
    case 0106:                                          /* .TFXD 105106 (OP_T) */
    case 0107:                                          /* .EFXD 105107 (OP_E) */
        O = fp_exec (opcode, &fpop, op[0], NOP);        /* fix to integer */
        AR = UPPER_WORD (fpop.dword);                   /* save result */
        BR = LOWER_WORD (fpop.dword);                   /* in A and B */
        break;

    case 0114:                                          /* .DSBR 105114 (OP_N) */
        return cpu_dbi (0105334u);                      /* remap to double int handler */

    case 0120:                                          /*  FLT  105120 (OP_I) */
    case 0124:                                          /* .FLTD 105124 (OP_J) */
        O = fp_exec (opcode, &fpop, op[0], NOP);        /* float to single */
        AR = fpop.fpk[0];                               /* save result */
        BR = fpop.fpk[1];                               /* into A/B */
        break;

    case 0121:                                          /* .XFTS 105121 (OP_IA) */
    case 0122:                                          /* .TFTS 105122 (OP_IA) */
    case 0123:                                          /* .EFTS 105123 (OP_IA) */
    case 0125:                                          /* .XFTD 105125 (OP_JA) */
    case 0126:                                          /* .TFTD 105126 (OP_JA) */
    case 0127:                                          /* .EFTD 105127 (OP_JA) */
        O = fp_exec (opcode, &fpop, op[0], NOP);        /* float integer */
        fp_prec (opcode, NULL, NULL, &rslt_prec);       /* determine result precision */
        WriteOp (op[1].word, fpop, rslt_prec);          /* write result */
        break;

    case 0134:                                          /* .DDIR 105134 (OP_N) */
        return cpu_dbi (0105326u);                      /* remap to double int handler */

    default:                                            /* others unimplemented */
        reason = STOP (cpu_ss_unimpl);
        }

return reason;
}


/* Scientific Instruction Set.

   The SIS adds single-precision trigonometric and logarithmic, and
   double-precision polynomial evaluation instructions to the 1000-F instruction
   set.  The SIS is standard on the 1000-F.

   Option implementation by CPU was as follows:

      2114    2115    2116    2100   1000-M  1000-E  1000-F
     ------  ------  ------  ------  ------  ------  ------
      N/A     N/A     N/A     N/A     N/A     N/A     std

   The routines are mapped to instruction codes as follows:

     Instr.  1000-F  Description
     ------  ------  ----------------------------------------------
     TAN     105320  Tangent
     SQRT    105321  Square root
     ALOG    105322  Natural logarithm
     ATAN    105323  Arc tangent
     COS     105324  Cosine
     SIN     105325  Sine
     EXP     105326  E to the power X
     ALOGT   105327  Common logarithm
     TANH    105330  Hyperbolic tangent
     DPOLY   105331  Double-precision polynomial evaluation
     /CMRT   105332  Double-precision common range reduction
     /ATLG   105333  Compute (1-x)/(1+x) for .ATAN and .LOG
     .FPWR   105334  Single-precision exponentiation
     .TPWR   105335  Double-precision exponentiation
     [tst]   105337  [self test]

   The SIS simulation follows the F-Series SIS microcode, which, in turn,
   follows the algebraic approximations given in the Relocatable Library manual
   descriptions of the equivalent software routines.

   Notes:

     1. The word following the DPOLY instruction contains up to three flag bits
        to indicate one of several polynomial forms to evaluate.  The comments
        in the DPOLY software library routine source interchange the actions of
        the bit 14 and bit 0 flags.  The DPOLY description in the Technical
        Reference Handbook is correct.

     2. Several instructions (e.g., DPOLY) are documented as leaving undefined
        values in the A, B, X, Y, E, or O registers.  Simulation does not
        attempt to reproduce the same values as would be obtained with the
        hardware.

     3. The SIS uses the hardware FPP of the F-Series.  FPP malfunctions are
        detected by the SIS firmware and are indicated by a memory-protect
        violation and setting the overflow flag.  Under simulation,
        malfunctions cannot occur.

     4. We use OP_IIT for the .FPWR operand pattern.  The "II" is redundant, but
        it aligns the operands with the OP_IAT of .TPWR, so the code may be
        shared.

   Additional references:
    - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)
    - HP 1000 E-Series and F-Series Computer Microprogramming Reference Manual
      (02109-90004, Apr-1980).
*/


/* Common single-precision range reduction for SIN, COS, TAN, and EXP.

   This routine is called by the SIN, COS, TAN, and EXP handlers to reduce the
   range of the argument.  Reduction is performed in extended-precision.  We
   calculate:

     multiple = (nearest even integer to argument * multiplier)
     argument = argument * multiplier - multiple
*/

static uint32 reduce (OP *argument, int32 *multiple, OP multiplier)
{
OP product, count;
uint32 overflow;

fp_cvt (argument, fp_f, fp_x);                          /* convert to extended precision */
fp_exec (0041, &product, *argument, multiplier);        /* product = argument * multiplier */
overflow = fp_exec (0111, &count, NOP, NOP);            /* count = FIX (acc) */

if ((int16) count.word >= 0)                            /* nearest even integer */
    count.word = count.word + 1;
count.word = count.word & ~1;
*multiple = (int16) count.word;

if (overflow == 0) {                                    /* in range? */
    fp_exec (0121, ACCUM, count, NOP);                  /* acc = FLT (count) */
    overflow = fp_exec (0025, ACCUM, product, NOP);     /* acc = product - acc */
    *argument = fp_accum (NULL, fp_f);                  /* trim to single-precision */
    }
return overflow;
}


/* SIS dispatcher */

static const OP_PAT op_sis[16] = {
  OP_R,       OP_R,       OP_R,       OP_R,             /* TAN    SQRT   ALOG   ATAN  */
  OP_R,       OP_R,       OP_R,       OP_R,             /* COS    SIN    EXP    ALOGT */
  OP_R,       OP_CATAKK,  OP_AAT,     OP_A,             /* TANH   DPOLY  /CMRT  /ATLG */
  OP_IIF,     OP_IAT,     OP_N,       OP_N              /* .FPWR  .TPWR   ---   [tst] */
  };

t_stat cpu_sis (HP_WORD IR)
{
OPS op;
OP arg, coeff, pwr, product, count, result;
int16 f, p;
int32 multiple, power, exponent, rsltexp;
uint32 entry, i;
t_bool flag, sign;
t_stat reason = SCPE_OK;

static const OP tan_c4  = { { 0137763, 0051006 } };     /* DEC -4.0030956 */
static const OP tan_c3  = { { 0130007, 0051026 } };     /* DEC -1279.5424 */
static const OP tan_c2  = { { 0040564, 0012761 } };     /* DEC  0.0019974806 */
static const OP tan_c1  = { { 0045472, 0001375 } };     /* DEC  0.14692695 */

static const OP alog_c3 = { { 0065010, 0063002 } };     /* DEC  1.6567626301 */
static const OP alog_c2 = { { 0125606, 0044404 } };     /* DEC -2.6398577035 */
static const OP alog_c1 = { { 0051260, 0037402 } };     /* DEC  1.2920070987 */

static const OP atan_c4 = { { 0040257, 0154404 } };     /* DEC  2.0214656 */
static const OP atan_c3 = { { 0132062, 0133406 } };     /* DEC -4.7376165 */
static const OP atan_c2 = { { 0047407, 0173775 } };     /* DEC  0.154357652 */
static const OP atan_c1 = { { 0053447, 0014002 } };     /* DEC  1.3617611 */

static const OP sin_c4  = { { 0132233, 0040745 } };     /* DEC -0.000035950439 */
static const OP sin_c3  = { { 0050627, 0122361 } };     /* DEC  0.002490001 */
static const OP sin_c2  = { { 0126521, 0011373 } };     /* DEC -0.0807454325 */
static const OP sin_c1  = { { 0062207, 0166400 } };     /* DEC  0.78539816 */

static const OP cos_c4  = { { 0126072, 0002753 } };     /* DEC -0.00031957  */
static const OP cos_c3  = { { 0040355, 0007767 } };     /* DEC  0.015851077 */
static const OP cos_c2  = { { 0130413, 0011377 } };     /* DEC -0.30842483 */
static const OP cos_c1  = { { 0040000, 0000002 } };     /* DEC  1.0 */

static const OP sqrt_a2 = { { 0045612, 0067400 } };     /* DEC  0.5901621 */
static const OP sqrt_b2 = { { 0065324, 0126377 } };     /* DEC  0.4173076 */
static const OP sqrt_a1 = { { 0065324, 0126400 } };     /* DEC  0.8346152 */
static const OP sqrt_b1 = { { 0045612, 0067400 } };     /* DEC  0.5901621 */

static const OP exp_c2  = { { 0073000, 0070771 } };     /* DEC  0.05761803 */
static const OP exp_c1  = { { 0056125, 0041406 } };     /* DEC  5.7708162 */

static const OP tanh_c3 = { { 0050045, 0022004 } };     /* DEC  2.5045337 */
static const OP tanh_c2 = { { 0041347, 0101404 } };     /* DEC  2.0907609 */
static const OP tanh_c1 = { { 0052226, 0047375 } };     /* DEC  0.16520923 */

static const OP minus_1   = { { 0100000, 0000000 } };   /* DEC -1.0 */
static const OP plus_1    = { { 0040000, 0000002 } };   /* DEC +1.0 */
static const OP plus_half = { { 0040000, 0000000 } };   /* DEC +0.5 */
static const OP ln_2      = { { 0054271, 0006000 } };   /* DEC  0.6931471806 (ln 2.0) */
static const OP log_e     = { { 0067455, 0166377 } };   /* DEC  0.43429228 (log e) */
static const OP pi_over_4 = { { 0062207, 0166400 } };   /* Pi / 4.0 */
static const OP pi_over_2 = { { 0062207, 0166402 } };   /* Pi / 2.0 */

static const OP four_over_pi = { { 0050574, 0140667, 0023402 } };   /* 4.0 / Pi */
static const OP two_over_ln2 = { { 0056125, 0016624, 0127404 } };   /* 2.0 / ln(2.0) */

static const OP t_one  = { { 0040000, 0000000, 0000000, 0000002 } };   /* DEY 1.0 */


entry = IR & 017;                                       /* mask to entry point */

if (op_sis [entry] != OP_N) {
    reason = cpu_ops (op_sis [entry], op);              /* get instruction operands */

    if (reason != SCPE_OK)                              /* evaluation failed? */
        return reason;                                  /* return reason for failure */
    }

switch (entry) {                                        /* decode IR<3:0> */

    case 000:                                           /* TAN 105320 (OP_R) */
        O = reduce (&op[0], &multiple, four_over_pi);   /* reduce range */

        if (O) {                                        /* out of range? */
            op[0].fpk[0] = '0' << 8 | '9';              /* return '09' */
            op[0].fpk[1] = 'O' << 8 | 'R';              /* return 'OR' */
            break;                                      /* error return is P+1 */
            }

        fp_exec (0040, &op[1], op[0], op[0]);           /* op1 = arg ^ 2 */
        fp_exec (0010, ACCUM, NOP, tan_c4);             /* acc = acc + C4 */
        fp_exec (0064, ACCUM, tan_c3, NOP);             /* acc = C3 / acc */
        fp_exec (0010, ACCUM, NOP, op[1]);              /* acc = acc + op1 */
        fp_exec (0050, ACCUM, NOP, tan_c2);             /* acc = acc * C2 */
        fp_exec (0010, ACCUM, NOP, tan_c1);             /* acc = acc + C1 */
        fp_exec (0050, &op[0], NOP, op[0]);             /* res = acc * arg */

        if (multiple & 0002)                            /* multiple * 2 odd? */
            fp_exec (0064, &op[0], minus_1, NOP);       /* res = -1.0 / acc */

        PR = (PR + 1) & LA_MASK;                        /* normal return is P+2 */
        break;


    case 001:                                           /* SQRT 105321 (OP_R) */
        O = 0;                                          /* clear overflow */

        if (op[0].fpk[0] == 0) {                        /* arg = 0? */
            PR = (PR + 1) & LA_MASK;                    /* normal return is P+2 */
            break;
            }

        else if ((int16) op[0].fpk[0] < 0) {            /* sqrt of neg? */
            op[0].fpk[0] = '0' << 8 | '3';              /* return '03' */
            op[0].fpk[1] = 'U' << 8 | 'N';              /* return 'UN' */
            O = 1;                                      /* set overflow */
            break;                                      /* error return is P+1 */
            }

        fp_unpack (&op[1], &exponent, op[0], fp_f);     /* unpack argument */

        if (exponent & 1) {                             /* exponent odd? */
            fp_exec (0040, ACCUM, op[1], sqrt_a1);      /* acc = op1 * A1 */
            fp_exec (0010, &op[2], NOP, sqrt_b1);       /* op2 = acc + B1 */
            op[1].fpk[1] = op[1].fpk[1] + 2;            /* op1 = op1 * 2.0 */
            }
        else {                                          /* exponent even */
            fp_exec (0040, ACCUM, op[1], sqrt_a2);      /* acc = op1 * A2 */
            fp_exec (0010, &op[2], NOP, sqrt_b2);       /* op2 = acc + B2 */
            }

        fp_exec (0064, ACCUM, op[1], NOP);              /* acc = op1 / acc */
        fp_exec (0010, &op[2], NOP, op[2]);             /* op2 = acc + op2 */

        op[1].fpk[1] = op[1].fpk[1] + 4;                /* op1 = op1 * 4.0 */

        fp_exec (0064, ACCUM, op[1], NOP);              /* acc = op1 / acc */
        fp_exec (0010, &op[0], NOP, op[2]);             /* res = acc + op2 */

        power = (exponent >> 1) - 2;

        if (op[0].fpk[0]) {                             /* calc x * 2**n */
            fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */
            exponent = exponent + power;                /* multiply by 2**n */

            if ((exponent > 0177) ||                    /* exponent overflow? */
                (exponent < -0200)) {                   /* or underflow? */
                O = 1;                                  /* rtn unscaled val, set ovf */
                break;                                  /* error return is P+1 */
                }

            else
                fp_pack (&op[0], op[1], exponent, fp_f);/* repack result */
            }

        PR = (PR + 1) & LA_MASK;                        /* normal return is P+2 */
        break;


    case 002:                                           /* ALOG  105322 (OP_R) */
    case 007:                                           /* ALOGT 105327 (OP_R) */
        O = 0;                                          /* clear overflow */

        if ((int16) op[0].fpk[0] <= 0) {                /* log of neg or zero? */
            op[0].fpk[0] = '0' << 8 | '2';              /* return '02' */
            op[0].fpk[1] = 'U' << 8 | 'N';              /* return 'UN' */
            O = 1;                                      /* set overflow */
            break;                                      /* error return is P+1 */
            }

        fp_unpack (&op[1], &exponent, op[0], fp_f);     /* unpack argument */

        if (op[0].fpk[0] < 0055000) {                   /* out of range? */
            exponent = exponent - 1;                    /* drop exponent */
            op[1].fpk[1] = op[1].fpk[1] | 2;            /* set "exponent" to 1 */
            }

        op[2].fpk[0] = (HP_WORD) exponent;
        fp_exec (0120, &op[3], op[2], NOP);             /* op3 = FLT(exponent) */

        fp_exec (0020, &op[4], op[1], plus_1);          /* op4 = op1 - 1.0 */
        fp_exec (0000, ACCUM, op[1], plus_1);           /* acc = op1 + 1.0 */
        fp_exec (0064, &op[5], op[4], NOP);             /* op5 = op4 / acc */

        fp_exec (0054, ACCUM, NOP, NOP);                /* acc = acc * acc */
        fp_exec (0030, ACCUM, NOP, alog_c3);            /* acc = acc - c3 */
        fp_exec (0064, ACCUM, alog_c2, NOP);            /* acc = c2 / acc */
        fp_exec (0010, ACCUM, NOP, alog_c1);            /* acc = acc + c1 */
        fp_exec (0050, ACCUM, NOP, op[5]);              /* acc = acc * op5 */
        fp_exec (0010, ACCUM, NOP, op[3]);              /* acc = acc + op3 */
        fp_exec (0050, &op[0], NOP, ln_2);              /* res = acc * ln2 */

        if (entry == 007)                               /* ALOGT? */
            fp_exec (0050, &op[0], NOP, log_e);         /* res = acc * log(e) */

        PR = (PR + 1) & LA_MASK;                        /* normal return is P+2 */
        break;


    case 003:                                           /* ATAN  105323 (OP_R) */
        O = 0;                                          /* clear overflow */

        if (op[0].fpk[0] == 0)                          /* argument zero? */
            break;                                      /* result zero */

        flag = (op[0].fpk[1] & 1);                      /* get exponent sign */
        sign = ((int16) op[0].fpk[0] < 0);              /* get argument sign */

        if (flag == 0) {                                /* exp pos? (abs >= 0.5)? */
            if (sign)                                   /* argument negative? */
                fp_pcom (&op[0], fp_f);                 /* make positive */

            if (op[0].fpk[1] & 0374) {                  /* arg >= 2? */
                fp_exec(0060, &op[0], plus_1, op[0]);   /* arg = 1.0 / arg */
                op[2] = pi_over_2;                      /* constant = pi / 2.0 */
                }
            else {
                fp_exec (0020, &op[1], plus_1, op[0]);  /* op1 = 1.0 - arg */
                fp_exec (0000, ACCUM, plus_1, op[0]);   /* acc = 1.0 + arg */
                fp_exec (0064, &op[0], op[1], NOP);     /* arg = op1 / acc */
                op[2] = pi_over_4;                      /* constant = pi / 4.0 */
                }
            }

        fp_exec (0040, &op[1], op[0], op[0]);           /* op1 = arg * arg */
        fp_exec (0010, ACCUM, NOP, atan_c4);            /* acc = acc + C4 */
        fp_exec (0064, ACCUM, atan_c3, NOP);            /* acc = C3 / acc */
        fp_exec (0010, ACCUM, NOP, op[1]);              /* acc = acc + op1 */
        fp_exec (0050, ACCUM, NOP, atan_c2);            /* acc = acc * C2 */
        fp_exec (0010, ACCUM, NOP, atan_c1);            /* acc = acc + C1 */
        fp_exec (0064, &op[0], op[0], NOP);             /* res = arg / acc */

        if (flag == 0) {                                /* exp pos? (abs >= 0.5)? */
            fp_exec (0030, &op[0], NOP, op[2]);         /* res = acc - pi / n */

            if (sign == 0)                              /* argument positive? */
                fp_pcom (&op[0], fp_f);                 /* make negative */
            }

        break;


    case 004:                                           /* COS 105324 (OP_R) */
    case 005:                                           /* SIN 105325 (OP_R) */
        O = reduce (&op[0], &multiple, four_over_pi);   /* reduce range */

        if (O) {                                        /* out of range? */
            op[0].fpk[0] = '0' << 8 | '5';              /* return '05' */
            op[0].fpk[1] = 'O' << 8 | 'R';              /* return 'OR' */
            break;                                      /* error return is P+1 */
            }

        multiple = multiple / 2 + (entry == 004);       /* add one for cosine */
        flag = (multiple & 1);                          /* decide on series */

        fp_exec (0040, &op[1], op[0], op[0]);           /* op1 = arg ^ 2 */

        if (flag) {
            fp_exec (0050, ACCUM, NOP, cos_c4);         /* acc = acc * c4 */
            fp_exec (0010, ACCUM, NOP, cos_c3);         /* acc = acc + c3 */
            fp_exec (0050, ACCUM, NOP, op[1]);          /* acc = acc * op1 */
            fp_exec (0010, ACCUM, NOP, cos_c2);         /* acc = acc + c2 */
            fp_exec (0050, ACCUM, NOP, op[1]);          /* acc = acc * op1 */
            fp_exec (0010, &op[0], NOP, cos_c1);        /* res = acc + c1 */
            }

        else {
            fp_exec (0050, ACCUM, NOP, sin_c4);         /* acc = acc * c4 */
            fp_exec (0010, ACCUM, NOP, sin_c3);         /* acc = acc + c3 */
            fp_exec (0050, ACCUM, NOP, op[1]);          /* acc = acc * op1 */
            fp_exec (0010, ACCUM, NOP, sin_c2);         /* acc = acc + c2 */
            fp_exec (0050, ACCUM, NOP, op[1]);          /* acc = acc * op1 */
            fp_exec (0010, ACCUM, NOP, sin_c1);         /* acc = acc + c1 */
            fp_exec (0050, &op[0], NOP, op[0]);         /* res = acc * arg */
            }

        if (multiple & 0002)                            /* multiple * 2 odd? */
            fp_pcom (&op[0], fp_f);                     /* make negative */

        PR = (PR + 1) & LA_MASK;                        /* normal return is P+2 */
        break;


    case 006:                                           /* EXP 105326 (OP_R) */
        sign = ((int16) op[0].fpk[0] < 0);              /* get argument sign */

        O = reduce (&op[0], &multiple, two_over_ln2);   /* reduce range */
        multiple = multiple / 2;                        /* get true multiple */

        if ((sign == 0) && (O | (multiple > 128))) {    /* pos and ovf or out of range? */
            op[0].fpk[0] = '0' << 8 | '7';              /* return '07' */
            op[0].fpk[1] = 'O' << 8 | 'F';              /* return 'OF' */
            O = 1;                                      /* set overflow */
            break;                                      /* error return is P+1 */
            }

        else if (sign && (multiple < -128)) {           /* neg and out of range? */
            op[0].fpk[0] = 0;                           /* result is zero */
            op[0].fpk[1] = 0;
            O = 0;                                      /* clear for underflow */
            PR = (PR + 1) & LA_MASK;                    /* normal return is P+2 */
            break;
            }

        fp_exec (0040, ACCUM, op[0], op[0]);            /* acc = arg ^ 2 */
        fp_exec (0050, ACCUM, NOP, exp_c2);             /* acc = acc * c2 */
        fp_exec (0030, ACCUM, NOP, op[0]);              /* acc = acc - op0 */
        fp_exec (0010, ACCUM, NOP, exp_c1);             /* acc = acc + c1 */
        fp_exec (0064, ACCUM, op[0], NOP);              /* acc = op0 / acc */
        fp_exec (0010, &op[0], NOP, plus_half);         /* res = acc + 0.5 */

        power = multiple + 1;

        if (op[0].fpk[0]) {                             /* calc x * 2**n */
            fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */
            exponent = exponent + power;                /* multiply by 2**n */

            if ((exponent > 0177) ||                    /* exponent overflow? */
                (exponent < -0200)) {                   /* or underflow? */
                if (sign == 0) {                        /* arg positive? */
                    op[0].fpk[0] = '0' << 8 | '7';      /* return '07' */
                    op[0].fpk[1] = 'O' << 8 | 'F';      /* return 'OF' */
                    O = 1;                              /* set overflow */
                    }
                else {
                    op[0].fpk[0] = 0;                   /* result is zero */
                    op[0].fpk[1] = 0;
                    O = 0;                              /* clear for underflow */
                    }
                break;                                  /* error return is P+1 */
                }

            else {
                fp_pack (&op[0], op[1], exponent, fp_f);/* repack value */
                O = 0;
                }
            }

        PR = (PR + 1) & LA_MASK;                        /* normal return is P+2 */
        break;


    case 010:                                           /* TANH 105330 (OP_R) */
        O = 0;
        sign = ((int16) op[0].fpk[0] < 0);              /* get argument sign */

        if (op[0].fpk[1] & 1) {                         /* abs (arg) < 0.5? */
            fp_exec (0040, ACCUM, op[0], op[0]);        /* acc = arg ^ 2 */
            fp_exec (0010, ACCUM, NOP, tanh_c3);        /* acc = acc + c3 */
            fp_exec (0064, ACCUM, tanh_c2, NOP);        /* acc = c2 / acc */
            fp_exec (0010, ACCUM, NOP, tanh_c1);        /* acc = acc + c1 */
            fp_exec (0050, &op[0], NOP, op[0]);         /* res = acc * arg */
            }

        else if (op[0].fpk[1] & 0370)                   /* abs (arg) >= 8.0? */
            if (sign)                                   /* arg negative?  */
                op[0] = minus_1;                        /* result = -1.0 */
            else                                        /* arg positive */
                op[0] = plus_1;                         /* result = +1.0 */

        else {                                          /* 0.5 <= abs (arg) < 8.0 */
            BR = BR + 2;                                /* arg = arg * 2.0 */
            cpu_sis (0105326u);                         /* calc exp (arg) */
            PR = (PR - 1) & LA_MASK;                    /* correct P (always good rtn) */

            op[0].fpk[0] = AR;                          /* save value */
            op[0].fpk[1] = BR;

            fp_exec (0020, &op[1], op[0], plus_1);      /* op1 = op0 - 1.0 */
            fp_exec (0000, ACCUM, op[0], plus_1);       /* acc = op0 + 1.0 */
            fp_exec (0064, &op[0], op[1], NOP);         /* res = op1 / acc */
            }

        break;


    case 011:                                           /* DPOLY 105331 (OP_CATAKK) */
        O = 0;                                          /* clear overflow */
        AR = op[0].word;                                /* get flag word */

        if ((int16) AR >= 0) {                          /* flags present? */
            AR = 1;                                     /* no, so set default */
            arg = op[2];                                /* arg = X */
            }

        else                                            /* bit 15 set */
            fp_exec (0042, &arg, op[2], op[2]);         /* arg = X ^ 2 */

        coeff = ReadOp (op[3].word, fp_t);              /* get first coefficient */
        op[3].word = (op[3].word + 4) & LA_MASK;        /* point at next */
        fp_accum (&coeff, fp_t);                        /* acc = coeff */

        for (i = 0; i < op[4].word; i++) {              /* compute numerator */
            fp_exec (0052, ACCUM, NOP, arg);            /* acc = P[m] * arg */
            coeff = ReadOp (op[3].word, fp_t);          /* get next coefficient */
            op[3].word = (op[3].word + 4) & LA_MASK;    /* point at next */
            fp_exec (0012, ACCUM, NOP, coeff);          /* acc = acc + P[m-1] */
            }

        if (AR & 1)                                     /* bit 0 set? */
            op[6] = fp_accum (NULL, fp_t);              /* save numerator */
        else
            fp_exec (0046, &op[6], op[2], NOP);         /* acc = X * acc */


        if (op[5].word) {                               /* n > 0 ? */
            fp_accum (&t_one, fp_t);                    /* acc = 1.0 */

            for (i = 0; i < op[5].word; i++) {          /* compute denominator */
                fp_exec (0052, ACCUM, NOP, arg);        /* acc = P[m] * arg */
                coeff = ReadOp (op[3].word, fp_t);      /* get next coefficient */
                op[3].word = (op[3].word + 4) & LA_MASK;/* point at next */
                fp_exec (0012, ACCUM, NOP, coeff);      /* acc = acc + P[m-1] */
                }

            if (AR & 0040000)                           /* bit 14 set? */
                fp_exec (0032, ACCUM, NOP, op[6]);      /* acc = den - num */

            fp_exec (0066, &op[6], op[6], NOP);         /* op6 = num / den */
            }

        WriteOp (op[1].word, op[6], fp_t);              /* write result */

        if (O)                                          /* overflow? */
            op[0].fpk[0] = 0;                           /* microcode rtns with A = 0 */
        break;


    case 012:                                           /* /CMRT 105332 (OP_AAT) */
        O = 0;
        f = (int16) AR;                                 /* save flags */

        coeff = ReadOp (op[1].word, fp_t);              /* get coefficient (C) */

        fp_unpack (NULL, &exponent, op[2], fp_t);       /* unpack exponent */

        if ((f == -1) || (exponent < 4)) {              /* TANH or abs (arg) < 16.0? */

            /* result = x * c - n */

            fp_exec (0042, &product, op[2], coeff);     /* product = arg * C */
            O = fp_exec (0112, &count, NOP, NOP);       /* count = FIX (acc) */

            if ((int16) count.word >= 0)                /* nearest even integer */
                count.word = count.word + 1;
            BR = count.word = count.word & ~1;          /* save LSBs of N */

            O = O | fp_exec (0122, ACCUM, count, NOP);  /* acc = FLT (count) */

            if (O) {                                    /* out of range? */
                op[0].fpk[0] = 0;                       /* microcode rtns with A = 0 */
                break;                                  /* error return is P+1 */
                }

            fp_exec (0026, &result, product, NOP);      /* acc = product - acc */
            fp_unpack (NULL, &rsltexp, result, fp_t);   /* unpack exponent */

            /* determine if cancellation matters */

            if ((f < 0) || (f == 2) || (f == 6) ||      /* EXP, TANH, or COS? */
                (exponent - rsltexp < 5)) {             /* bits lost < 5? */
                WriteOp (op[0].word, result, fp_t);     /* write result */
                PR = (PR + 1) & LA_MASK;                /* P+2 return for good result */
                op[0].fpk[1] = BR;                      /* return LSBs of N in B */
                break;                                  /* all done! */
                }
            }

        /* result = (xu * cu - n) + (x - xu) * c + xu * cl */

        if (exponent >= (8 + 16 * (f >= 0))) {          /* exp >= 8 (EXP,TANH)? */
            op[0].fpk[0] = 0;                           /*  or 24 (SIN/COS/TAN)? */
            break;                                      /* range error return is P+1 */
            }

        op[3].fpk[0] = coeff.fpk[0];                    /* form upper bits of C (CU) */
        op[3].fpk[1] = coeff.fpk[1] & 0177770;
        op[3].fpk[2] = 0;
        op[3].fpk[3] = coeff.fpk[3] & 0000377;

        op[4].fpk[0] = op[2].fpk[0];                    /* form upper bits of X (XU) */
        op[4].fpk[1] = op[2].fpk[1] & 0177770;
        op[4].fpk[2] = 0;
        op[4].fpk[3] = op[2].fpk[3] & 0000377;

        fp_exec (0042, &op[5], op[3], op[4]);           /* op5 = cu * xu */

        fp_exec (0116, &op[6], NOP, NOP);               /* op6 = fix (acc) (2wd) */

        if ((int32) op[6].dword >= 0)                   /* nearest even integer */
            op[6].dword = op[6].dword + 1;
        op[6].dword = op[6].dword & ~1;
        BR = LOWER_WORD (op[6].dword);                  /* save LSBs of N */

        O = fp_exec (0126, ACCUM, op[6], NOP);          /* acc = flt (op6) */

        if (O) {                                        /* overflow? */
            op[0].fpk[0] = 0;                           /* microcode rtns with A = 0 */
            break;                                      /* range error return is P+1 */
            }

        fp_exec (0026, &op[7], op[5], NOP);             /* op7 = cu * xu - n */

        fp_exec (0022, ACCUM, op[2], op[4]);            /* acc = x - xu */
        fp_exec (0052, ACCUM, NOP, coeff);              /* acc = (x - xu) * c */
        fp_exec (0012, &op[5], NOP, op[7]);             /* op5 = acc + (cu * xu - n) */

        op[1].word = (op[1].word + 4) & LA_MASK;        /* point at second coefficient */
        coeff = ReadOp (op[1].word, fp_t);              /* get coefficient (CL) */

        fp_exec (0042, ACCUM, op[4], coeff);            /* acc = xu * cl */
        fp_exec (0012, &result, NOP, op[5]);            /* result = acc + (x - xu) * c + (cu * xu - n) */

        WriteOp (op[0].word, result, fp_t);             /* write result */
        PR = (PR + 1) & LA_MASK;                        /* P+2 return for good result */
        op[0].fpk[1] = BR;                              /* return LSBs of N in B */
        break;


    case 013:                                           /* /ATLG 105333 (OP_A) */
        arg = ReadOp (op[0].word, fp_t);                /* get argument */

        fp_exec (0022, &op[1], t_one, arg);             /* op1 = 1.0 - arg */
        fp_exec (0002, ACCUM, t_one, arg);              /* acc = 1.0 + arg */
        fp_exec (0066, &op[1], op[1], NOP);             /* res = op1 / acc */

        WriteOp (op[0].word, op[1], fp_t);              /* write result */
        break;


    case 014:                                           /* .FPWR 105334 (OP_IIF) */
        p = 0;                                          /* set to single-precision */
        goto NPWR;

    case 015:                                           /* .TPWR 105335 (OP_IAT) */
        p = 2;                                          /* set to double-precision */

    NPWR:
        if (op[2].fpk[0]) {                             /* non-zero base? */
            fp_exec (0120, &pwr, op[0], NOP);           /* float power */

            sign = ((int16) pwr.fpk[0] < 0);            /* save sign of power */
            i = (pwr.fpk[0] << 2) & D16_MASK;           /* clear it */

            fp_unpack (NULL, &exponent, pwr, fp_f);     /* unpack exponent */

            if (sign == 0)
                exponent = exponent - 1;

            O = 0;                                      /* clear overflow */
            fp_accum (&op[2], (OPSIZE) (fp_f + p));     /* acc = arg */

            while (exponent-- > 0) {
                O = O | fp_exec ((uint16) (0054 | p),   /* square acc */
                                 ACCUM, NOP, NOP);

                if (i & D16_SIGN)
                    O = O | fp_exec ((uint16) (0050 | p),   /* acc = acc * arg */
                                     ACCUM, NOP, op[2]);
                i = i << 1;
                }

            op[2] = fp_accum (NULL, (OPSIZE) (fp_f + p));   /* get accum */

            if (op[2].fpk[0] == 0)                      /* result zero? */
                O = 1;                                  /* underflow */
            }

        if (entry == 014)                               /* .FPWR ? */
            op[0] = op[2];                              /* copy result */
        else                                            /* .TPWR */
            WriteOp (op[1].word, op[2], fp_t);          /* write result */

        break;


    case 017:                                           /* [tst] 105337 (OP_N) */
        XR = 4;                                         /* firmware revision */
        SR = 0102077;                                   /* test passed code */
        PR = (PR + 1) & LA_MASK;                        /* P+2 return for firmware w/DPOLY */
        return reason;


    default:                                            /* others unimplemented */
        return STOP (cpu_ss_unimpl);
        }

AR = op[0].fpk[0];                                      /* save result */
BR = op[0].fpk[1];                                      /* into A/B */
return reason;
}

#endif                                                  /* end of int64 support */
