/* intrin.c -- Recognize references to intrinsics
   Copyright (C) 1995 Free Software Foundation, Inc.
   Contributed by James Craig Burley (burley@gnu.ai.mit.edu).

This file is part of GNU Fortran.

GNU Fortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Fortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

*/

#include "proj.h"
#include <ctype.h>
#include "intrin.h"
#include "info.h"
#include "src.h"
#include "target.h"
#include "top.h"

struct _ffeintrin_name_
  {
    char *name_uc;
    char *name_lc;
    char *name_ic;
    ffeintrinGen generic;
    ffeintrinSpec specific;
  };

struct _ffeintrin_gen_
  {
    char *name;			/* Name as seen in program. */
    ffeintrinSpec specs[14];
  };

struct _ffeintrin_spec_
  {
    char *name;			/* Uppercase name as seen in source code,
				   lowercase if no source name, "none" if no
				   name at all (NONE case). */
    bool is_actualarg;		/* Ok to pass as actual arg if -pedantic. */
    ffeintrinFamily family;
    ffeintrinImp implementation;
  };

struct _ffeintrin_imp_
  {
    char *name;			/* Name of implementation. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
    ffecomGfrt gfrt;		/* gfrt index in library. */
#endif
    ffeinfoBasictype basictype;
    ffeinfoKindtype kindtype;
    ffetargetCharacterSize size;
    ffebad (*check) (ffebld arglist);
  };

static ffebad ffeintrin_check_1_ (ffebld arglist, ffebld *xarg1);
static ffebad ffeintrin_check_1or2_ (ffebld arglist, ffebld *xarg1,
				     ffebld *xarg2);
static ffebad ffeintrin_check_2_ (ffebld arglist, ffebld *xarg1,
				  ffebld *xarg2);
static ffebad ffeintrin_check_3_ (ffebld arglist, ffebld *xarg1,
				  ffebld *xarg2, ffebld *xarg3);
static ffebad ffeintrin_check_5_ (ffebld arglist, ffebld *xarg1,
				  ffebld *xarg2, ffebld *xarg3,
				  ffebld *xarg4, ffebld *xarg5);
static bool ffeintrin_check_any_ (ffebld arglist);
static ffebad ffeintrin_check_char_1_ (ffebld arglist);
static ffebad ffeintrin_check_char_2_ (ffebld arglist);
static ffebad ffeintrin_check_cmplx_1_ (ffebld arglist);
static ffebad ffeintrin_check_cmplx_1or2_ (ffebld arglist);
static ffebad ffeintrin_check_dcmplx_1_ (ffebld arglist);
static ffebad ffeintrin_check_dcmplx_1or2_ (ffebld arglist);
static ffebad ffeintrin_check_int_1_ (ffebld arglist);
static ffebad ffeintrin_check_int_1or2_ (ffebld arglist);
static ffebad ffeintrin_check_int_2_ (ffebld arglist);
static ffebad ffeintrin_check_int_2p_ (ffebld arglist);
static ffebad ffeintrin_check_int_3_ (ffebld arglist);
static ffebad ffeintrin_check_loc_ (ffebld arglist);
static ffebad ffeintrin_check_log_1_ (ffebld arglist);
#if 0
static ffebad ffeintrin_check_log_1or2_ (ffebld arglist);
#endif
static ffebad ffeintrin_check_log_2_ (ffebld arglist);
#if 0
static ffebad ffeintrin_check_log_2p_ (ffebld arglist);
#endif
static ffebad ffeintrin_check_mvbits_ (ffebld arglist);
static ffebad ffeintrin_check_procedure_ (ffeintrinImp imp, ffebldOp op);
static ffebad ffeintrin_check_real_1_ (ffebld arglist);
static ffebad ffeintrin_check_real_1or2_ (ffebld arglist);
static ffebad ffeintrin_check_real_2_ (ffebld arglist);
static ffebad ffeintrin_check_real_2p_ (ffebld arglist);
static ffebad ffeintrin_check_realdbl_1_ (ffebld arglist);
static ffebad ffeintrin_check_realdbl_1or2_ (ffebld arglist);
static ffebad ffeintrin_check_realdbl_2_ (ffebld arglist);
static ffebad ffeintrin_check_realdbl_2p_ (ffebld arglist);
static ffebad ffeintrin_check_void_ (ffebld arglist);
static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic);

