/**
 * -- IEEE Floating-Point word set, Part II (EXPERIMENTAL)
 *
 * Copyright (C) 2005, 2009, 2010, 2020, 2021 David N. Williams
 *
 * @see LGPL 
 * @author David N. Williams              (modified by $Author: dnw $)
 * @version %Revision: 0.6.2%
 *   (modified $Date: 2021-01-03 08:19:00 $)
 *
 * @description
 *   This experimental pfe loadable module was formerly part of
 *   ieeefp-ext.c, which implemented much of the proposed IEEE-FP
 *   Floating-Point word set, and is now split into two parts.
 *   
 *   Part I deals with words that operate on the floating-point stack,
 *   and has been merged into floating-ext.c.
 *   
 *   This module, Part II, implements words that deal with fpu
 *   control/status register access and bindings to C99 functions for
 *   floating-point environment, exceptions, and rounding modes.
 *   
 *   It does not automatically load floating-ext.c, because it is
 *   intended to work with any fp stack implemented for C99 compatible
 *   floating-point data types:  float, double, extended double, and
 *   __float128 (libquadmath).
 *   
 *   This module is intended to be POSIX compliant.  It is known to work
 *   on 32-bit Mac OS X ppc/intel Leopard and GNU/Linux systems, and
 *   64-bit macOS Big Sur and Linux Mint 19 systems.
 */

#define _P4_SOURCE 1
#include <pfe/pfe-base.h>
#include <pfe/incl-sup.h>  /* for BITSOF in pfe-0.33.58 */

#ifdef __linux__
  #define __USE_ISOC99  1
#endif
#include <float.h>
#include <math.h>

// This is needed in the alternate exception handling section.
#ifdef __linux__
/* BEGIN quote
http://graphviz.sourcearchive.com/documentation/2.16/gvrender__pango_8c-source.html
*/
/* _GNU_SOURCE is needed (supposedly) for the feenableexcept
 * prototype to be defined in fenv.h on GNU systems.
 * Presumably it will do no harm on other systems.
 */
#ifndef _GNU_SOURCE
#define _GNU_SOURCE
#endif

/* We are not supposed to need __USE_GNU, but I can't see
 * how to get the prototype for fedisableexcept from
 * /usr/include/fenv.h without it.
 */
#ifndef __USE_GNU
#define __USE_GNU
#endif
/* END quote */
#endif // __linux__
#include <fenv.h>

#if 0
#if __STDC_VERSION__+0 > 199900L
#pragma STDC FENV_ACCESS ON  /* ignored by gcc */
#pragma GCC FENV_ACCESS ON   /* also ignored */
#endif
#endif

// #include <pfe/double-sub.h>  /* p4_d_negate() */
#include <pfe/def-words.h>   /* for synonyms */
#include <pfe/logging.h>     /* P4_fatal () */

#include "fpaux-ext.h"

#define CELLBITS   BITSOF (p4cell)

#define DEFINED_PPC      (defined(__ppc__) || defined(__ppc64__))
#define DEFINED_INTEL    (defined(__i386__) || defined(__x86_64__))

/* The following is used for ppc FPSCR access and for fp
 * constants. For the constants it's a kludge -- couldn't get
 * unsigned long long int to work in the analogous union.
 */
#ifdef ABI_32
    typedef union {
        struct {
        #if DEFINED_PPC
            unsigned long hi;
            unsigned long lo;
        #elif DEFINED_INTEL
            unsigned long lo;
            unsigned long hi;
        #else
            #error Can be compiled only for a ppc or intel cpu.
        #endif
    } i; double d;
} hexdouble;
#elif defined ABI_64
    typedef union {
        p4cell i;
        double d;
    } hexdouble;
#else
    #error Can be compiled only with ABI_32  or ABI_64.
#endif

/****************************************************************/
/* IEEE special constants                                       */
/****************************************************************/

#if 0
FCode (p4_plus_inf)
{
 hexdouble t;
#ifdef ABI_32
  t.i.hi = 0x7FF00000;
  t.i.lo = 0;
#else
  t.i = 0x7FF0000000000000;
#endif
  *--FP = t.d;
}

FCode (p4_minus_inf)
{
  hexdouble t;
#ifdef ABI_32
  t.i.hi = 0xFFF00000;
  t.i.lo = 0;
#else
  t.i = 0xFFF0000000000000;
#endif
  *--FP = t.d;
}

FCode (p4_plus_nan)
{
  hexdouble t; 
#ifdef ABI_32
  t.i.hi = 0x7FF80000;
  t.i.lo = 0;
#else
  t.i = 0x7FF8000000000000;
#endif
  *--FP = t.d;
}

FCode (p4_minus_nan)
{
  hexdouble t; 
#ifdef ABI_32
  t.i.hi = 0xFFF80000;
  t.i.lo = 0;
#else
  t.i = 0xFFF8000000000000;
#endif
  *--FP = t.d;
}
#endif

/****************************************************************/
/* floating-point environment                                   */
/****************************************************************/

/* These words implement Forth bindings for the C99 functions
 * fegetenv(), fesetenv(), feholdexcept(), and feupdateenv(). In
 * the stack effects, "fenvp" indicates the address of an
 * implementation-defined, opaque structure for control mode and
 * exception bit data for the floating-point state,
 * corresponding to C99 fenv_t.  For example, in Mac OS X
 * Leopard ppc, it is just an unsigned int that holds a copy of
 * the FPSCR register (floating-point status and control), but
 * for Leopard intel it holds copies of the x87 fpu status and
 * control registers, as well as the SSE status and control
 * register, MXCSR.  GNU/Linux is similar to OS X intel, but
 * more opaque.
 */

/* Align BSD? with C99 */
#if !defined FE_DEFL_ENV &&  defined FE_DFL_ENV
#define FE_DEFL_ENV   FE_DFL_ENV
#endif

/** /FENV  ( -- fenv_t.size )
 */

/** FE-DFL-ENV  ( -- default.fenvp)
 */

/** FEGETENV  ( fenvp --  )
 * Store current floating-point environment at fenvp.
 */
FCode (p4_fegetenv)
{ fegetenv ( (fenv_t*) *SP++ ); }

/** FESETENV  ( fenvp -- )
 * Set the floating-point environment to that pointed to by
 * fenvp.
 */
FCode (p4_fesetenv)
{ fesetenv ( (fenv_t*) SP++ ); }

/** FEHOLDEXCEPT  ( -- fenvp )
 * Leave the current floating-point environment pointer for
 * later restoration, and install an environment that turns off
 * floating-point exceptions.
 */
FCode (p4_feholdexcept)
{ feholdexcept ( (fenv_t*) --SP ); }

/** FEUPDATEENV  ( fenvp -- )
 * Set the floating-point environment to that pointed to by
 * fenvp, and raise the exceptions that were up just before the
 * call.
 */
FCode (p4_feupdateenv)
{ feupdateenv ( (fenv_t*) SP++ ); }

/****************************************************************/
/* floating-point exception flags                               */
/****************************************************************/

/* In the following stack effects, excepts stands for the
 * bitwise OR of a subset of the fp exception flag constants
 * FDIVBYZERO, FINEXACT, FINVALID, FOVERFLOW, and
 * FUNDERFLOW, with FALL-EXCEPT the OR of all five.
 *
 * POSIX returns for errors are assumed.
 */

/** GET-FFLAGS  ( excepts -- flags )
 * The flags output is the bitwise OR of the fp exception
 * constants corresponding to those flags that are both on in
 * the current fp state and present in excepts.
 */
FCode (p4_get_fflags)
{ *SP = fetestexcept (*SP & FE_ALL_EXCEPT); }

/** SET-FFLAGS  ( excepts -- )
 * Turn on the fp exception status flags corresponding to the fp
 * exceptions present in excepts.
 */