static struct _ffeintrin_name_ ffeintrin_names_[]
=
{				/* Alpha order. */
  {"ABS", "abs", "Abs", FFEINTRIN_genABS, FFEINTRIN_specABS,},
  {"ACHAR", "achar", "AChar", FFEINTRIN_genACHAR, FFEINTRIN_specNONE,},	/* F90, F2C */
  {"ACOS", "acos", "ACos", FFEINTRIN_genACOS, FFEINTRIN_specACOS,},
  {"ACOSD", "acosd", "ACosD", FFEINTRIN_genACOSD, FFEINTRIN_specACOSD,},	/* VXT */
{"ADJUSTL", "adjustl", "AdjustL", FFEINTRIN_genADJUSTL, FFEINTRIN_specNONE,},	/* F90 */
{"ADJUSTR", "adjustr", "AdjustR", FFEINTRIN_genADJUSTR, FFEINTRIN_specNONE,},	/* F90 */
  {"AIMAG", "aimag", "AImag", FFEINTRIN_genAIMAG, FFEINTRIN_specAIMAG,},
  {"AIMAX0", "aimax0", "AIMax0", FFEINTRIN_genNONE, FFEINTRIN_specAIMAX0,},	/* VXT */
  {"AIMIN0", "aimin0", "AIMin0", FFEINTRIN_genNONE, FFEINTRIN_specAIMIN0,},	/* VXT */
  {"AINT", "aint", "AInt", FFEINTRIN_genAINT, FFEINTRIN_specAINT,},
  {"AJMAX0", "ajmax0", "AJMax0", FFEINTRIN_genNONE, FFEINTRIN_specAJMAX0,},	/* VXT */
  {"AJMIN0", "ajmin0", "AJMin0", FFEINTRIN_genNONE, FFEINTRIN_specAJMIN0,},	/* VXT */
  {"ALL", "all", "All", FFEINTRIN_genALL, FFEINTRIN_specNONE,},	/* F90 */
  {"ALLOCATED", "allocated", "Allocated", FFEINTRIN_genALLOCATED, FFEINTRIN_specNONE,},	/* F90 */
  {"ALOG", "alog", "ALog", FFEINTRIN_genNONE, FFEINTRIN_specALOG,},
  {"ALOG10", "alog10", "ALog10", FFEINTRIN_genNONE, FFEINTRIN_specALOG10,},
  {"AMAX0", "amax0", "AMax0", FFEINTRIN_genAMAX0, FFEINTRIN_specAMAX0,},
  {"AMAX1", "amax1", "AMax1", FFEINTRIN_genNONE, FFEINTRIN_specAMAX1,},
  {"AMIN0", "amin0", "AMin0", FFEINTRIN_genAMIN0, FFEINTRIN_specAMIN0,},
  {"AMIN1", "amin1", "AMin1", FFEINTRIN_genNONE, FFEINTRIN_specAMIN1,},
  {"AMOD", "amod", "AMod", FFEINTRIN_genNONE, FFEINTRIN_specAMOD,},
  {"AND", "and", "And", FFEINTRIN_genAND, FFEINTRIN_specNONE,},	/* F2C */
  {"ANINT", "anint", "ANInt", FFEINTRIN_genANINT, FFEINTRIN_specANINT,},
  {"ANY", "any", "Any", FFEINTRIN_genANY, FFEINTRIN_specNONE,},	/* F90 */
  {"ASIN", "asin", "ASin", FFEINTRIN_genASIN, FFEINTRIN_specASIN,},
  {"ASIND", "asind", "ASinD", FFEINTRIN_genASIND, FFEINTRIN_specASIND,},	/* VXT */
  {"ASSOCIATED", "associated", "Associated", FFEINTRIN_genASSOCIATED, FFEINTRIN_specNONE,},	/* F90 */
  {"ATAN", "atan", "ATan", FFEINTRIN_genATAN, FFEINTRIN_specATAN,},
  {"ATAN2", "atan2", "ATan2", FFEINTRIN_genATAN2, FFEINTRIN_specATAN2,},
  {"ATAN2D", "atan2d", "ATan2D", FFEINTRIN_genATAN2D, FFEINTRIN_specATAN2D,},	/* VXT */
  {"ATAND", "atand", "ATanD", FFEINTRIN_genATAND, FFEINTRIN_specATAND,},	/* VXT */
  {"BITEST", "bitest", "BITest", FFEINTRIN_genNONE, FFEINTRIN_specBITEST,},	/* VXT */
  {"BIT_SIZE", "bit_size", "Bit_Size", FFEINTRIN_genBIT_SIZE, FFEINTRIN_specNONE,},	/* F90 */
  {"BJTEST", "bjtest", "BJTest", FFEINTRIN_genNONE, FFEINTRIN_specBJTEST,},	/* VXT */
  {"BTEST", "btest", "BTest", FFEINTRIN_genBTEST, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"CABS", "cabs", "CAbs", FFEINTRIN_genNONE, FFEINTRIN_specCABS,},
  {"CCOS", "ccos", "CCos", FFEINTRIN_genNONE, FFEINTRIN_specCCOS,},
  {"CDABS", "cdabs", "CDAbs", FFEINTRIN_genNONE, FFEINTRIN_specCDABS,},	/* VXT */
  {"CDCOS", "cdcos", "CDCos", FFEINTRIN_genNONE, FFEINTRIN_specCDCOS,},	/* VXT */
  {"CDEXP", "cdexp", "CDExp", FFEINTRIN_genNONE, FFEINTRIN_specCDEXP,},	/* VXT */
  {"CDLOG", "cdlog", "CDLog", FFEINTRIN_genNONE, FFEINTRIN_specCDLOG,},	/* VXT */
  {"CDSIN", "cdsin", "CDSin", FFEINTRIN_genNONE, FFEINTRIN_specCDSIN,},	/* VXT */
  {"CDSQRT", "cdsqrt", "CDSqRt", FFEINTRIN_genNONE, FFEINTRIN_specCDSQRT,},	/* VXT */
{"CEILING", "ceiling", "Ceiling", FFEINTRIN_genCEILING, FFEINTRIN_specNONE,},	/* F90 */
  {"CEXP", "cexp", "CExp", FFEINTRIN_genNONE, FFEINTRIN_specCEXP,},
  {"CHAR", "char", "Char", FFEINTRIN_genCHAR, FFEINTRIN_specCHAR,},
  {"CLOG", "clog", "CLog", FFEINTRIN_genNONE, FFEINTRIN_specCLOG,},
  {"CMPLX", "cmplx", "Cmplx", FFEINTRIN_genCMPLX, FFEINTRIN_specNONE,},
  {"CONJG", "conjg", "Conjg", FFEINTRIN_genCONJG, FFEINTRIN_specCONJG,},
  {"COS", "cos", "Cos", FFEINTRIN_genCOS, FFEINTRIN_specCOS,},
  {"COSD", "cosd", "CosD", FFEINTRIN_genCOSD, FFEINTRIN_specCOSD,},	/* VXT */
  {"COSH", "cosh", "CosH", FFEINTRIN_genCOSH, FFEINTRIN_specCOSH,},
  {"COUNT", "count", "Count", FFEINTRIN_genCOUNT, FFEINTRIN_specNONE,},	/* F90 */
  {"CSHIFT", "cshift", "CShift", FFEINTRIN_genCSHIFT, FFEINTRIN_specNONE,},	/* F90 */
  {"CSIN", "csin", "CSin", FFEINTRIN_genNONE, FFEINTRIN_specCSIN,},
  {"CSQRT", "csqrt", "CSqRt", FFEINTRIN_genNONE, FFEINTRIN_specCSQRT,},
  {"DABS", "dabs", "DAbs", FFEINTRIN_genNONE, FFEINTRIN_specDABS,},
  {"DACOS", "dacos", "DACos", FFEINTRIN_genNONE, FFEINTRIN_specDACOS,},
  {"DACOSD", "dacosd", "DACosD", FFEINTRIN_genNONE, FFEINTRIN_specDACOSD,},	/* VXT */
  {"DASIN", "dasin", "DASin", FFEINTRIN_genNONE, FFEINTRIN_specDASIN,},
  {"DASIND", "dasind", "DASinD", FFEINTRIN_genNONE, FFEINTRIN_specDASIND,},	/* VXT */
  {"DATAN", "datan", "DATan", FFEINTRIN_genNONE, FFEINTRIN_specDATAN,},
  {"DATAN2", "datan2", "DATan2", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2,},
{"DATAN2D", "datan2d", "DATan2D", FFEINTRIN_genNONE, FFEINTRIN_specDATAN2D,},	/* VXT */
  {"DATAND", "datand", "DATanD", FFEINTRIN_genNONE, FFEINTRIN_specDATAND,},	/* VXT */
  {"DATE_AND_TIME", "date_and_time", "Date_and_Time", FFEINTRIN_genNONE, FFEINTRIN_specDATE_AND_TIME,},	/* F90 */
  {"DBLE", "dble", "Dble", FFEINTRIN_genDBLE, FFEINTRIN_specDBLE,},
  {"DBLEQ", "dbleq", "DbleQ", FFEINTRIN_genNONE, FFEINTRIN_specDBLEQ,},	/* VXT */
  {"DCMPLX", "dcmplx", "DCmplx", FFEINTRIN_genDCMPLX, FFEINTRIN_specNONE,},	/* F2C, VXT */
  {"DCONJG", "dconjg", "DConjg", FFEINTRIN_genNONE, FFEINTRIN_specDCONJG,},	/* F2C, VXT */
  {"DCOS", "dcos", "DCos", FFEINTRIN_genNONE, FFEINTRIN_specDCOS,},
  {"DCOSD", "dcosd", "DCosD", FFEINTRIN_genNONE, FFEINTRIN_specDCOSD,},	/* VXT */
  {"DCOSH", "dcosh", "DCosH", FFEINTRIN_genNONE, FFEINTRIN_specDCOSH,},
  {"DDIM", "ddim", "DDim", FFEINTRIN_genNONE, FFEINTRIN_specDDIM,},
  {"DEXP", "dexp", "DExp", FFEINTRIN_genNONE, FFEINTRIN_specDEXP,},
  {"DFLOAT", "dfloat", "DFloat", FFEINTRIN_genDFLOAT, FFEINTRIN_specNONE,},	/* F2C, VXT */
  {"DFLOTI", "dfloti", "DFlotI", FFEINTRIN_genNONE, FFEINTRIN_specDFLOTI,},	/* VXT */
  {"DFLOTJ", "dflotj", "DFlotJ", FFEINTRIN_genNONE, FFEINTRIN_specDFLOTJ,},	/* VXT */
  {"DIGITS", "digits", "Digits", FFEINTRIN_genDIGITS, FFEINTRIN_specNONE,},	/* F90 */
  {"DIM", "dim", "DiM", FFEINTRIN_genDIM, FFEINTRIN_specDIM,},
  {"DIMAG", "dimag", "DImag", FFEINTRIN_genNONE, FFEINTRIN_specDIMAG,},	/* VXT */
  {"DINT", "dint", "DInt", FFEINTRIN_genNONE, FFEINTRIN_specDINT,},
  {"DLOG", "dlog", "DLog", FFEINTRIN_genNONE, FFEINTRIN_specDLOG,},
  {"DLOG10", "dlog10", "DLog10", FFEINTRIN_genNONE, FFEINTRIN_specDLOG10,},
  {"DMAX1", "dmax1", "DMax1", FFEINTRIN_genNONE, FFEINTRIN_specDMAX1,},
  {"DMIN1", "dmin1", "DMin1", FFEINTRIN_genNONE, FFEINTRIN_specDMIN1,},
  {"DMOD", "dmod", "DMod", FFEINTRIN_genNONE, FFEINTRIN_specDMOD,},
  {"DNINT", "dnint", "DNInt", FFEINTRIN_genNONE, FFEINTRIN_specDNINT,},
  {"DOT_PRODUCT", "dot_product", "Dot_Product", FFEINTRIN_genDOT_PRODUCT, FFEINTRIN_specNONE,},	/* F90 */
  {"DPROD", "dprod", "DProd", FFEINTRIN_genDPROD, FFEINTRIN_specDPROD,},
  {"DREAL", "dreal", "DReal", FFEINTRIN_genNONE, FFEINTRIN_specDREAL,},	/* VXT */
  {"DSIGN", "dsign", "DSign", FFEINTRIN_genNONE, FFEINTRIN_specDSIGN,},
  {"DSIN", "dsin", "DSin", FFEINTRIN_genNONE, FFEINTRIN_specDSIN,},
  {"DSIND", "dsind", "DSinD", FFEINTRIN_genNONE, FFEINTRIN_specDSIND,},	/* VXT */
  {"DSINH", "dsinh", "DSinH", FFEINTRIN_genNONE, FFEINTRIN_specDSINH,},
  {"DSQRT", "dsqrt", "DSqRt", FFEINTRIN_genNONE, FFEINTRIN_specDSQRT,},
  {"DTAN", "dtan", "DTan", FFEINTRIN_genNONE, FFEINTRIN_specDTAN,},
  {"DTAND", "dtand", "DTanD", FFEINTRIN_genNONE, FFEINTRIN_specDTAND,},	/* VXT */
  {"DTANH", "dtanh", "DTanH", FFEINTRIN_genNONE, FFEINTRIN_specDTANH,},
{"EOSHIFT", "eoshift", "EOShift", FFEINTRIN_genEOSHIFT, FFEINTRIN_specNONE,},	/* F90 */
{"EPSILON", "epsilon", "Epsilon", FFEINTRIN_genEPSILON, FFEINTRIN_specNONE,},	/* F90 */
  {"EXP", "exp", "Exp", FFEINTRIN_genEXP, FFEINTRIN_specEXP,},
  {"EXPONENT", "exponent", "Exponent", FFEINTRIN_genEXPONENT, FFEINTRIN_specNONE,},	/* F90 */
  {"FLOAT", "float", "Float", FFEINTRIN_genFLOAT, FFEINTRIN_specFLOAT,},
  {"FLOATI", "floati", "FloatI", FFEINTRIN_genNONE, FFEINTRIN_specFLOATI,},	/* VXT */
  {"FLOATJ", "floatj", "FloatJ", FFEINTRIN_genNONE, FFEINTRIN_specFLOATJ,},	/* VXT */
  {"FLOOR", "floor", "Floor", FFEINTRIN_genFLOOR, FFEINTRIN_specNONE,},	/* F90 */
  {"FPABSP", "fpabsp", "FPAbsP", FFEINTRIN_genFPABSP, FFEINTRIN_specNONE,},	/* F2C */
  {"FPEXPN", "fpexpn", "FPExpn", FFEINTRIN_genFPEXPN, FFEINTRIN_specNONE,},	/* F2C */
  {"FPFRAC", "fpfrac", "FPFrac", FFEINTRIN_genFPFRAC, FFEINTRIN_specNONE,},	/* F2C */
  {"FPMAKE", "fpmake", "FPMake", FFEINTRIN_genFPMAKE, FFEINTRIN_specNONE,},	/* F2C */
  {"FPRRSP", "fprrsp", "FPRRSp", FFEINTRIN_genFPRRSP, FFEINTRIN_specNONE,},	/* F2C */
  {"FPSCAL", "fpscal", "FPScal", FFEINTRIN_genFPSCAL, FFEINTRIN_specNONE,},	/* F2C */
  {"FRACTION", "fraction", "Fraction", FFEINTRIN_genFRACTION, FFEINTRIN_specNONE,},	/* F90 */
  {"HUGE", "huge", "Huge", FFEINTRIN_genHUGE, FFEINTRIN_specNONE,},	/* F90 */
  {"IABS", "iabs", "IAbs", FFEINTRIN_genIABS, FFEINTRIN_specIABS,},
  {"IACHAR", "iachar", "IAChar", FFEINTRIN_genIACHAR, FFEINTRIN_specNONE,},	/* F90, F2C */
  {"IAND", "iand", "IAnd", FFEINTRIN_genIAND, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"IBCLR", "ibclr", "IBClr", FFEINTRIN_genIBCLR, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"IBITS", "ibits", "IBits", FFEINTRIN_genIBITS, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"IBSET", "ibset", "IBSet", FFEINTRIN_genIBSET, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"ICHAR", "ichar", "IChar", FFEINTRIN_genICHAR, FFEINTRIN_specICHAR,},
  {"IDIM", "idim", "IDiM", FFEINTRIN_genIDIM, FFEINTRIN_specIDIM,},
  {"IDINT", "idint", "IDInt", FFEINTRIN_genIDINT, FFEINTRIN_specIDINT,},
  {"IDNINT", "idnint", "IDNInt", FFEINTRIN_genIDNINT, FFEINTRIN_specIDNINT,},
  {"IEOR", "ieor", "IEOr", FFEINTRIN_genIEOR, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"IFIX", "ifix", "IFix", FFEINTRIN_genIFIX, FFEINTRIN_specIFIX,},
  {"IIABS", "iiabs", "IIAbs", FFEINTRIN_genNONE, FFEINTRIN_specIIABS,},	/* VXT */
  {"IIAND", "iiand", "IIAnd", FFEINTRIN_genNONE, FFEINTRIN_specIIAND,},	/* VXT */
  {"IIBCLR", "iibclr", "IIBClr", FFEINTRIN_genNONE, FFEINTRIN_specIIBCLR,},	/* VXT */
  {"IIBITS", "iibits", "IIBits", FFEINTRIN_genNONE, FFEINTRIN_specIIBITS,},	/* VXT */
  {"IIBSET", "iibset", "IIBSet", FFEINTRIN_genNONE, FFEINTRIN_specIIBSET,},	/* VXT */
  {"IIDIM", "iidim", "IIDiM", FFEINTRIN_genNONE, FFEINTRIN_specIIDIM,},	/* VXT */
  {"IIDINT", "iidint", "IIDint", FFEINTRIN_genNONE, FFEINTRIN_specIIDINT,},	/* VXT */
  {"IIDNNT", "iidnnt", "IIDNnt", FFEINTRIN_genNONE, FFEINTRIN_specIIDNNT,},	/* VXT */
  {"IIEOR", "iieor", "IIEOr", FFEINTRIN_genNONE, FFEINTRIN_specIIEOR,},	/* VXT */
  {"IIFIX", "iifix", "IIFix", FFEINTRIN_genNONE, FFEINTRIN_specIIFIX,},	/* VXT */
  {"IINT", "iint", "IInt", FFEINTRIN_genNONE, FFEINTRIN_specIINT,},	/* VXT */
  {"IIOR", "iior", "IIOr", FFEINTRIN_genNONE, FFEINTRIN_specIIOR,},	/* VXT */
  {"IIQINT", "iiqint", "IIQint", FFEINTRIN_genNONE, FFEINTRIN_specIIQINT,},	/* VXT */
  {"IIQNNT", "iiqnnt", "IIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specIIQNNT,},	/* VXT */
  {"IISHFT", "iishft", "IIShft", FFEINTRIN_genNONE, FFEINTRIN_specNONE,},	/* VXT */
{"IISHFTC", "iishftc", "IIShftC", FFEINTRIN_genNONE, FFEINTRIN_specIISHFTC,},	/* VXT */
  {"IISIGN", "iisign", "IISign", FFEINTRIN_genNONE, FFEINTRIN_specIISIGN,},	/* VXT */
  {"IMAG", "imag", "Imag", FFEINTRIN_genIMAG, FFEINTRIN_spec_IMAG_C_F2C,},	/* F2C */
  {"IMAX0", "imax0", "IMax0", FFEINTRIN_genNONE, FFEINTRIN_specIMAX0,},	/* VXT */
  {"IMAX1", "imax1", "IMax1", FFEINTRIN_genNONE, FFEINTRIN_specIMAX1,},	/* VXT */
  {"IMIN0", "imin0", "IMin0", FFEINTRIN_genNONE, FFEINTRIN_specIMIN0,},	/* VXT */
  {"IMIN1", "imin1", "IMin1", FFEINTRIN_genNONE, FFEINTRIN_specIMIN1,},	/* VXT */
  {"IMOD", "imod", "IMod", FFEINTRIN_genNONE, FFEINTRIN_specIMOD,},	/* VXT */
  {"INDEX", "index", "Index", FFEINTRIN_genINDEX, FFEINTRIN_specINDEX,},
  {"ININT", "inint", "INInt", FFEINTRIN_genNONE, FFEINTRIN_specININT,},	/* VXT */
  {"INOT", "inot", "INot", FFEINTRIN_genNONE, FFEINTRIN_specINOT,},	/* VXT */
  {"INT", "int", "Int", FFEINTRIN_genINT, FFEINTRIN_specINT,},
  {"IOR", "ior", "IOr", FFEINTRIN_genIOR, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"ISHFT", "ishft", "IShft", FFEINTRIN_genISHFT, FFEINTRIN_specNONE,},	/* F90 */
  {"ISHFTC", "ishftc", "IShftC", FFEINTRIN_genISHFTC, FFEINTRIN_specNONE,},	/* F90, VXT */
  {"ISIGN", "isign", "ISign", FFEINTRIN_genNONE, FFEINTRIN_specISIGN,},
  {"IZEXT", "izext", "IZExt", FFEINTRIN_genNONE, FFEINTRIN_specIZEXT,},	/* VXT */
  {"JIABS", "jiabs", "JIAbs", FFEINTRIN_genNONE, FFEINTRIN_specJIABS,},	/* VXT */
  {"JIAND", "jiand", "JIAnd", FFEINTRIN_genNONE, FFEINTRIN_specJIAND,},	/* VXT */
  {"JIBCLR", "jibclr", "JIBClr", FFEINTRIN_genNONE, FFEINTRIN_specJIBCLR,},	/* VXT */
  {"JIBITS", "jibits", "JIBits", FFEINTRIN_genNONE, FFEINTRIN_specJIBITS,},	/* VXT */
  {"JIBSET", "jibset", "JIBSet", FFEINTRIN_genNONE, FFEINTRIN_specJIBSET,},	/* VXT */
  {"JIDIM", "jidim", "JIDiM", FFEINTRIN_genNONE, FFEINTRIN_specJIDIM,},	/* VXT */
  {"JIDINT", "jidint", "JIDint", FFEINTRIN_genNONE, FFEINTRIN_specJIDINT,},	/* VXT */
  {"JIDNNT", "jidnnt", "JIDNnt", FFEINTRIN_genNONE, FFEINTRIN_specJIDNNT,},	/* VXT */
  {"JIEOR", "jieor", "JIEOr", FFEINTRIN_genNONE, FFEINTRIN_specJIEOR,},	/* VXT */
  {"JIFIX", "jifix", "JIFix", FFEINTRIN_genNONE, FFEINTRIN_specJIFIX,},	/* VXT */
  {"JINT", "jint", "JInt", FFEINTRIN_genNONE, FFEINTRIN_specJINT,},	/* VXT */
  {"JIOR", "jior", "JIOr", FFEINTRIN_genNONE, FFEINTRIN_specJIOR,},	/* VXT */
  {"JIQINT", "jiqint", "JIQint", FFEINTRIN_genNONE, FFEINTRIN_specJIQINT,},	/* VXT */
  {"JIQNNT", "jiqnnt", "JIQNnt", FFEINTRIN_genNONE, FFEINTRIN_specJIQNNT,},	/* VXT */
  {"JISHFT", "jishft", "JIShft", FFEINTRIN_genNONE, FFEINTRIN_specJISHFT,},	/* VXT */
{"JISHFTC", "jishftc", "JIShftC", FFEINTRIN_genNONE, FFEINTRIN_specJISHFTC,},	/* VXT */
  {"JISIGN", "jisign", "JISign", FFEINTRIN_genNONE, FFEINTRIN_specJISIGN,},	/* VXT */
  {"JMAX0", "jmax0", "JMax0", FFEINTRIN_genNONE, FFEINTRIN_specJMAX0,},	/* VXT */
  {"JMAX1", "jmax1", "JMax1", FFEINTRIN_genNONE, FFEINTRIN_specJMAX1,},	/* VXT */
  {"JMIN0", "jmin0", "JMin0", FFEINTRIN_genNONE, FFEINTRIN_specJMIN0,},	/* VXT */
  {"JMIN1", "jmin1", "JMin1", FFEINTRIN_genNONE, FFEINTRIN_specJMIN1,},	/* VXT */
  {"JMOD", "jmod", "JMod", FFEINTRIN_genNONE, FFEINTRIN_specJMOD,},	/* VXT */
  {"JNINT", "jnint", "JNInt", FFEINTRIN_genNONE, FFEINTRIN_specJNINT,},	/* VXT */
  {"JNOT", "jnot", "JNot", FFEINTRIN_genNONE, FFEINTRIN_specJNOT,},	/* VXT */
  {"JZEXT", "jzext", "JZExt", FFEINTRIN_genNONE, FFEINTRIN_specJZEXT,},	/* VXT */
  {"KIND", "kind", "Kind", FFEINTRIN_genKIND, FFEINTRIN_specNONE,},	/* F90 */
  {"LBOUND", "lbound", "LBound", FFEINTRIN_genLBOUND, FFEINTRIN_specNONE,},	/* F90 */
  {"LEN", "len", "Len", FFEINTRIN_genLEN, FFEINTRIN_specLEN,},
  {"LEN_TRIM", "len_trim", "Len_Trim", FFEINTRIN_genLEN_TRIM, FFEINTRIN_specNONE,},	/* F90 */
  {"LGE", "lge", "LGe", FFEINTRIN_genLGE, FFEINTRIN_specLGE,},
  {"LGT", "lgt", "LGt", FFEINTRIN_genLGT, FFEINTRIN_specLGT,},
  {"LLE", "lle", "LLe", FFEINTRIN_genLLE, FFEINTRIN_specLLE,},
  {"LLT", "llt", "LLt", FFEINTRIN_genLLT, FFEINTRIN_specLLT,},
  {"LOC", "loc", "Loc", FFEINTRIN_genNONE, FFEINTRIN_specLOC,},	/* VXT */
  {"LOG", "log", "Log", FFEINTRIN_genLOG, FFEINTRIN_specNONE,},
  {"LOG10", "log10", "Log10", FFEINTRIN_genLOG10, FFEINTRIN_specNONE,},
{"LOGICAL", "logical", "Logical", FFEINTRIN_genLOGICAL, FFEINTRIN_specNONE,},	/* F90 */
  {"LSHIFT", "lshift", "LShift", FFEINTRIN_genLSHIFT, FFEINTRIN_specNONE,},	/* F2C */
  {"MATMUL", "matmul", "MatMul", FFEINTRIN_genMATMUL, FFEINTRIN_specNONE,},	/* F90 */
  {"MAX", "max", "Max", FFEINTRIN_genMAX, FFEINTRIN_specNONE,},
  {"MAX0", "max0", "Max0", FFEINTRIN_genMAX0, FFEINTRIN_specMAX0,},
  {"MAX1", "max1", "Max1", FFEINTRIN_genMAX1, FFEINTRIN_specMAX1,},
  {"MAXEXPONENT", "maxexponent", "MaxExponent", FFEINTRIN_genMAXEXPONENT, FFEINTRIN_specNONE,},	/* F90 */
  {"MAXLOC", "maxloc", "MaxLoc", FFEINTRIN_genMAXLOC, FFEINTRIN_specNONE,},	/* F90 */
  {"MAXVAL", "maxval", "MaxVal", FFEINTRIN_genMAXVAL, FFEINTRIN_specNONE,},	/* F90 */
  {"MERGE", "merge", "Merge", FFEINTRIN_genMERGE, FFEINTRIN_specNONE,},	/* F90 */
  {"MIN", "min", "Min", FFEINTRIN_genMIN, FFEINTRIN_specNONE,},
  {"MIN0", "min0", "Min0", FFEINTRIN_genMIN0, FFEINTRIN_specMIN0,},
  {"MIN1", "min1", "Min1", FFEINTRIN_genMIN1, FFEINTRIN_specMIN1,},
  {"MINEXPONENT", "minexponent", "MinExponent", FFEINTRIN_genMINEXPONENT, FFEINTRIN_specNONE,},	/* F90 */
  {"MINLOC", "minloc", "MinLoc", FFEINTRIN_genMINLOC, FFEINTRIN_specNONE,},	/* F90 */
  {"MINVAL", "minval", "MinVal", FFEINTRIN_genMINVAL, FFEINTRIN_specNONE,},	/* F90 */
  {"MOD", "mod", "Mod", FFEINTRIN_genMOD, FFEINTRIN_specMOD,},
  {"MODULO", "modulo", "Modulo", FFEINTRIN_genMODULO, FFEINTRIN_specNONE,},	/* F90 */
  {"MVBITS", "mvbits", "MvBits", FFEINTRIN_genMVBITS, FFEINTRIN_specNONE,},	/* F90 */
{"NEAREST", "nearest", "Nearest", FFEINTRIN_genNEAREST, FFEINTRIN_specNONE,},	/* F90 */
  {"NINT", "nint", "NInt", FFEINTRIN_genNINT, FFEINTRIN_specNINT,},
  {"NOT", "not", "Not", FFEINTRIN_genNOT, FFEINTRIN_specNONE,},	/* F2C, F90, VXT */
  {"OR", "or", "Or", FFEINTRIN_genOR, FFEINTRIN_specNONE,},	/* F2C */
  {"PACK", "pack", "Pack", FFEINTRIN_genPACK, FFEINTRIN_specNONE,},	/* F90 */
  {"PRECISION", "precision", "Precision", FFEINTRIN_genPRECISION, FFEINTRIN_specNONE,},	/* F90 */
{"PRESENT", "present", "Present", FFEINTRIN_genPRESENT, FFEINTRIN_specNONE,},	/* F90 */
{"PRODUCT", "product", "Product", FFEINTRIN_genPRODUCT, FFEINTRIN_specNONE,},	/* F90 */
  {"QABS", "qabs", "QAbs", FFEINTRIN_genNONE, FFEINTRIN_specQABS,},	/* VXT */
  {"QACOS", "qacos", "QACos", FFEINTRIN_genNONE, FFEINTRIN_specQACOS,},	/* VXT */
  {"QACOSD", "qacosd", "QACosD", FFEINTRIN_genNONE, FFEINTRIN_specQACOSD,},	/* VXT */
  {"QASIN", "qasin", "QASin", FFEINTRIN_genNONE, FFEINTRIN_specQASIN,},	/* VXT */
  {"QASIND", "qasind", "QASinD", FFEINTRIN_genNONE, FFEINTRIN_specQASIND,},	/* VXT */
  {"QATAN", "qatan", "QATan", FFEINTRIN_genNONE, FFEINTRIN_specQATAN,},	/* VXT */
  {"QATAN2", "qatan2", "QATan2", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2,},	/* VXT */
{"QATAN2D", "qatan2d", "QATan2D", FFEINTRIN_genNONE, FFEINTRIN_specQATAN2D,},	/* VXT */
  {"QATAND", "qatand", "QATanD", FFEINTRIN_genNONE, FFEINTRIN_specQATAND,},	/* VXT */
  {"QCOS", "qcos", "QCos", FFEINTRIN_genNONE, FFEINTRIN_specQCOS,},	/* VXT */
  {"QCOSD", "qcosd", "QCosD", FFEINTRIN_genNONE, FFEINTRIN_specQCOSD,},	/* VXT */
  {"QCOSH", "qcosh", "QCosH", FFEINTRIN_genNONE, FFEINTRIN_specQCOSH,},	/* VXT */
  {"QDIM", "qdim", "QDiM", FFEINTRIN_genNONE, FFEINTRIN_specQDIM,},	/* VXT */
  {"QEXP", "qexp", "QExp", FFEINTRIN_genNONE, FFEINTRIN_specQEXP,},	/* VXT */
  {"QEXT", "qext", "QExt", FFEINTRIN_genQEXT, FFEINTRIN_specQEXT,},	/* VXT */
  {"QEXTD", "qextd", "QExtD", FFEINTRIN_genNONE, FFEINTRIN_specQEXTD,},	/* VXT */
  {"QFLOAT", "qfloat", "QFloat", FFEINTRIN_genQFLOAT, FFEINTRIN_specNONE,},	/* VXT */
  {"QINT", "qint", "QInt", FFEINTRIN_genNONE, FFEINTRIN_specQINT,},	/* VXT */
  {"QLOG", "qlog", "QLog", FFEINTRIN_genNONE, FFEINTRIN_specQLOG,},	/* VXT */
  {"QLOG10", "qlog10", "QLog10", FFEINTRIN_genNONE, FFEINTRIN_specQLOG10,},	/* VXT */
  {"QMAX1", "qmax1", "QMax1", FFEINTRIN_genNONE, FFEINTRIN_specQMAX1,},	/* VXT */
  {"QMIN1", "qmin1", "QMin1", FFEINTRIN_genNONE, FFEINTRIN_specQMIN1,},	/* VXT */
  {"QMOD", "qmod", "QMod", FFEINTRIN_genNONE, FFEINTRIN_specQMOD,},	/* VXT */
  {"QNINT", "qnint", "QNInt", FFEINTRIN_genNONE, FFEINTRIN_specQNINT,},	/* VXT */
  {"QSIN", "qsin", "QSin", FFEINTRIN_genNONE, FFEINTRIN_specQSIN,},	/* VXT */
  {"QSIND", "qsind", "QSinD", FFEINTRIN_genNONE, FFEINTRIN_specQSIND,},	/* VXT */
  {"QSINH", "qsinh", "QSinH", FFEINTRIN_genNONE, FFEINTRIN_specQSINH,},	/* VXT */
  {"QSQRT", "qsqrt", "QSqRt", FFEINTRIN_genNONE, FFEINTRIN_specQSQRT,},	/* VXT */
  {"QTAN", "qtan", "QTan", FFEINTRIN_genNONE, FFEINTRIN_specQTAN,},	/* VXT */
  {"QTAND", "qtand", "QTanD", FFEINTRIN_genNONE, FFEINTRIN_specQTAND,},	/* VXT */
  {"QTANH", "qtanh", "QTanH", FFEINTRIN_genNONE, FFEINTRIN_specQTANH,},	/* VXT */
  {"RADIX", "radix", "Radix", FFEINTRIN_genRADIX, FFEINTRIN_specNONE,},	/* F90 */
  {"RANDOM_NUMBER", "random_number", "Random_Number", FFEINTRIN_genNONE, FFEINTRIN_specRANDOM_NUMBER,},	/* F90 */
  {"RANDOM_SEED", "random_seed", "Random_Seed", FFEINTRIN_genNONE, FFEINTRIN_specRANDOM_SEED,},	/* F90 */
  {"RANGE", "range", "Range", FFEINTRIN_genRANGE, FFEINTRIN_specNONE,},	/* F90 */
  {"REAL", "real", "Real", FFEINTRIN_genREAL, FFEINTRIN_specREAL,},
  {"REPEAT", "repeat", "Repeat", FFEINTRIN_genREPEAT, FFEINTRIN_specNONE,},	/* F90 */
{"RESHAPE", "reshape", "Reshape", FFEINTRIN_genRESHAPE, FFEINTRIN_specNONE,},	/* F90 */
  {"RRSPACING", "rrspacing", "RRSpacing", FFEINTRIN_genRRSPACING, FFEINTRIN_specNONE,},	/* F90 */
  {"RSHIFT", "rshift", "RShift", FFEINTRIN_genRSHIFT, FFEINTRIN_specNONE,},	/* F2C */
  {"SCALE", "scale", "Scale", FFEINTRIN_genSCALE, FFEINTRIN_specNONE,},	/* F90 */
  {"SCAN", "scan", "Scan", FFEINTRIN_genSCAN, FFEINTRIN_specNONE,},	/* F90 */
  {"SELECTED_INT_KIND", "selected_int_kind", "Selected_Int_Kind", FFEINTRIN_genSEL_INT_KIND, FFEINTRIN_specNONE,},	/* F90 */
  {"SELECTED_REAL_KIND", "selected_real_kind", "Selected_Real_Kind", FFEINTRIN_genSEL_REAL_KIND, FFEINTRIN_specNONE,},	/* F90 */
  {"SET_EXPONENT", "set_exponent", "Set_Exponent", FFEINTRIN_genSET_EXPONENT, FFEINTRIN_specNONE,},	/* F90 */
  {"SHAPE", "shape", "Shape", FFEINTRIN_genSHAPE, FFEINTRIN_specNONE,},	/* F90 */
  {"SIGN", "sign", "Sign", FFEINTRIN_genSIGN, FFEINTRIN_specSIGN,},
  {"SIN", "sin", "Sin", FFEINTRIN_genSIN, FFEINTRIN_specSIN,},
  {"SIND", "sind", "SinD", FFEINTRIN_genSIND, FFEINTRIN_specSIND,},	/* VXT */
  {"SINH", "sinh", "SinH", FFEINTRIN_genSINH, FFEINTRIN_specSINH,},
  {"SNGL", "sngl", "Sngl", FFEINTRIN_genNONE, FFEINTRIN_specSNGL,},
  {"SNGLQ", "snglq", "SnglQ", FFEINTRIN_genNONE, FFEINTRIN_specSNGLQ,},	/* VXT */
{"SPACING", "spacing", "Spacing", FFEINTRIN_genSPACING, FFEINTRIN_specNONE,},	/* F90 */
  {"SPREAD", "spread", "Spread", FFEINTRIN_genSPREAD, FFEINTRIN_specNONE,},	/* F90 */
  {"SQRT", "sqrt", "SqRt", FFEINTRIN_genSQRT, FFEINTRIN_specSQRT,},
  {"SUM", "sum", "Sum", FFEINTRIN_genSUM, FFEINTRIN_specNONE,},	/* F90 */
  {"SYSTEM_CLOCK", "system_clock", "System_Clock", FFEINTRIN_genNONE, FFEINTRIN_specSYSTEM_CLOCK,},	/* F90 */
  {"TAN", "tan", "Tan", FFEINTRIN_genTAN, FFEINTRIN_specTAN,},
  {"TAND", "tand", "TanD", FFEINTRIN_genTAND, FFEINTRIN_specTAND,},	/* VXT */
  {"TANH", "tanh", "TanH", FFEINTRIN_genTANH, FFEINTRIN_specTANH,},
  {"TINY", "tiny", "Tiny", FFEINTRIN_genTINY, FFEINTRIN_specNONE,},	/* F90 */
  {"TRANSFER", "transfer", "Transfer", FFEINTRIN_genTRANSFER, FFEINTRIN_specNONE,},	/* F90 */
  {"TRANSPOSE", "transpose", "Transpose", FFEINTRIN_genTRANSPOSE, FFEINTRIN_specNONE,},	/* F90 */
  {"TRIM", "trim", "Trim", FFEINTRIN_genTRIM, FFEINTRIN_specNONE,},	/* F90 */
  {"UBOUND", "ubound", "UBound", FFEINTRIN_genUBOUND, FFEINTRIN_specNONE,},	/* F90 */
  {"UNPACK", "unpack", "Unpack", FFEINTRIN_genUNPACK, FFEINTRIN_specNONE,},	/* F90 */
  {"VERIFY", "verify", "Verify", FFEINTRIN_genVERIFY, FFEINTRIN_specNONE,},	/* F90 */
  {"XOR", "xor", "XOr", FFEINTRIN_genXOR, FFEINTRIN_specNONE,},	/* F2C */
  {"ZABS", "zabs", "ZAbs", FFEINTRIN_genNONE, FFEINTRIN_specZABS,},	/* F2C */
  {"ZCOS", "zcos", "ZCos", FFEINTRIN_genNONE, FFEINTRIN_specZCOS,},	/* F2C */
  {"ZEXP", "zexp", "ZExp", FFEINTRIN_genNONE, FFEINTRIN_specZEXP,},	/* F2C */
  {"ZEXT", "zext", "ZExt", FFEINTRIN_genZEXT, FFEINTRIN_specZEXT,},	/* VXT */
  {"ZLOG", "zlog", "ZLog", FFEINTRIN_genNONE, FFEINTRIN_specZLOG,},	/* F2C */
  {"ZSIN", "zsin", "ZSin", FFEINTRIN_genNONE, FFEINTRIN_specZSIN,},	/* F2C */
  {"ZSQRT", "zsqrt", "ZSqRt", FFEINTRIN_genNONE, FFEINTRIN_specZSQRT,},	/* F2C */
};

static struct _ffeintrin_gen_ ffeintrin_gens_[]
=
{
#define DEFGEN(CODE,NAME,SPEC1,SPEC2,SPEC3,SPEC4,SPEC5,SPEC6, \
  SPEC7,SPEC8,SPEC9,SPEC10,SPEC11,SPEC12,SPEC13,SPEC14) \
  { NAME, { SPEC1, SPEC2, SPEC3, SPEC4, SPEC5, SPEC6, \
    SPEC7, SPEC8, SPEC9, SPEC10, SPEC11, SPEC12, SPEC13, SPEC14, }, },
#define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#include "intrin.def"
#undef DEFGEN
#undef DEFIMP
#undef DEFSPEC
};