FCode (p4_set_fflags)
// { feraiseexcept (*SP++); }
{
  if ( feraiseexcept (*SP++ & FE_ALL_EXCEPT) )
      P4_fatal ("Cannot get raise fp flags!");
}

/** CLEAR-FFLAGS ( excepts -- )
 * Clear the fp exception status flags corresponding to the fp
 * exceptions present in excepts.
 */
FCode (p4_clear_fflags)
//{ feclearexcept (*SP++); }
{
  unsigned int excepts = *SP++ & FE_ALL_EXCEPT;

  if ( !excepts ) return ;
  if ( feclearexcept (excepts) )
      P4_fatal ("Cannot get clear fp flags!");
}

/****************************************************************/
/* floating-point rounding modes                                */
/****************************************************************/

/* The Forth constants FR-DOWNWARD, FR-UPWARD, FR-TONEAREST,
 * FR-TOWARDZERO, corresponding to C99 rounding mode values with "FE_"
 * instead of "FR-" in their names, are defined under P4_LISTWORDS. 
 * They represent the legal rounding modes.
 *
 * The approach taken in the IEEE-FP proposal is likely to be different.
 * These words just bind the C99 functions to Forth.
 */

/** GET-FROUND  ( -- round )
 * Leave the current rounding mode value.
 */
FCode (p4_get_fround)
{
  if ( (*--SP = fegetround ()) < 0 )
     P4_fatal ("Cannot get fp rounding direction!");
}

/** SET-FROUND  ( round --  )
 * Set the current rounding mode to round.
 */
FCode (p4_set_fround)
{
  if ( (fesetround (*SP++)) < 0 )
      P4_fatal ("Cannot set fp rounding direction!");
}

/****************************************************************/
/* alternate floating-point exception handling                  */
/****************************************************************/

/*** GNU/Linux fp environment extensions  ***/ 

#ifndef __linux__
#if DEFINED_PPC

#define FE_EXCEPT_SHIFT 22  // shift flags right to get enabling masks
#define FM_ALL_EXCEPT    FE_ALL_EXCEPT >> FE_EXCEPT_SHIFT 

/* GNU C Library:
http://www.gnu.org/software/libc/manual/html_node/Control-Functions.html

     - Function: int fegetexcept (int excepts)

       The function returns a bitmask of all currently enabled
       exceptions.  It returns -1 in case of failure.
   
   The excepts argument appears in other functions in fenv.h,
   and corresponds to the FE_xxx exception flag constants.  It
   is unclear whether the bitmask is for the flags or the masks.
   We return that for the flags, which corresponds to the
   excepts argument in feenableexcept(excepts) and
   fedisableexcept(excepts).  In GNU/Linux the argument is void,
   and that's what we implement.  Linux "man fegetenv" appears
   to suggest that it's the mask corresponding to bits in
   excepts that is returned.
*/
static int
fegetexcept (void)
{
  static fenv_t fenv;

  return ( fegetenv (&fenv) ? -1 :
    (
      ( fenv & (FM_ALL_EXCEPT) ) << FE_EXCEPT_SHIFT )
    );
}

static int
feenableexcept (unsigned int excepts)
{
  static fenv_t fenv;
  unsigned int new_excepts = (excepts & FE_ALL_EXCEPT) >> FE_EXCEPT_SHIFT,
               old_excepts;  // all previous masks

  // The flags are cleared so a handler doesn't kick in.
  if ( feclearexcept (excepts & FE_ALL_EXCEPT)
         || fegetenv (&fenv) ) return -1;
  old_excepts = (fenv & FM_ALL_EXCEPT) << FE_EXCEPT_SHIFT;

  fenv = (fenv & ~new_excepts) | new_excepts;
  return ( fesetenv (&fenv) ? -1 : old_excepts );
}

static int
fedisableexcept (unsigned int excepts)
{
  static fenv_t fenv;
  unsigned int still_on = ~( (excepts & FE_ALL_EXCEPT) >> FE_EXCEPT_SHIFT ),
               old_excepts;  // previous masks

  if ( fegetenv (&fenv) ) return -1;
  old_excepts = (fenv & FM_ALL_EXCEPT) << FE_EXCEPT_SHIFT;

  fenv &= still_on;
  return ( fesetenv (&fenv) ? -1 : old_excepts );
}

#elif DEFINED_INTEL

static int
fegetexcept (void)
{
  static fenv_t fenv;

  return fegetenv (&fenv) ? -1 : ( (~fenv.__control) & FE_ALL_EXCEPT );
}

static int
feenableexcept (unsigned int excepts)
{
  static fenv_t fenv;
  unsigned int new_excepts = excepts & FE_ALL_EXCEPT,
               old_excepts;  // previous masks

  // The flags are cleared so a handler doesn't kick in.
  if ( feclearexcept (new_excepts) | fegetenv (&fenv) ) return -1;
  old_excepts = fenv.__control & FE_ALL_EXCEPT;

  // unmask
  fenv.__control &= ~new_excepts;
  fenv.__mxcsr   &= ~(new_excepts << 7);

  return ( fesetenv (&fenv) ? -1 : old_excepts );
}

static int
fedisableexcept (unsigned int excepts)
{
  static fenv_t fenv;
  unsigned int new_excepts = excepts & FE_ALL_EXCEPT,
               old_excepts;  // all previous masks

  if ( fegetenv (&fenv) ) return -1;
  old_excepts = fenv.__control & FE_ALL_EXCEPT;

  // mask
  fenv.__control |= new_excepts;
  fenv.__mxcsr   |= new_excepts << 7;

  return ( fesetenv (&fenv) ? -1 : old_excepts );
}

#endif  // PPC or INTEL enabling
#endif  // not __linux__

/*** PPC FPSCR REGISTER ***/

#if DEFINED_PPC

#define getfpscr(x)    asm volatile ("mffs %0" : "=f" (x));
#define setfpscr(x)    asm volatile ("mtfsf 255,%0" : : "f" (x));

/** FPSCR@  ( -- u )
 * Leave the ppc 32-bit fp status and control register. 
 */
FCode (p4_fpscr_fetch)
{
  hexdouble t;

  getfpscr (t.d);
  *--SP = t.i.lo;
}

/** FPSCR!  ( u -- )
 * Store u in the ppc 32-bit fp status and control register.
 */
FCode (p4_fpscr_store)
{
  hexdouble t;
 
  t.i.hi = 0;
  t.i.lo = *SP++;
  setfpscr (t.d);
}

/** (FENABLE)   ( excepts -- )
 ** (FDISABLE)  ( excepts -- )
 * These words are a low level ppc version of FENABLE and
 * FDISABLE.  Turn on, respectively, off those enabling bits in
 * the ppc FPSCR register that are on in excepts, and leave the
 * rest alone.  Note that excepts is an OR of FE_xxx masks.
 */
FCode (p4_paren_fenable)
{
  hexdouble t;

  getfpscr(t.d);
  t.i.lo |= (*SP++ & FE_ALL_EXCEPT) >> 22;
  setfpscr(t.d);
}

FCode (p4_paren_fdisable)
{
  hexdouble t;

  getfpscr(t.d);
  t.i.lo &= ~( (*SP++ & FE_ALL_EXCEPT) >> 22 );
  setfpscr(t.d);
}

#endif  // DEFINED_PPC

/*** INTEL X87CR, X87SR, MXCSR REGISTER ACCESS ***/

#if DEFINED_INTEL

// x87 fpu
#define getx87cr(x)    asm ("fnstcw %0" : "=m" (x));
#define setx87cr(x)    asm ("fldcw %0"  : "=m" (x));
#define getx87sr(x)    asm ("fnstsw %0" : "=m" (x));