static struct _ffeintrin_imp_ ffeintrin_imps_[]
=
{
#define DEFGEN(CODE,NAME,SPEC1,SPEC2,SPEC3,SPEC4,SPEC5,SPEC6, \
  SPEC7,SPEC8,SPEC9,SPEC10,SPEC11,SPEC12,SPEC13,SPEC14)
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \
      { NAME, GFRT, RETURNS, EXPECTS },
#endif
#if FFECOM_targetCURRENT == FFECOM_targetFFE
#define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS) \
      { NAME, RETURNS, EXPECTS },
#endif
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#include "intrin.def"
#undef DEFGEN
#undef DEFIMP
#undef DEFSPEC
};

static struct _ffeintrin_spec_ ffeintrin_specs_[]
=
{
#define DEFGEN(CODE,NAME,SPEC1,SPEC2,SPEC3,SPEC4,SPEC5,SPEC6, \
  SPEC7,SPEC8,SPEC9,SPEC10,SPEC11,SPEC12,SPEC13,SPEC14)
#define DEFIMP(CODE,NAME,GFRT,RETURNS,EXPECTS)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
  { NAME, CALLABLE, FAMILY, IMP, },
#include "intrin.def"
#undef DEFGEN
#undef DEFIMP
#undef DEFSPEC
};