// SIMD, gcc with Intel Core 2 Duo uses SSE2(4)
#define getmxcsr(x)    asm ("stmxcsr %0" : "=m" (x));
#define setmxcsr(x)    asm ("ldmxcsr %0" : "=m" (x));

FCode (p4_x87cr_fetch)
{
  unsigned short cr;

  getx87cr (cr);
  *--SP = cr;
}

FCode (p4_x87cr_store)
{
  unsigned short cr = *SP++;

  setx87cr (cr);
}

FCode (p4_x87sr_fetch)
{
  unsigned short x87sr;

  getx87sr (x87sr);
  *--SP = x87sr;
}

FCode (p4_mxcsr_fetch)
{
  unsigned int csr;

  getmxcsr (csr);
  *--SP = csr;
}

FCode (p4_mxcsr_store)
{
  setmxcsr ((p4ucell) *SP++);
}

/** (FENABLE)   ( excepts -- )
 ** (FDISABLE)  ( excepts -- )
 * These words are a low level intel version of FENABLE and
 * FDISABLE.  Turn on, respectively, off those enabling bits in
 * the intel fpu registers that are on in excepts, and leave the
 * rest alone.  Note that excepts is an OR of FE_xxx masks.
 */
FCode (p4_paren_fenable)
{
  unsigned int   mxmb  = (*SP++ & FE_ALL_EXCEPT) << 7, csr;
  unsigned short x87mb = mxmb >> 7, cr;
  
  getx87cr (cr);
  cr &= ~x87mb;  //unmask with x87mb
  setx87cr (cr);

  getmxcsr (csr);
  csr &= ~mxmb;  //unmask with mxmb
  setmxcsr (csr);
}

FCode (p4_paren_fdisable)
{
  unsigned int   mxmb  = (*SP++ & FE_ALL_EXCEPT) << 7, csr;
  unsigned short x87mb = mxmb >> 7, cr;

  getx87cr (cr);
  cr |= x87mb;  //mask with x87mb
  setx87cr (cr);

  getmxcsr (csr);
  csr |= mxmb;  //mask with mxmb
  setmxcsr (csr);
}

#endif // DEFINED_INTEL

/* In the following, excepts is the bitwise OR of a subset of
 * values of the exception flag constants corresponding to fp
 * exceptions that currently have alternate handling enabled, or
 * are to have it enabled or disabled.
 *
 * In some implementations of gclib for some cpu's, the
 * exception flag constants actually use the same bits as those
 * of the status flags in a floating-point status register, and
 * are shifted by a fixed amount from the bits that enable or
 * mask alternate handling, possibly in the same register.
 *
 * The point is that the exception flag constants serve a dual
 * purpose, logically representing both exception status flag
 * bits and exception enabing or masking bits.
 */

// This shouldn't be necessary!  It comes right out of fenv.h.
#ifdef __linux__
extern int fegetexcept (void);
extern int feenableexcept (int __excepts);
extern int fedisableexcept (int __excepts);
#endif

/** FENABLED  ( -- excepts )
 * Leave the excepts corresponds to the fp exceptions currently
 * enabled for alternate handling.
 */
FCode (p4_fenabled)
{
  if ( (*--SP = fegetexcept()) == -1 )
      P4_fatal ("Can't get enabled exceptions!");
}

/** FEENABLEEXCEPT  ( excepts -- excepts.old )
 * Enable the exceptions in excepts for alternate handling, and
 * leave the previously enabled exceptions as excepts.old
 */
FCode (p4_feenableexcept)
{
  if ( (*SP = feenableexcept(*SP)) == -1 )
      P4_fatal ("Can't enable exceptions!");
}

/** FENABLE  ( excepts -- )
 * Enable the fp exceptions in excepts for alternate handling,
 * after first clearing all fp exception status flags.
 */