static ffebad
ffeintrin_check_1_ (ffebld arglist, ffebld *xarg1)
{
  ffebld arg1;

  arg1 = arglist;
  if (arg1 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  if (ffebld_trail (arg1) != NULL)
    return FFEBAD_INTRINSIC_TOOMANY;

  if ((arg1 = ffebld_head (arg1)) == NULL)
    return FFEBAD_INTRINSIC_REF;

  *xarg1 = arg1;
  return FFEBAD;
}

static ffebad
ffeintrin_check_1or2_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2)
{
  ffebld arg1;
  ffebld arg2;

  arg1 = arglist;
  if (arg1 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg2 = ffebld_trail (arg1);
  if ((arg2 != NULL)
      && (ffebld_trail (arg2) != NULL))
    return FFEBAD_INTRINSIC_TOOMANY;

  if (((arg1 = ffebld_head (arg1)) == NULL)
      || ((arg2 != NULL)
	  && ((arg2 = ffebld_head (arg2)) == NULL)))
    return FFEBAD_INTRINSIC_REF;

  *xarg1 = arg1;
  *xarg2 = arg2;
  return FFEBAD;
}

static ffebad
ffeintrin_check_2_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2)
{
  ffebld arg1;
  ffebld arg2;

  arg1 = arglist;
  if (arg1 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg2 = ffebld_trail (arg1);
  if (arg2 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  if (ffebld_trail (arg2) != NULL)
    return FFEBAD_INTRINSIC_TOOMANY;

  if (((arg1 = ffebld_head (arg1)) == NULL)
      || ((arg2 = ffebld_head (arg2)) == NULL))
    return FFEBAD_INTRINSIC_REF;

  *xarg1 = arg1;
  *xarg2 = arg2;
  return FFEBAD;
}

static ffebad
ffeintrin_check_3_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2,
		    ffebld *xarg3)
{
  ffebld arg1;
  ffebld arg2;
  ffebld arg3;

  arg1 = arglist;
  if (arg1 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg2 = ffebld_trail (arg1);
  if (arg2 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg3 = ffebld_trail (arg2);
  if (arg3 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  if (ffebld_trail (arg3) != NULL)
    return FFEBAD_INTRINSIC_TOOMANY;

  if (((arg1 = ffebld_head (arg1)) == NULL)
      || ((arg2 = ffebld_head (arg2)) == NULL)
      || ((arg3 = ffebld_head (arg3)) == NULL))
    return FFEBAD_INTRINSIC_REF;

  *xarg1 = arg1;
  *xarg2 = arg2;
  *xarg3 = arg3;
  return FFEBAD;
}

static ffebad
ffeintrin_check_5_ (ffebld arglist, ffebld *xarg1, ffebld *xarg2,
		    ffebld *xarg3, ffebld *xarg4, ffebld *xarg5)
{
  ffebld arg1;
  ffebld arg2;
  ffebld arg3;
  ffebld arg4;
  ffebld arg5;

  arg1 = arglist;
  if (arg1 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg2 = ffebld_trail (arg1);
  if (arg2 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg3 = ffebld_trail (arg2);
  if (arg3 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg4 = ffebld_trail (arg3);
  if (arg4 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  arg5 = ffebld_trail (arg4);
  if (arg5 == NULL)
    return FFEBAD_INTRINSIC_TOOFEW;

  if (ffebld_trail (arg5) != NULL)
    return FFEBAD_INTRINSIC_TOOMANY;

  if (((arg1 = ffebld_head (arg1)) == NULL)
      || ((arg2 = ffebld_head (arg2)) == NULL)
      || ((arg3 = ffebld_head (arg3)) == NULL)
      || ((arg4 = ffebld_head (arg4)) == NULL)
      || ((arg5 = ffebld_head (arg5)) == NULL))
    return FFEBAD_INTRINSIC_REF;

  *xarg1 = arg1;
  *xarg2 = arg2;
  *xarg3 = arg3;
  *xarg4 = arg4;
  *xarg5 = arg5;
  return FFEBAD;
}

static bool
ffeintrin_check_any_ (ffebld arglist)
{
  ffebld item;

  for (; arglist != NULL; arglist = ffebld_trail (arglist))
    {
      item = ffebld_head (arglist);
      if ((item != NULL)
	  && (ffebld_op (item) == FFEBLD_opANY))
	return TRUE;
    }

  return FALSE;
}

static ffebad
ffeintrin_check_char_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_char_2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_cmplx_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_cmplx_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_dcmplx_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_dcmplx_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeCOMPLEX)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_int_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_int_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_int_2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_int_2p_ (ffebld arglist)
{
  ffebld arg;
  ffebldListLength length = 0;
  ffeinfo info;

  for (; arglist != NULL; ++length, arglist = ffebld_trail (arglist))
    {
      if ((arg = ffebld_head (arglist)) == NULL)
	return FFEBAD_INTRINSIC_REF;

      info = ffebld_info (arg);
      if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
	  || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
	  || (ffeinfo_rank (info) != 0)
	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
	return FFEBAD_INTRINSIC_REF;
    }

  if (length < 2)
    return FFEBAD_INTRINSIC_TOOFEW;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_int_3_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffebld arg3;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_3_ (arglist, &arg1, &arg2, &arg3);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg3);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_loc_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  /* See also ffeexpr_finished_, case FFEEXPR_contextLOC_.  */
  info = ffebld_info (arg1);
  if ((ffeinfo_kind (info) != FFEINFO_kindENTITY)
      || ((ffebld_op (arg1) != FFEBLD_opSYMTER)
	  && (ffebld_op (arg1) != FFEBLD_opSUBSTR)
	  && (ffebld_op (arg1) != FFEBLD_opARRAYREF)))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_log_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

#if 0
static ffebad
ffeintrin_check_log_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

#endif
static ffebad
ffeintrin_check_log_2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

#if 0
static ffebad
ffeintrin_check_log_2p_ (ffebld arglist)
{
  ffebld arg;
  ffebldListLength length = 0;
  ffeinfo info;

  for (; arglist != NULL; ++length, arglist = ffebld_trail (arglist))
    {
      if ((arg = ffebld_head (arglist)) == NULL)
	return FFEBAD_INTRINSIC_REF;

      info = ffebld_info (arg);
      if ((ffeinfo_basictype (info) != FFEINFO_basictypeLOGICAL)
	  || (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT)
	  || (ffeinfo_rank (info) != 0)
	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
	return FFEBAD_INTRINSIC_REF;
    }

  if (length < 2)
    return FFEBAD_INTRINSIC_TOOFEW;

  return FFEBAD;		/* Ok. */
}

#endif
static ffebad
ffeintrin_check_mvbits_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffebld arg3;
  ffebld arg4;
  ffebld arg5;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_5_ (arglist, &arg1, &arg2, &arg3, &arg4, &arg5);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg3);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg4);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY)
      || ((ffebld_op (arg4) != FFEBLD_opSYMTER)
	  && (ffebld_op (arg4) != FFEBLD_opARRAYREF)))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg5);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeINTEGER)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_procedure_ (ffeintrinImp imp, ffebldOp op)
{
  bool subr = (ffeintrin_imps_[imp].basictype == FFEINFO_basictypeNONE);

  if ((op == FFEBLD_opSUBRREF) && !subr)
    return FFEBAD_INTRINSIC_IS_FUNC;

  if ((op == FFEBLD_opFUNCREF) && subr)
    return FFEBAD_INTRINSIC_IS_SUBR;

  return FFEBAD;
}

static ffebad
ffeintrin_check_real_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_real_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_real_2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_real_2p_ (ffebld arglist)
{
  ffebld arg;
  ffebldListLength length = 0;
  ffeinfo info;

  for (; arglist != NULL; ++length, arglist = ffebld_trail (arglist))
    {
      if ((arg = ffebld_head (arglist)) == NULL)
	return FFEBAD_INTRINSIC_REF;

      info = ffebld_info (arg);
      if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
	  || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDEFAULT)
	  || (ffeinfo_rank (info) != 0)
	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
	return FFEBAD_INTRINSIC_REF;
    }

  if (length < 2)
    return FFEBAD_INTRINSIC_TOOFEW;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_realdbl_1_ (ffebld arglist)
{
  ffebld arg1;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1_ (arglist, &arg1);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_realdbl_1or2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_1or2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  if (arg2 == NULL)
    return FFEBAD;		/* Ok. */

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_realdbl_2_ (ffebld arglist)
{
  ffebld arg1;
  ffebld arg2;
  ffeinfo info;
  ffebad bad;

  bad = ffeintrin_check_2_ (arglist, &arg1, &arg2);
  if (bad != FFEBAD)
    return bad;

  info = ffebld_info (arg1);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  info = ffebld_info (arg2);
  if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
      || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
      || (ffeinfo_rank (info) != 0)
      || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
    return FFEBAD_INTRINSIC_REF;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_realdbl_2p_ (ffebld arglist)
{
  ffebld arg;
  ffebldListLength length = 0;
  ffeinfo info;

  for (; arglist != NULL; ++length, arglist = ffebld_trail (arglist))
    {
      if ((arg = ffebld_head (arglist)) == NULL)
	return FFEBAD_INTRINSIC_REF;

      info = ffebld_info (arg);
      if ((ffeinfo_basictype (info) != FFEINFO_basictypeREAL)
	  || (ffeinfo_kindtype (info) != FFEINFO_kindtypeREALDOUBLE)
	  || (ffeinfo_rank (info) != 0)
	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY))
	return FFEBAD_INTRINSIC_REF;
    }

  if (length < 2)
    return FFEBAD_INTRINSIC_TOOFEW;

  return FFEBAD;		/* Ok. */
}

static ffebad
ffeintrin_check_void_ (ffebld arglist)
{
  return FFEBAD;		/* Ok. */
}

/* Compare name to intrinsic's name.  Uses strcmp on arguments' names.	*/

static int
ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
{
  char *uc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_uc;
  char *lc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_lc;
  char *ic = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_ic;

  return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic);
}

/* Return basic type of intrinsic implementation.  */

ffeinfoBasictype
ffeintrin_basictype (ffeintrinImp imp)
{
  assert (imp < FFEINTRIN_imp);
  return ffeintrin_imps_[imp].basictype;
}

/* Return family to which specific intrinsic belongs.  */

ffeintrinFamily
ffeintrin_family (ffeintrinSpec spec)
{
  if (spec >= FFEINTRIN_spec)
    return FALSE;
  return ffeintrin_specs_[spec].family;
}

/* Check and fill in info on func/subr ref node.

   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
				// gets it from the modified info structure).
   ffeinfo info;		// Already filled in, will be overwritten.
   ffelexToken token;		// Used for error message.
   ffeintrin_fulfill_generic (&expr, &info, token);

   Based on the generic id, figure out which specific procedure is meant and
   pick that one.  Else return an error, a la _specific.  */

void
ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t)
{
  ffebld symter;
  ffebldOp op;
  ffeintrinGen gen;
  ffeintrinSpec spec = FFEINTRIN_specNONE;
  ffeintrinImp imp;
  ffeintrinSpec tspec;
  ffebad error;
  bool any = FALSE;
  char *name = NULL;
  int i;

  op = ffebld_op (*expr);
  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);

  gen = ffebld_symter_generic (ffebld_left (*expr));
  assert (gen != FFEINTRIN_genNONE);

  imp = FFEINTRIN_impNONE;
  error = FFEBAD;

  for (i = 0;
       (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
       && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
       ++i)
    {
      ffeintrinImp timp = ffeintrin_specs_[tspec].implementation;
      ffeIntrinsicState state
      = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
      ffebad terror;
      char *tname;

      if (state == FFE_intrinsicstateDELETED)
	continue;

      if (timp == FFEINTRIN_impNONE)
	tname = ffeintrin_specs_[tspec].name;
      else
	tname = ffeintrin_imps_[timp].name;

      if (state == FFE_intrinsicstateDISABLED)
	terror = FFEBAD_INTRINSIC_DISABLED;
      else if (timp == FFEINTRIN_impNONE)
	terror = FFEBAD_INTRINSIC_UNIMPL;
      else
	{
	  terror = ffeintrin_check_procedure_ (timp, ffebld_op (*expr));
	  if (terror == FFEBAD)
	    {
	      any = ffeintrin_check_any_ (ffebld_right (*expr));
	      if (!any)
		terror = (*ffeintrin_imps_[timp].check) (ffebld_right (*expr));
	    }
	  if (!any && (terror == FFEBAD) && (timp != imp))
	    {
	      if (imp != FFEINTRIN_impNONE)
		{
		  ffebad_start (FFEBAD_INTRINSIC_AMBIG);
		  ffebad_here (0, ffelex_token_where_line (t),
			       ffelex_token_where_column (t));
		  ffebad_string (ffeintrin_gens_[gen].name);
		  ffebad_string (ffeintrin_specs_[spec].name);
		  ffebad_string (ffeintrin_specs_[tspec].name);
		  ffebad_finish ();
		}
	      else
		{
		  imp = timp;
		  spec = tspec;
		  error = terror;
		}
	    }
	  else if (!any && (terror != FFEBAD))
	    {			/* This error has precedence over others. */
	      if ((error == FFEBAD_INTRINSIC_DISABLED)
		  || (error == FFEBAD_INTRINSIC_UNIMPL))
		error = FFEBAD;
	    }
	}

      if (!any && (error == FFEBAD))
	{
	  error = terror;
	  name = tname;
	}
    }

  if (any || (imp == FFEINTRIN_impNONE))
    {
      if (!any)
	{
	  if (error == FFEBAD)
	    error = FFEBAD_INTRINSIC_REF;
	  if (name == NULL)
	    name = ffeintrin_gens_[gen].name;
	  ffebad_start (error);
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  ffebad_string (name);
	  ffebad_finish ();
	}

      *expr = ffebld_new_any ();
      *info = ffeinfo_new_any ();
    }
  else
    {
      *info = ffeinfo_new (ffeintrin_imps_[imp].basictype,
			   ffeintrin_imps_[imp].kindtype,
			   0,
			   FFEINFO_kindENTITY,
			   FFEINFO_whereFLEETING,
			   ffeintrin_imps_[imp].size);
      symter = ffebld_left (*expr);
      ffebld_symter_set_specific (symter, spec);
      ffebld_symter_set_implementation (symter, imp);
      ffebld_set_info (symter,
		       ffeinfo_new (ffeintrin_imps_[imp].basictype,
				    ffeintrin_imps_[imp].kindtype,
				    0,
				    (ffeintrin_imps_[imp].basictype
				     == FFEINFO_basictypeNONE)
				    ? FFEINFO_kindSUBROUTINE
				    : FFEINFO_kindFUNCTION,
				    FFEINFO_whereINTRINSIC,
				    ffeintrin_imps_[imp].size));
    }
}

/* Check and fill in info on func/subr ref node.

   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
				// gets it from the modified info structure).
   ffeinfo info;		// Already filled in, will be overwritten.
   ffelexToken token;		// Used for error message.
   ffeintrin_fulfill_specific (&expr, &info, token);

   Based on the specific id, determine whether the arg list is valid
   (number, type, rank, and kind of args) and fill in the info structure
   accordingly.	 Currently don't rewrite the expression, but perhaps
   someday do so for constant collapsing, except when an error occurs,
   in which case it is overwritten with ANY and info is also overwritten
   accordingly.	 */

void
ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info, ffelexToken t)
{
  ffebld symter;
  ffebldOp op;
  ffeintrinSpec spec;
  ffeintrinImp imp;
  ffeIntrinsicState state;
  ffebad error;
  bool any = FALSE;

  op = ffebld_op (*expr);
  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);

  spec = ffebld_symter_specific (ffebld_left (*expr));
  assert (spec != FFEINTRIN_specNONE);

  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);

  imp = ffeintrin_specs_[spec].implementation;

  if (state == FFE_intrinsicstateDISABLED)
    error = FFEBAD_INTRINSIC_DISABLED;
  else if (imp == FFEINTRIN_impNONE)
    error = FFEBAD_INTRINSIC_UNIMPL;
  else
    {
      error = ffeintrin_check_procedure_ (imp, ffebld_op (*expr));
      if (error == FFEBAD)
	{
	  any = ffeintrin_check_any_ (ffebld_right (*expr));
	  if (!any)
	    error = (*ffeintrin_imps_[imp].check) (ffebld_right (*expr));
	}
    }

  if (any || (error != FFEBAD))
    {
      char *name;

      if (!any)
	{
	  ffebad_start (error);
	  ffebad_here (0, ffelex_token_where_line (t),
		       ffelex_token_where_column (t));
	  if (imp == FFEINTRIN_impNONE)
	    name = ffeintrin_specs_[spec].name;
	  else
	    name = ffeintrin_imps_[imp].name;
	  ffebad_string (name);
	  ffebad_finish ();
	}

      *expr = ffebld_new_any ();
      *info = ffeinfo_new_any ();
    }
  else
    {
      *info = ffeinfo_new (ffeintrin_imps_[imp].basictype,
			   ffeintrin_imps_[imp].kindtype,
			   0,
			   FFEINFO_kindENTITY,
			   FFEINFO_whereFLEETING,
			   ffeintrin_imps_[imp].size);
      symter = ffebld_left (*expr);
      ffebld_set_info (symter,
		       ffeinfo_new (ffeintrin_imps_[imp].basictype,
				    ffeintrin_imps_[imp].kindtype,
				    0,
				    (ffeintrin_imps_[imp].basictype
				     == FFEINFO_basictypeNONE)
				    ? FFEINFO_kindSUBROUTINE
				    : FFEINFO_kindFUNCTION,
				    FFEINFO_whereINTRINSIC,
				    ffeintrin_imps_[imp].size));
    }
}