FCode (p4_fenable)
{
  if ( feclearexcept (FE_ALL_EXCEPT) )
      P4_fatal ("Can't clear exception flags!");
  if ( feenableexcept(*SP++) == -1 )
      P4_fatal ("Can't enable exceptions!");
}

/** FEDISABLEEXCEPT  ( excepts -- excepts.old )
 * Disable the exceptions in excepts for alternate handling, and
 * leave the previously enabled exceptions as excepts.old.
 */
FCode (p4_fedisableexcept)
{ 
  if ( feclearexcept (FE_ALL_EXCEPT) )
      P4_fatal ("Can't clear exception flags!");
  if ( (*SP = fedisableexcept(*SP)) == -1 )
      P4_fatal ("Can't disable exceptions!");
}

/** FDISABLE  ( excepts -- )
 * Disable the fp exceptions in excepts for alternate handling,
 * after first clearing all fp exception status flags.
 */
FCode (p4_fdisable)
{ 
  if ( fedisableexcept(*SP++) == -1 )
      P4_fatal ("Can't disable exceptions!");
}

#include <pfe/exception-ext.h>
static p4xt current_fhdl = 0;

/** SET-FHANDLER  ( xt -- )
 * Set the fp exception handler to use xt when enabled.  If
 * alternate handling is enabled and an fp exception occurs, xt
 * will be executed with the appropriate ANS Forth fp throw code
 * topmost on the data stack, possibly followed by other
 * implementation-defined data.  An ambiguous condition exists
 * if execution does not end by peforming THROW on the throw
 * code.  The default is the xt of THROW, which is initialized
 * by INSTALL-FHANDLING.
 */
FCode (p4_set_fhandler) { current_fhdl = (p4xt) *SP++; }

/** GET-FHANDLER  ( -- xt )
 * Return the current xt, which will be used if alternate fp
 * exception handling is enabled.
 */
FCode (p4_get_fhandler) { *--SP = (p4ucell) current_fhdl; }

#include <signal.h>

#ifndef _XOPEN_SOURCE
#define _XOPEN_SOURCE 1
#endif
#include <ucontext.h>

static void
fhdl ( int sig, siginfo_t *sip, ucontext_t *scp )
{
  int fe_code = sip->si_code;

  switch (fe_code)
  {
    case FPE_FLTDIV: fe_code = -42; break; // divideByZero
    case FPE_FLTINV: fe_code = -46; break; // invalid
    case FPE_FLTOVF: fe_code = -43; break; // overflow
    case FPE_FLTUND: fe_code = -54; break; // underflow
    case FPE_FLTRES: fe_code = -41; break; // inexact
#if DEFINED_INTEL && !defined __linux__
    case FPE_NOOP:   fe_code = -55; break; // denormal (experimental) 
#endif
    default:  // should not occur
    {
      printf ("\nSignal is: %i\n", sig);
      printf ("SIGFPE code: %i\n", fe_code);
      fe_code = -55;  // unidentified fp fault
    }
  }

  // This test should not be necessary, but who knows.
  if ( !current_fhdl ) p4_throw(fe_code);

  *--SP = fe_code;
# ifndef PFE_CALL_THREADING
  PFE.execute (current_fhdl);
# else
  p4_call (current_fhdl);
# endif
}

/** INSTALL-FHANDLING  ( -- )
 * Establish the alternate fp exception handler, and initialize
 * the xt it executes to that of THROW.  Thereafter the handler
 * will fire on a floating-point exception, if alternate fp
 * handling is enabled.  This word is executed when the ieeefp
 * extensions word set is loaded.  It may also be executed by an
 * application, which may be necessary on some systems after an
 * ABORT, to reestablish the handler.
 */
FCode (p4_fhandling_init)
{
  struct sigaction act;

  act.sa_sigaction = (void(*))fhdl;
  sigemptyset (&act.sa_mask);  // no blocked signals
  act.sa_flags = SA_SIGINFO;   // pass siginfo to handler

  // Do this first in case the handler fires:
  current_fhdl = p4_name_from ( p4_find ((p4_char_t *) "THROW", 5) );

  if (sigaction (SIGFPE, &act, (struct sigaction *)0) != 0)
     P4_fatal ("Can't install fp signal handler!");
}

P4_LISTWORDS (fpaux) =
{
  P4_INTO ("EXTENSIONS", 0),
  /* floating-point environment */
  P4_OCoN ("/FENV",         sizeof (fenv_t) ),
  P4_OCoN ("FE-DFL-ENV",    FE_DFL_ENV),
  P4_FXco ("FEGETENV",      p4_fegetenv),
  P4_FXco ("FESETENV",      p4_fesetenv),
  P4_FXco ("FEHOLDEXCEPT",  p4_feholdexcept),
  P4_FXco ("FEUPDATEENV",   p4_feupdateenv),
  /* floating-point exception flags */
  P4_OCoN ("FDIVBYZERO",    FE_DIVBYZERO),
  P4_OCoN ("FINEXACT",      FE_INEXACT),
  P4_OCoN ("FINVALID",      FE_INVALID),
  P4_OCoN ("FOVERFLOW",     FE_OVERFLOW),
  P4_OCoN ("FUNDERFLOW",    FE_UNDERFLOW),
#if DEFINED_INTEL && !defined __linux__
  P4_OCoN ("FDENORMOPAND",  FE_DENORMALOPERAND),
#endif
  P4_OCoN ("ALL-FEXCEPTS",  FE_ALL_EXCEPT),
  P4_FXco ("GET-FFLAGS",    p4_get_fflags),
  P4_FXco ("SET-FFLAGS",    p4_set_fflags),
  P4_FXco ("CLEAR-FFLAGS",  p4_clear_fflags),
  /* floating-point rounding modes */
  P4_OCoN ("FR-DOWNWARD",   FE_DOWNWARD),
  P4_OCoN ("FR-UPWARD",     FE_UPWARD),
  P4_OCoN ("FR-TONEAREST",  FE_TONEAREST),
  P4_OCoN ("FR-TOWARDZERO", FE_TOWARDZERO),
  P4_FXco ("GET-FROUND",    p4_get_fround),
  P4_FXco ("SET-FROUND",    p4_set_fround),
  /* alternate floating-point exception handling */
#if DEFINED_PPC
  P4_FXco ("FPSCR@",        p4_fpscr_fetch),
  P4_FXco ("FPSCR!",        p4_fpscr_store),
#endif
#if DEFINED_INTEL
  P4_FXco ("X87CR@",        p4_x87cr_fetch),
  P4_FXco ("X87CR!",        p4_x87cr_store),
  P4_FXco ("X87SR@",        p4_x87sr_fetch),
  P4_FXco ("MXCSR@",        p4_mxcsr_fetch),
  P4_FXco ("MXCSR!",        p4_mxcsr_store),
#endif
  P4_FXco ("(FENABLE)",     p4_paren_fenable),
  P4_FXco ("(FDISABLE)",    p4_paren_fdisable),
  P4_FXco ("FENABLED",      p4_fenabled),
  P4_FXco ("FEENABLEEXCEPT",    p4_feenableexcept),
  P4_FXco ("FENABLE",       p4_fenable),
  P4_FXco ("FEDISABLEEXCEPT",   p4_fedisableexcept),
  P4_FXco ("FDISABLE",      p4_fdisable),
  P4_FXco ("SET-FHANDLER",  p4_set_fhandler),
  P4_FXco ("GET-FHANDLER",  p4_get_fhandler),
  P4_FXco ("INSTALL-FHANDLING", p4_fhandling_init),

  P4_INTO ("ENVIRONMENT",   0),
  P4_OCoN ("FPAUX",       2020),
  P4_XXco ("INSTALL-FHANDLING", p4_fhandling_init),
};

P4_COUNTWORDS (fpaux, "C99 IEEE 754 auxliary");