/* Return run-time index of intrinsic implementation as arg.  */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecomGfrt
ffeintrin_gfrt (ffeintrinImp imp)
{
  assert (imp < FFEINTRIN_imp);
  return ffeintrin_imps_[imp].gfrt;
}

#endif
void
ffeintrin_init_0 ()
{
  int i;
  char *p1;
  char *p2;
  char *p3;

  assert (FFEINTRIN_gen == ARRAY_SIZE (ffeintrin_gens_));
  assert (FFEINTRIN_imp == ARRAY_SIZE (ffeintrin_imps_));
  assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_));

  for (i = 1; i < ARRAY_SIZE (ffeintrin_names_); ++i)
    {				/* Make sure binary-searched list is in alpha
				   order. */
      if (strcmp (ffeintrin_names_[i - 1].name_uc,
		  ffeintrin_names_[i].name_uc) >= 0)
	assert ("name list out of order" == NULL);
    }

  for (i = 0; i < ARRAY_SIZE (ffeintrin_names_); ++i)
    {
      p1 = ffeintrin_names_[i].name_uc;
      p2 = ffeintrin_names_[i].name_lc;
      p3 = ffeintrin_names_[i].name_ic;
      for (; *p1 != '\0' && *p2 != '\0' && *p3 != '\0'; ++p1, ++p2, ++p3)
	{
	  if (!isascii (*p1) || !isascii (*p2) || !isascii (*p3))
	    break;
	  if ((isdigit (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
	    continue;
	  if (!isupper (*p1) || !islower (*p2)
	      || (*p1 != toupper (*p2)) || ((*p3 != *p1) && (*p3 != *p2)))
	    break;
	}
      assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
    }
}

/* Determine whether intrinsic ok as actual arg.  */

bool
ffeintrin_is_actualarg (ffeintrinSpec spec)
{
  ffeIntrinsicState state;

  if (spec >= FFEINTRIN_spec)
    return FALSE;

  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);

  return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg)
#if FFECOM_targetCURRENT == FFECOM_targetGCC
    && (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt
	!= FFECOM_gfrt)
#endif
    && ((state == FFE_intrinsicstateENABLED)
	|| (state == FFE_intrinsicstateHIDDEN));
}

/* Determine if name is intrinsic, return info.

   char *name;			// C-string name of possible intrinsic.
   ffelexToken t;		// NULL if no diagnostic to be given.
   bool explicit;		// TRUE if INTRINSIC name.
   ffeintrinGen gen;		// (TRUE only) Generic id of intrinsic.
   ffeintrinSpec spec;		// (TRUE only) Specific id of intrinsic.
   ffeintrinImp imp;		// (TRUE only) Implementation id of intrinsic.
   ffeinfoKind kind;		// (TRUE:) kindFUNCTION, kindSUBROUTINE,
				// or kindNONE; (FALSE:) kindANY, kindNONE.
   if (ffeintrin_is_intrinsic (name, t, &gen, &spec, &imp, &kind))
				// is an intrinsic, use gen, spec, imp, and
				// kind accordingly.

   If FALSE is returned, kindANY says that the intrinsic exists but is
   not valid for some reason (disabled or unimplemented), in which case a
   diagnostic was generated (assuming t == NULL).  */

bool
ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit,
			ffeintrinGen *xgen, ffeintrinSpec *xspec,
			ffeintrinImp *ximp, ffeinfoKind *xkind)
{
  struct _ffeintrin_name_ *intrinsic;
  ffeintrinGen gen;
  ffeintrinSpec spec;
  ffeintrinImp imp;
  ffeinfoKind kind;
  ffeIntrinsicState state;
  bool disabled = FALSE;
  bool unimpl = FALSE;

  intrinsic = bsearch (name, &ffeintrin_names_[0],
		       ARRAY_SIZE (ffeintrin_names_),
		       sizeof (struct _ffeintrin_name_),
		         (void *) ffeintrin_cmp_name_);

  if (intrinsic == NULL)
    return FALSE;

  gen = intrinsic->generic;
  spec = intrinsic->specific;
  imp = ffeintrin_specs_[spec].implementation;

  /* Generic is okay only if at least one of its specifics is okay.  */

  if (gen != FFEINTRIN_genNONE)
    {
      int i;
      ffeintrinSpec tspec;
      bool ok = FALSE;

      for (i = 0;
	   (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
	   && ((tspec
		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
	   ++i)
	{
	  state = ffeintrin_state_family (ffeintrin_specs_[tspec].family);

	  if (state == FFE_intrinsicstateDELETED)
	    continue;

	  if (state == FFE_intrinsicstateDISABLED)
	    {
	      disabled = TRUE;
	      continue;
	    }

	  if (ffeintrin_specs_[tspec].implementation == FFEINTRIN_impNONE)
	    {
	      unimpl = TRUE;
	      continue;
	    }

	  if ((state == FFE_intrinsicstateENABLED)
	      || (explicit
		  && (state == FFE_intrinsicstateHIDDEN)))
	    {
	      ok = TRUE;
	      break;
	    }
	}
      if (!ok)
	gen = FFEINTRIN_genNONE;
    }

  /* Specific is okay only if not: unimplemented, disabled, deleted, or
     hidden and not explicit.  */

  if (spec != FFEINTRIN_specNONE)
    {
      if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family))
	   == FFE_intrinsicstateDELETED)
	  || (!explicit
	      && (state == FFE_intrinsicstateHIDDEN)))
	spec = FFEINTRIN_specNONE;
      else if (state == FFE_intrinsicstateDISABLED)
	{
	  disabled = TRUE;
	  spec = FFEINTRIN_specNONE;
	}
      else if (imp == FFEINTRIN_impNONE)
	{
	  unimpl = TRUE;
	  spec = FFEINTRIN_specNONE;
	}
    }

  /* If neither is okay, not an intrinsic.  */

  if ((gen == FFEINTRIN_genNONE) && (spec == FFEINTRIN_specNONE))
    {
      /* Here is where we produce a diagnostic about a reference to a
         disabled or unimplemented intrinsic, if the diagnostic is desired.  */

      if ((disabled || unimpl)
	  && (t != NULL))
	{
	  ffebad_start (disabled
			? FFEBAD_INTRINSIC_DISABLED
			: FFEBAD_INTRINSIC_UNIMPL);
	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
	  ffebad_string (name);
	  ffebad_finish ();
	}

      if (disabled || unimpl)
	*xkind = FFEINFO_kindANY;
      else
	*xkind = FFEINFO_kindNONE;
      return FALSE;
    }

  /* Determine whether intrinsic is function or subroutine.  If no specific
     id, scan list of possible specifics for generic to get consensus.  Must
     be unanimous, at least for now.  */

  if (spec == FFEINTRIN_specNONE)
    {
      int i;
      ffeintrinSpec tspec;
      ffeintrinImp timp;
      ffeinfoKind tkind;

      kind = FFEINFO_kindNONE;

      for (i = 0;
	   (i < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
	   && ((tspec
		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
	   ++i)
	{
	  if ((timp = ffeintrin_specs_[tspec].implementation)
	      == FFEINTRIN_impNONE)
	    continue;

	  if (ffeintrin_imps_[timp].basictype == FFEINFO_basictypeNONE)
	    tkind = FFEINFO_kindSUBROUTINE;
	  else
	    tkind = FFEINFO_kindFUNCTION;

	  if ((kind == tkind) || (kind == FFEINFO_kindNONE))
	    kind = tkind;
	  else
	    assert ("what kind of proc am i?" == NULL);
	}
    }
  else				/* Have specific, use that. */
    kind
      = (ffeintrin_imps_[imp].basictype == FFEINFO_basictypeNONE)
      ? FFEINFO_kindSUBROUTINE
      : FFEINFO_kindFUNCTION;

  *xgen = gen;
  *xspec = spec;
  *ximp = imp;
  *xkind = kind;
  return TRUE;
}

/* Return kind type of intrinsic implementation.  */

ffeinfoKindtype
ffeintrin_kindtype (ffeintrinImp imp)
{
  assert (imp < FFEINTRIN_imp);
  return ffeintrin_imps_[imp].kindtype;
}

/* Return name of generic intrinsic.  */

char *
ffeintrin_name_generic (ffeintrinGen gen)
{
  assert (gen < FFEINTRIN_gen);
  return ffeintrin_gens_[gen].name;
}

/* Return name of intrinsic implementation.  */

char *
ffeintrin_name_implementation (ffeintrinImp imp)
{
  assert (imp < FFEINTRIN_imp);
  return ffeintrin_imps_[imp].name;
}

/* Return external/internal name of specific intrinsic.	 */

char *
ffeintrin_name_specific (ffeintrinSpec spec)
{
  assert (spec < FFEINTRIN_spec);
  return ffeintrin_specs_[spec].name;
}

/* Return state of family.  */

ffeIntrinsicState
ffeintrin_state_family (ffeintrinFamily family)
{
  ffeIntrinsicState state;

  switch (family)
    {
    case FFEINTRIN_familyNONE:
      return FFE_intrinsicstateDELETED;

    case FFEINTRIN_familyF77:
      return FFE_intrinsicstateENABLED;

    case FFEINTRIN_familyASC:
      state = ffe_intrinsic_state_f2c ();
      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
      return state;

    case FFEINTRIN_familyMIL:
      state = ffe_intrinsic_state_vxt ();
      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
      state = ffe_state_max (state, ffe_intrinsic_state_mil ());
      return state;

    case FFEINTRIN_familyDCP:
      state = ffe_intrinsic_state_vxt ();
      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
      state = ffe_state_max (state, ffe_intrinsic_state_dcp ());
      return state;

    case FFEINTRIN_familyF90:
      state = ffe_intrinsic_state_f90 ();
      return state;

    case FFEINTRIN_familyVXT:
      state = ffe_intrinsic_state_vxt ();
      return state;

    case FFEINTRIN_familyFVZ:
      state = ffe_intrinsic_state_f2c ();
      state = ffe_state_max (state, ffe_intrinsic_state_vxt ());
      state = ffe_state_max (state, ffe_intrinsic_state_dcp ());
      return state;

    case FFEINTRIN_familyF2C:
      state = ffe_intrinsic_state_f2c ();
      return state;

    case FFEINTRIN_familyF2Z:
      state = ffe_intrinsic_state_f2c ();
      return state;

    default:
      assert ("bad family" == NULL);
      return FFE_intrinsicstateDELETED;
    }
}
