mirror/freebsd
1
0
Fork 0
mirror of https://git.FreeBSD.org/src.git synced 2024-12-21 11:13:30 +00:00
Code Issues Releases Activity
4af42c2cb1
freebsd/contrib/gcc/f/intrin.c

2120 lines
51 KiB
C
Raw Normal View History

Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
/* intrin.c -- Recognize references to intrinsics
Gcc 3.4.2 20040728.
2004-07-28 03:11:36 +00:00
Copyright (C) 1995, 1996, 1997, 1998, 2002,
2003 Free Software Foundation, Inc.
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
Contributed by James Craig Burley.
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.
*/
#include "proj.h"
#include "intrin.h"
#include "expr.h"
#include "info.h"
#include "src.h"
#include "symbol.h"
#include "target.h"
#include "top.h"
struct _ffeintrin_name_
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const char *const name_uc;
const char *const name_lc;
const char *const name_ic;
const ffeintrinGen generic;
const ffeintrinSpec specific;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
struct _ffeintrin_gen_
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const char *const name; /* Name as seen in program. */
const ffeintrinSpec specs[2];
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
struct _ffeintrin_spec_
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const char *const name; /* Uppercase name as seen in source code,
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
lowercase if no source name, "none" if no
name at all (NONE case). */
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
const ffeintrinFamily family;
const ffeintrinImp implementation;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
struct _ffeintrin_imp_
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const char *const name; /* Name of implementation. */
const ffecomGfrt gfrt_direct;/* library routine, direct-callable form. */
const ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */
const ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */
const char *const control;
const char y2kbad;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
ffebld args, ffeinfoBasictype *xbt,
ffeinfoKindtype *xkt,
ffetargetCharacterSize *xsz,
bool *check_intrin,
ffelexToken t,
bool commit);
static bool ffeintrin_check_any_ (ffebld arglist);
static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic);
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
static const struct _ffeintrin_name_ ffeintrin_names_[]
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
=
{ /* Alpha order. */
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
{ UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#undef DEFIMPY
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
static const struct _ffeintrin_gen_ ffeintrin_gens_[]
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
=
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
{ NAME, { SPEC1, SPEC2, }, },
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#undef DEFIMPY
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
static const struct _ffeintrin_imp_ ffeintrin_imps_[]
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
=
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
FFECOM_gfrt ## GFRTGNU, CONTROL, FALSE },
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
{ NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
FFECOM_gfrt ## GFRTGNU, CONTROL, Y2KBAD },
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#undef DEFIMPY
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
static const struct _ffeintrin_spec_ ffeintrin_specs_[]
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
=
{
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
{ NAME, CALLABLE, FAMILY, IMP, },
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
#include "intrin.def"
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
#undef DEFIMPY
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
};
static ffebad
ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
ffebld args, ffeinfoBasictype *xbt,
ffeinfoKindtype *xkt,
ffetargetCharacterSize *xsz,
bool *check_intrin,
ffelexToken t,
bool commit)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *c = ffeintrin_imps_[imp].control;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
bool subr = (c[0] == '-');
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *argc;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffebld arg;
ffeinfoBasictype bt;
ffeinfoKindtype kt;
ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
ffeinfoKindtype firstarg_kt;
bool need_col;
ffeinfoBasictype col_bt = FFEINFO_basictypeNONE;
ffeinfoKindtype col_kt = FFEINFO_kindtypeNONE;
int colon = (c[2] == ':') ? 2 : 3;
int argno;
/* Check procedure type (function vs. subroutine) against
invocation. */
if (op == FFEBLD_opSUBRREF)
{
if (!subr)
return FFEBAD_INTRINSIC_IS_FUNC;
}
else if (op == FFEBLD_opFUNCREF)
{
if (subr)
return FFEBAD_INTRINSIC_IS_SUBR;
}
else
return FFEBAD_INTRINSIC_REF;
/* Check the arglist for validity. */
if ((args != NULL)
&& (ffebld_head (args) != NULL))
firstarg_kt = ffeinfo_kindtype (ffebld_info (ffebld_head (args)));
else
firstarg_kt = FFEINFO_kindtype;
for (argc = &c[colon + 3],
arg = args;
*argc != '\0';
)
{
char optional = '\0';
char required = '\0';
char extra = '\0';
char basic;
char kind;
int length;
int elements;
bool lastarg_complex = FALSE;
/* We don't do anything with keywords yet. */
do
{
} while (*(++argc) != '=');
++argc;
if ((*argc == '?')
|| (*argc == '!')
|| (*argc == '*'))
optional = *(argc++);
if ((*argc == '+')
|| (*argc == 'n')
|| (*argc == 'p'))
required = *(argc++);
basic = *(argc++);
kind = *(argc++);
if (*argc == '[')
{
length = *++argc - '0';
if (*++argc != ']')
length = 10 * length + (*(argc++) - '0');
++argc;
}
else
length = -1;
if (*argc == '(')
{
elements = *++argc - '0';
if (*++argc != ')')
elements = 10 * elements + (*(argc++) - '0');
++argc;
}
else if (*argc == '&')
{
elements = -1;
++argc;
}
else
elements = 0;
if ((*argc == '&')
|| (*argc == 'i')
|| (*argc == 'w')
|| (*argc == 'x'))
extra = *(argc++);
if (*argc == ',')
++argc;
/* Break out of this loop only when current arg spec completely
processed. */
do
{
bool okay;
ffebld a;
ffeinfo i;
bool anynum;
ffeinfoBasictype abt = FFEINFO_basictypeNONE;
ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
if ((arg == NULL)
|| (ffebld_head (arg) == NULL))
{
if (required != '\0')
return FFEBAD_INTRINSIC_TOOFEW;
if (optional == '\0')
return FFEBAD_INTRINSIC_TOOFEW;
if (arg != NULL)
arg = ffebld_trail (arg);
break; /* Try next argspec. */
}
a = ffebld_head (arg);
i = ffebld_info (a);
anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
/* See how well the arg matches up to the spec. */
switch (basic)
{
case 'A':
okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
&& ((length == -1)
|| (ffeinfo_size (i) == (ffetargetCharacterSize) length));
break;
case 'C':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
abt = FFEINFO_basictypeCOMPLEX;
break;
case 'I':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
abt = FFEINFO_basictypeINTEGER;
break;
case 'L':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
abt = FFEINFO_basictypeLOGICAL;
break;
case 'R':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
abt = FFEINFO_basictypeREAL;
break;
case 'B':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
break;
case 'F':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'N':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'S':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'g':
okay = ((ffebld_op (a) == FFEBLD_opLABTER)
|| (ffebld_op (a) == FFEBLD_opLABTOK));
elements = -1;
extra = '-';
break;
case 's':
okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
&& (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
&& (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
&& (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
&& (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
&& ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
|| (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
&& (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
elements = -1;
extra = '-';
break;
case '-':
default:
okay = TRUE;
break;
}
switch (kind)
{
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
akt = (kind - '0');
if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
{
switch (akt)
{ /* Translate to internal kinds for now! */
default:
break;
case 2:
akt = 4;
break;
case 3:
akt = 2;
break;
case 4:
akt = 5;
break;
case 6:
akt = 3;
break;
case 7:
akt = ffecom_pointer_kind ();
break;
}
}
okay &= anynum || (ffeinfo_kindtype (i) == akt);
break;
case 'A':
okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
: firstarg_kt;
break;
Gcc 3.1.0 pre-release from the FSF anoncvs repo on 9-May-2002 15:57:15 EDT.
2002-05-09 20:02:13 +00:00
case 'N':
/* Accept integers and logicals not wider than the default integer/logical. */
if (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
{
okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER1
|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER2
|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER3);
akt = FFEINFO_kindtypeINTEGER1; /* The default. */
}
else if (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL)
{
okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL1
|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL2
|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL3);
akt = FFEINFO_kindtypeLOGICAL1; /* The default. */
}
break;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
case '*':
default:
break;
}
switch (elements)
{
ffebld b;
case -1:
break;
case 0:
if (ffeinfo_rank (i) != 0)
okay = FALSE;
break;
default:
if ((ffeinfo_rank (i) != 1)
|| (ffebld_op (a) != FFEBLD_opSYMTER)
|| ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
|| (ffebld_op (b) != FFEBLD_opCONTER)
|| (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
|| (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
|| (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
okay = FALSE;
break;
}
switch (extra)
{
case '&':
if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
|| ((ffebld_op (a) != FFEBLD_opSYMTER)
&& (ffebld_op (a) != FFEBLD_opSUBSTR)
&& (ffebld_op (a) != FFEBLD_opARRAYREF)))
okay = FALSE;
break;
case 'w':
case 'x':
if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
|| ((ffebld_op (a) != FFEBLD_opSYMTER)
&& (ffebld_op (a) != FFEBLD_opARRAYREF)
&& (ffebld_op (a) != FFEBLD_opSUBSTR)))
okay = FALSE;
break;
case '-':
case 'i':
break;
default:
if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
okay = FALSE;
break;
}
if ((optional == '!')
&& lastarg_complex)
okay = FALSE;
if (!okay)
{
/* If it wasn't optional, it's an error,
else maybe it could match a later argspec. */
if (optional == '\0')
return FFEBAD_INTRINSIC_REF;
break; /* Try next argspec. */
}
lastarg_complex
= (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
if (anynum)
{
/* If we know dummy arg type, convert to that now. */
if ((abt != FFEINFO_basictypeNONE)
&& (akt != FFEINFO_kindtypeNONE)
&& commit)
{
/* We have a known type, convert hollerith/typeless
to it. */
a = ffeexpr_convert (a, t, NULL,
abt, akt, 0,
FFETARGET_charactersizeNONE,
FFEEXPR_contextLET);
ffebld_set_head (arg, a);
}
}
arg = ffebld_trail (arg); /* Arg accepted, now move on. */
if (optional == '*')
continue; /* Go ahead and try another arg. */
if (required == '\0')
break;
if ((required == 'n')
|| (required == '+'))
{
optional = '*';
required = '\0';
}
else if (required == 'p')
required = 'n';
} while (TRUE);
}
if (arg != NULL)
return FFEBAD_INTRINSIC_TOOMANY;
/* Set up the initial type for the return value of the function. */
need_col = FALSE;
switch (c[0])
{
case 'A':
bt = FFEINFO_basictypeCHARACTER;
sz = (c[2] == '*') ? FFETARGET_charactersizeNONE : 1;
break;
case 'C':
bt = FFEINFO_basictypeCOMPLEX;
break;
case 'I':
bt = FFEINFO_basictypeINTEGER;
break;
case 'L':
bt = FFEINFO_basictypeLOGICAL;
break;
case 'R':
bt = FFEINFO_basictypeREAL;
break;
case 'B':
case 'F':
case 'N':
case 'S':
need_col = TRUE;
/* Fall through. */
case '-':
default:
bt = FFEINFO_basictypeNONE;
break;
}
switch (c[1])
{
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
kt = (c[1] - '0');
if ((bt == FFEINFO_basictypeINTEGER)
|| (bt == FFEINFO_basictypeLOGICAL))
{
switch (kt)
{ /* Translate to internal kinds for now! */
default:
break;
case 2:
kt = 4;
break;
case 3:
kt = 2;
break;
case 4:
kt = 5;
break;
case 6:
kt = 3;
break;
case 7:
kt = ffecom_pointer_kind ();
break;
}
}
break;
case 'C':
if (ffe_is_90 ())
need_col = TRUE;
kt = 1;
break;
case '=':
need_col = TRUE;
/* Fall through. */
case '-':
default:
kt = FFEINFO_kindtypeNONE;
break;
}
/* Determine collective type of COL, if there is one. */
if (need_col || c[colon + 1] != '-')
{
bool okay = TRUE;
bool have_anynum = FALSE;
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
int arg_count=0;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
for (arg = args, arg_count=0;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
arg != NULL;
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
arg = ffebld_trail (arg), arg_count++ )
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
{
ffebld a = ffebld_head (arg);
ffeinfo i;
bool anynum;
if (a == NULL)
continue;
i = ffebld_info (a);
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
if ( c[colon+1] != '*' && (c[colon+1]-'0') != arg_count )
continue;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
if (anynum)
{
have_anynum = TRUE;
continue;
}
if ((col_bt == FFEINFO_basictypeNONE)
&& (col_kt == FFEINFO_kindtypeNONE))
{
col_bt = ffeinfo_basictype (i);
col_kt = ffeinfo_kindtype (i);
}
else
{
ffeexpr_type_combine (&col_bt, &col_kt,
col_bt, col_kt,
ffeinfo_basictype (i),
ffeinfo_kindtype (i),
NULL);
if ((col_bt == FFEINFO_basictypeNONE)
|| (col_kt == FFEINFO_kindtypeNONE))
return FFEBAD_INTRINSIC_REF;
}
}
if (have_anynum
&& ((col_bt == FFEINFO_basictypeNONE)
|| (col_kt == FFEINFO_kindtypeNONE)))
{
/* No type, but have hollerith/typeless. Use type of return
value to determine type of COL. */
switch (c[0])
{
case 'A':
return FFEBAD_INTRINSIC_REF;
case 'B':
case 'I':
case 'L':
if ((col_bt != FFEINFO_basictypeNONE)
&& (col_bt != FFEINFO_basictypeINTEGER))
return FFEBAD_INTRINSIC_REF;
/* Fall through. */
case 'N':
case 'S':
case '-':
default:
col_bt = FFEINFO_basictypeINTEGER;
col_kt = FFEINFO_kindtypeINTEGER1;
break;
case 'C':
if ((col_bt != FFEINFO_basictypeNONE)
&& (col_bt != FFEINFO_basictypeCOMPLEX))
return FFEBAD_INTRINSIC_REF;
col_bt = FFEINFO_basictypeCOMPLEX;
col_kt = FFEINFO_kindtypeREAL1;
break;
case 'R':
if ((col_bt != FFEINFO_basictypeNONE)
&& (col_bt != FFEINFO_basictypeREAL))
return FFEBAD_INTRINSIC_REF;
/* Fall through. */
case 'F':
col_bt = FFEINFO_basictypeREAL;
col_kt = FFEINFO_kindtypeREAL1;
break;
}
}
switch (c[0])
{
case 'B':
okay = (col_bt == FFEINFO_basictypeINTEGER)
|| (col_bt == FFEINFO_basictypeLOGICAL);
if (need_col)
bt = col_bt;
break;
case 'F':
okay = (col_bt == FFEINFO_basictypeCOMPLEX)
|| (col_bt == FFEINFO_basictypeREAL);
if (need_col)
bt = col_bt;
break;
case 'N':
okay = (col_bt == FFEINFO_basictypeCOMPLEX)
|| (col_bt == FFEINFO_basictypeINTEGER)
|| (col_bt == FFEINFO_basictypeREAL);
if (need_col)
bt = col_bt;
break;
case 'S':
okay = (col_bt == FFEINFO_basictypeINTEGER)
|| (col_bt == FFEINFO_basictypeREAL)
|| (col_bt == FFEINFO_basictypeCOMPLEX);
if (need_col)
bt = ((col_bt != FFEINFO_basictypeCOMPLEX) ? col_bt
: FFEINFO_basictypeREAL);
break;
}
switch (c[1])
{
case '=':
if (need_col)
kt = col_kt;
break;
case 'C':
if (col_bt == FFEINFO_basictypeCOMPLEX)
{
if (col_kt != FFEINFO_kindtypeREALDEFAULT)
*check_intrin = TRUE;
if (need_col)
kt = col_kt;
}
break;
}
if (!okay)
return FFEBAD_INTRINSIC_REF;
}
/* Now, convert args in the arglist to the final type of the COL. */
for (argno = 0, argc = &c[colon + 3],
arg = args;
*argc != '\0';
++argno)
{
char optional = '\0';
char required = '\0';
char extra = '\0';
char basic;
char kind;
int length;
int elements;
bool lastarg_complex = FALSE;
/* We don't do anything with keywords yet. */
do
{
} while (*(++argc) != '=');
++argc;
if ((*argc == '?')
|| (*argc == '!')
|| (*argc == '*'))
optional = *(argc++);
if ((*argc == '+')
|| (*argc == 'n')
|| (*argc == 'p'))
required = *(argc++);
basic = *(argc++);
kind = *(argc++);
if (*argc == '[')
{
length = *++argc - '0';
if (*++argc != ']')
length = 10 * length + (*(argc++) - '0');
++argc;
}
else
length = -1;
if (*argc == '(')
{
elements = *++argc - '0';
if (*++argc != ')')
elements = 10 * elements + (*(argc++) - '0');
++argc;
}
else if (*argc == '&')
{
elements = -1;
++argc;
}
else
elements = 0;
if ((*argc == '&')
|| (*argc == 'i')
|| (*argc == 'w')
|| (*argc == 'x'))
extra = *(argc++);
if (*argc == ',')
++argc;
/* Break out of this loop only when current arg spec completely
processed. */
do
{
bool okay;
ffebld a;
ffeinfo i;
bool anynum;
ffeinfoBasictype abt = FFEINFO_basictypeNONE;
ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
if ((arg == NULL)
|| (ffebld_head (arg) == NULL))
{
if (arg != NULL)
arg = ffebld_trail (arg);
break; /* Try next argspec. */
}
a = ffebld_head (arg);
i = ffebld_info (a);
anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
/* Determine what the default type for anynum would be. */
if (anynum)
{
switch (c[colon + 1])
{
case '-':
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
if (argno != (c[colon + 1] - '0'))
break;
case '*':
abt = col_bt;
akt = col_kt;
break;
}
}
/* Again, match arg up to the spec. We go through all of
this again to properly follow the contour of optional
arguments. Probably this level of flexibility is not
needed, perhaps it's even downright naughty. */
switch (basic)
{
case 'A':
okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
&& ((length == -1)
|| (ffeinfo_size (i) == (ffetargetCharacterSize) length));
break;
case 'C':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
abt = FFEINFO_basictypeCOMPLEX;
break;
case 'I':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
abt = FFEINFO_basictypeINTEGER;
break;
case 'L':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
abt = FFEINFO_basictypeLOGICAL;
break;
case 'R':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
abt = FFEINFO_basictypeREAL;
break;
case 'B':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
break;
case 'F':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'N':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'S':
okay = anynum
|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
break;
case 'g':
okay = ((ffebld_op (a) == FFEBLD_opLABTER)
|| (ffebld_op (a) == FFEBLD_opLABTOK));
elements = -1;
extra = '-';
break;
case 's':
okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
&& (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
&& (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
&& (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
&& (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
&& ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
|| (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
&& (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
elements = -1;
extra = '-';
break;
case '-':
default:
okay = TRUE;
break;
}
switch (kind)
{
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
akt = (kind - '0');
if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
{
switch (akt)
{ /* Translate to internal kinds for now! */
default:
break;
case 2:
akt = 4;
break;
case 3:
akt = 2;
break;
case 4:
akt = 5;
break;
case 6:
akt = 3;
break;
case 7:
akt = ffecom_pointer_kind ();
break;
}
}
okay &= anynum || (ffeinfo_kindtype (i) == akt);
break;
case 'A':
okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
: firstarg_kt;
break;
case '*':
default:
break;
}
switch (elements)
{
ffebld b;
case -1:
break;
case 0:
if (ffeinfo_rank (i) != 0)
okay = FALSE;
break;
default:
if ((ffeinfo_rank (i) != 1)
|| (ffebld_op (a) != FFEBLD_opSYMTER)
|| ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
|| (ffebld_op (b) != FFEBLD_opCONTER)
|| (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
|| (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
|| (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
okay = FALSE;
break;
}
switch (extra)
{
case '&':
if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
|| ((ffebld_op (a) != FFEBLD_opSYMTER)
&& (ffebld_op (a) != FFEBLD_opSUBSTR)
&& (ffebld_op (a) != FFEBLD_opARRAYREF)))
okay = FALSE;
break;
case 'w':
case 'x':
if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
|| ((ffebld_op (a) != FFEBLD_opSYMTER)
&& (ffebld_op (a) != FFEBLD_opARRAYREF)
&& (ffebld_op (a) != FFEBLD_opSUBSTR)))
okay = FALSE;
break;
case '-':
case 'i':
break;
default:
if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
okay = FALSE;
break;
}
if ((optional == '!')
&& lastarg_complex)
okay = FALSE;
if (!okay)
{
/* If it wasn't optional, it's an error,
else maybe it could match a later argspec. */
if (optional == '\0')
return FFEBAD_INTRINSIC_REF;
break; /* Try next argspec. */
}
lastarg_complex
= (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
if (anynum && commit)
{
/* If we know dummy arg type, convert to that now. */
if (abt == FFEINFO_basictypeNONE)
abt = FFEINFO_basictypeINTEGER;
if (akt == FFEINFO_kindtypeNONE)
akt = FFEINFO_kindtypeINTEGER1;
/* We have a known type, convert hollerith/typeless to it. */
a = ffeexpr_convert (a, t, NULL,
abt, akt, 0,
FFETARGET_charactersizeNONE,
FFEEXPR_contextLET);
ffebld_set_head (arg, a);
}
else if ((c[colon + 1] == '*') && commit)
{
/* This is where we promote types to the consensus
type for the COL. Maybe this is where -fpedantic
should issue a warning as well. */
a = ffeexpr_convert (a, t, NULL,
col_bt, col_kt, 0,
ffeinfo_size (i),
FFEEXPR_contextLET);
ffebld_set_head (arg, a);
}
arg = ffebld_trail (arg); /* Arg accepted, now move on. */
if (optional == '*')
continue; /* Go ahead and try another arg. */
if (required == '\0')
break;
if ((required == 'n')
|| (required == '+'))
{
optional = '*';
required = '\0';
}
else if (required == 'p')
required = 'n';
} while (TRUE);
}
*xbt = bt;
*xkt = kt;
*xsz = sz;
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;
}
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
/* Compare a forced-to-uppercase name with a known-upper-case name. */
static int
upcasecmp_ (const char *name, const char *ucname)
{
for ( ; *name != 0 && *ucname != 0; name++, ucname++)
{
int i = TOUPPER(*name) - *ucname;
if (i != 0)
return i;
}
return *name - *ucname;
}
/* Compare name to intrinsic's name.
The intrinsics table is sorted on the upper case entries; so first
compare irrespective of case on the `uc' entry. If it matches,
compare according to the setting of intrinsics case comparison mode. */
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
static int
ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
const char *const uc = ((const struct _ffeintrin_name_ *) intrinsic)->name_uc;
const char *const lc = ((const struct _ffeintrin_name_ *) intrinsic)->name_lc;
const char *const ic = ((const struct _ffeintrin_name_ *) intrinsic)->name_ic;
int i;
if ((i = upcasecmp_ (name, uc)) == 0)
{
switch (ffe_case_intrin ())
{
case FFE_caseLOWER:
return strcmp(name, lc);
case FFE_caseINITCAP:
return strcmp(name, ic);
default:
return 0;
}
}
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
return i;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
}
/* Return basic type of intrinsic implementation, based on its
run-time implementation *only*. (This is used only when
the type of an intrinsic name is needed without having a
list of arguments, i.e. an interface signature, such as when
passing the intrinsic itself, or really the run-time-library
function, as an argument.)
If there's no eligible intrinsic implementation, there must be
a bug somewhere else; no such reference should have been permitted
to go this far. (Well, this might be wrong.) */
ffeinfoBasictype
ffeintrin_basictype (ffeintrinSpec spec)
{
ffeintrinImp imp;
ffecomGfrt gfrt;
assert (spec < FFEINTRIN_spec);
imp = ffeintrin_specs_[spec].implementation;
assert (imp < FFEINTRIN_imp);
if (ffe_is_f2c ())
gfrt = ffeintrin_imps_[imp].gfrt_f2c;
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
else
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
gfrt = ffeintrin_imps_[imp].gfrt_gnu;
assert (gfrt != FFECOM_gfrt);
return ffecom_gfrt_basictype (gfrt);
}
/* 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;
ffeinfoBasictype bt = FFEINFO_basictypeNONE;
ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
ffeintrinImp imp;
ffeintrinSpec tspec;
ffeintrinImp nimp = FFEINTRIN_impNONE;
ffebad error;
bool any = FALSE;
bool highly_specific = FALSE;
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;
any = ffeintrin_check_any_ (ffebld_right (*expr));
for (i = 0;
(((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
&& ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE)
&& !any;
++i)
{
ffeintrinImp timp = ffeintrin_specs_[tspec].implementation;
ffeinfoBasictype tbt;
ffeinfoKindtype tkt;
ffetargetCharacterSize tsz;
ffeIntrinsicState state
= ffeintrin_state_family (ffeintrin_specs_[tspec].family);
ffebad terror;
if (state == FFE_intrinsicstateDELETED)
continue;
if (timp != FFEINTRIN_impNONE)
{
if (!(ffeintrin_imps_[timp].control[0] == '-')
!= !(ffebld_op (*expr) == FFEBLD_opSUBRREF))
continue; /* Form of reference must match form of specific. */
}
if (state == FFE_intrinsicstateDISABLED)
terror = FFEBAD_INTRINSIC_DISABLED;
else if (timp == FFEINTRIN_impNONE)
terror = FFEBAD_INTRINSIC_UNIMPL;
else
{
terror = ffeintrin_check_ (timp, ffebld_op (*expr),
ffebld_right (*expr),
&tbt, &tkt, &tsz, NULL, t, FALSE);
if (terror == FFEBAD)
{
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
{
if (ffebld_symter_specific (ffebld_left (*expr))
== tspec)
highly_specific = TRUE;
imp = timp;
spec = tspec;
bt = tbt;
kt = tkt;
sz = tkt;
error = terror;
}
}
else if (terror != FFEBAD)
{ /* This error has precedence over others. */
if ((error == FFEBAD_INTRINSIC_DISABLED)
|| (error == FFEBAD_INTRINSIC_UNIMPL))
error = FFEBAD;
}
}
if (error == FFEBAD)
error = terror;
}
if (any || (imp == FFEINTRIN_impNONE))
{
if (!any)
{
if (error == FFEBAD)
error = FFEBAD_INTRINSIC_REF;
ffebad_start (error);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_string (ffeintrin_gens_[gen].name);
ffebad_finish ();
}
*expr = ffebld_new_any ();
*info = ffeinfo_new_any ();
}
else
{
if (!highly_specific && (nimp != FFEINTRIN_impNONE))
{
fprintf (stderr, "lineno=%ld, gen=%s, imp=%s, timp=%s\n",
Gcc 3.4.2 20040728.
2004-07-28 03:11:36 +00:00
(long) input_line,
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffeintrin_gens_[gen].name,
ffeintrin_imps_[imp].name,
ffeintrin_imps_[nimp].name);
assert ("Ambiguous generic reference" == NULL);
abort ();
}
error = ffeintrin_check_ (imp, ffebld_op (*expr),
ffebld_right (*expr),
&bt, &kt, &sz, NULL, t, TRUE);
assert (error == FFEBAD);
*info = ffeinfo_new (bt,
kt,
0,
FFEINFO_kindENTITY,
FFEINFO_whereFLEETING,
sz);
symter = ffebld_left (*expr);
ffebld_symter_set_specific (symter, spec);
ffebld_symter_set_implementation (symter, imp);
ffebld_set_info (symter,
ffeinfo_new (bt,
kt,
0,
(bt == FFEINFO_basictypeNONE)
? FFEINFO_kindSUBROUTINE
: FFEINFO_kindFUNCTION,
FFEINFO_whereINTRINSIC,
sz));
if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
&& (((bt != ffesymbol_basictype (ffebld_symter (symter)))
|| (kt != ffesymbol_kindtype (ffebld_symter (symter)))
|| ((sz != FFETARGET_charactersizeNONE)
&& (sz != ffesymbol_size (ffebld_symter (symter)))))))
{
ffebad_start (FFEBAD_INTRINSIC_TYPE);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_string (ffeintrin_gens_[gen].name);
ffebad_finish ();
}
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
if (ffeintrin_imps_[imp].y2kbad)
{
ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_string (ffeintrin_gens_[gen].name);
ffebad_finish ();
}
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
}
}
/* 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.
bool check_intrin; // May be omitted, else set TRUE if intrinsic needs checking.
ffelexToken token; // Used for error message.
ffeintrin_fulfill_specific (&expr, &info, &check_intrin, 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,
bool *check_intrin, ffelexToken t)
{
ffebld symter;
ffebldOp op;
ffeintrinGen gen;
ffeintrinSpec spec;
ffeintrinImp imp;
ffeinfoBasictype bt = FFEINFO_basictypeNONE;
ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
ffeIntrinsicState state;
ffebad error;
bool any = FALSE;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *name;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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));
spec = ffebld_symter_specific (ffebld_left (*expr));
assert (spec != FFEINTRIN_specNONE);
if (gen != FFEINTRIN_genNONE)
name = ffeintrin_gens_[gen].name;
else
name = ffeintrin_specs_[spec].name;
state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
imp = ffeintrin_specs_[spec].implementation;
if (check_intrin != NULL)
*check_intrin = FALSE;
any = ffeintrin_check_any_ (ffebld_right (*expr));
if (state == FFE_intrinsicstateDISABLED)
error = FFEBAD_INTRINSIC_DISABLED;
else if (imp == FFEINTRIN_impNONE)
error = FFEBAD_INTRINSIC_UNIMPL;
else if (!any)
{
error = ffeintrin_check_ (imp, ffebld_op (*expr),
ffebld_right (*expr),
&bt, &kt, &sz, check_intrin, t, TRUE);
}
else
error = FFEBAD; /* Not really needed, but quiet -Wuninitialized. */
if (any || (error != FFEBAD))
{
if (!any)
{
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 (bt,
kt,
0,
FFEINFO_kindENTITY,
FFEINFO_whereFLEETING,
sz);
symter = ffebld_left (*expr);
ffebld_set_info (symter,
ffeinfo_new (bt,
kt,
0,
(bt == FFEINFO_basictypeNONE)
? FFEINFO_kindSUBROUTINE
: FFEINFO_kindFUNCTION,
FFEINFO_whereINTRINSIC,
sz));
if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
&& (((bt != ffesymbol_basictype (ffebld_symter (symter)))
|| (kt != ffesymbol_kindtype (ffebld_symter (symter)))
|| (sz != ffesymbol_size (ffebld_symter (symter))))))
{
ffebad_start (FFEBAD_INTRINSIC_TYPE);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_string (name);
ffebad_finish ();
}
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
if (ffeintrin_imps_[imp].y2kbad)
{
ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
ffebad_here (0, ffelex_token_where_line (t),
ffelex_token_where_column (t));
ffebad_string (name);
ffebad_finish ();
}
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
}
}
/* Return run-time index of intrinsic implementation as direct call. */
ffecomGfrt
ffeintrin_gfrt_direct (ffeintrinImp imp)
{
assert (imp < FFEINTRIN_imp);
return ffeintrin_imps_[imp].gfrt_direct;
}
/* Return run-time index of intrinsic implementation as actual argument. */
ffecomGfrt
ffeintrin_gfrt_indirect (ffeintrinImp imp)
{
assert (imp < FFEINTRIN_imp);
if (! ffe_is_f2c ())
return ffeintrin_imps_[imp].gfrt_gnu;
return ffeintrin_imps_[imp].gfrt_f2c;
}
void
Gcc 3.4.2 20040728.
2004-07-28 03:11:36 +00:00
ffeintrin_init_0 (void)
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
{
int i;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *p1;
const char *p2;
const char *p3;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
int colon;
if (!ffe_is_do_internal_checks ())
return;
assert (FFEINTRIN_gen == ARRAY_SIZE (ffeintrin_gens_));
assert (FFEINTRIN_imp == ARRAY_SIZE (ffeintrin_imps_));
assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_));
for (i = 1; ((size_t) 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; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
{
assert ((ffeintrin_names_[i].generic == FFEINTRIN_genNONE)
|| (ffeintrin_names_[i].specific == FFEINTRIN_specNONE));
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 ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
continue;
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
if (! ISUPPER ((unsigned char)*p1) || ! ISLOWER ((unsigned char)*p2)
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
|| (*p1 != TOUPPER (*p2))
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
|| ((*p3 != *p1) && (*p3 != *p2)))
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
break;
}
assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
}
for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i)
{
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *c = ffeintrin_imps_[i].control;
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
if (c[0] == '\0')
continue;
if ((c[0] != '-')
&& (c[0] != 'A')
&& (c[0] != 'C')
&& (c[0] != 'I')
&& (c[0] != 'L')
&& (c[0] != 'R')
&& (c[0] != 'B')
&& (c[0] != 'F')
&& (c[0] != 'N')
&& (c[0] != 'S'))
{
fprintf (stderr, "%s: bad return-base-type\n",
ffeintrin_imps_[i].name);
continue;
}
if ((c[1] != '-')
&& (c[1] != '=')
&& ((c[1] < '1')
|| (c[1] > '9'))
&& (c[1] != 'C'))
{
fprintf (stderr, "%s: bad return-kind-type\n",
ffeintrin_imps_[i].name);
continue;
}
if (c[2] == ':')
colon = 2;
else
{
if (c[2] != '*')
{
fprintf (stderr, "%s: bad return-modifier\n",
ffeintrin_imps_[i].name);
continue;
}
colon = 3;
}
if ((c[colon] != ':') || (c[colon + 2] != ':'))
{
fprintf (stderr, "%s: bad control\n",
ffeintrin_imps_[i].name);
continue;
}
if ((c[colon + 1] != '-')
&& (c[colon + 1] != '*')
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
&& (! ISDIGIT (c[colon + 1])))
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
{
fprintf (stderr, "%s: bad COL-spec\n",
ffeintrin_imps_[i].name);
continue;
}
c += (colon + 3);
while (c[0] != '\0')
{
while ((c[0] != '=')
&& (c[0] != ',')
&& (c[0] != '\0'))
++c;
if (c[0] != '=')
{
fprintf (stderr, "%s: bad keyword\n",
ffeintrin_imps_[i].name);
break;
}
if ((c[1] == '?')
|| (c[1] == '!')
|| (c[1] == '+')
|| (c[1] == '*')
|| (c[1] == 'n')
|| (c[1] == 'p'))
++c;
if ((c[1] != '-')
&& (c[1] != 'A')
&& (c[1] != 'C')
&& (c[1] != 'I')
&& (c[1] != 'L')
&& (c[1] != 'R')
&& (c[1] != 'B')
&& (c[1] != 'F')
&& (c[1] != 'N')
&& (c[1] != 'S')
&& (c[1] != 'g')
&& (c[1] != 's'))
{
fprintf (stderr, "%s: bad arg-base-type\n",
ffeintrin_imps_[i].name);
break;
}
if ((c[2] != '*')
&& ((c[2] < '1')
|| (c[2] > '9'))
&& (c[2] != 'A'))
{
fprintf (stderr, "%s: bad arg-kind-type\n",
ffeintrin_imps_[i].name);
break;
}
if (c[3] == '[')
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
if ((! ISDIGIT (c[4]))
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
|| ((c[5] != ']')
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
&& (++c, ! ISDIGIT (c[4])
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
|| (c[5] != ']'))))
{
fprintf (stderr, "%s: bad arg-len\n",
ffeintrin_imps_[i].name);
break;
}
c += 3;
}
if (c[3] == '(')
{
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
if ((! ISDIGIT (c[4]))
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
|| ((c[5] != ')')
Enlist the FreeBSD-CURRENT users as testers of what is to become Gcc 3.1.0. These bits are taken from the FSF anoncvs repo on 1-Feb-2002 08:20 PST.
2002-02-01 18:16:02 +00:00
&& (++c, ! ISDIGIT (c[4])
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
|| (c[5] != ')'))))
{
fprintf (stderr, "%s: bad arg-rank\n",
ffeintrin_imps_[i].name);
break;
}
c += 3;
}
else if ((c[3] == '&')
&& (c[4] == '&'))
++c;
if ((c[3] == '&')
|| (c[3] == 'i')
|| (c[3] == 'w')
|| (c[3] == 'x'))
++c;
if (c[3] == ',')
{
c += 4;
continue;
}
if (c[3] != '\0')
{
fprintf (stderr, "%s: bad arg-list\n",
ffeintrin_imps_[i].name);
}
break;
}
}
}
/* Determine whether intrinsic is okay as an actual argument. */
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)
&& (ffe_is_f2c ()
? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
!= FFECOM_gfrt)
: (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
!= FFECOM_gfrt))
&& ((state == FFE_intrinsicstateENABLED)
|| (state == FFE_intrinsicstateHIDDEN));
}
/* Determine if name is intrinsic, return info.
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *name; // C-string name of possible intrinsic.
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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.
if (ffeintrin_is_intrinsic (name, t, explicit,
&gen, &spec, &imp))
// is an intrinsic, use gen, spec, imp, and
// kind accordingly. */
bool
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffeintrinGen *xgen, ffeintrinSpec *xspec,
ffeintrinImp *ximp)
{
struct _ffeintrin_name_ *intrinsic;
ffeintrinGen gen;
ffeintrinSpec spec;
ffeintrinImp imp;
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;
name = ffeintrin_gens_[gen].name;
for (i = 0;
(((size_t) 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 (gen != FFEINTRIN_genNONE)
name = ffeintrin_gens_[gen].name;
else
name = ffeintrin_specs_[spec].name;
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_UNIMPLW);
ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
ffebad_string (name);
ffebad_finish ();
}
return FALSE;
}
/* Determine whether intrinsic is function or subroutine. If no specific
id, scan list of possible specifics for generic to get consensus. If
not unanimous, or clear from the context, return NONE. */
if (spec == FFEINTRIN_specNONE)
{
int i;
ffeintrinSpec tspec;
ffeintrinImp timp;
bool at_least_one_ok = FALSE;
for (i = 0;
(((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
&& ((tspec
= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
++i)
{
if (((state = ffeintrin_state_family (ffeintrin_specs_[tspec].family))
== FFE_intrinsicstateDELETED)
|| (state == FFE_intrinsicstateDISABLED))
continue;
if ((timp = ffeintrin_specs_[tspec].implementation)
== FFEINTRIN_impNONE)
continue;
at_least_one_ok = TRUE;
break;
}
if (!at_least_one_ok)
{
*xgen = FFEINTRIN_genNONE;
*xspec = FFEINTRIN_specNONE;
*ximp = FFEINTRIN_impNONE;
return FALSE;
}
}
*xgen = gen;
*xspec = spec;
*ximp = imp;
return TRUE;
}
/* Return TRUE if intrinsic is standard F77 (or, if -ff90, F90). */
bool
ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec)
{
if (spec == FFEINTRIN_specNONE)
{
if (gen == FFEINTRIN_genNONE)
return FALSE;
spec = ffeintrin_gens_[gen].specs[0];
if (spec == FFEINTRIN_specNONE)
return FALSE;
}
if ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF77)
|| (ffe_is_90 ()
&& ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF90)
|| (ffeintrin_specs_[spec].family == FFEINTRIN_familyMIL)
|| (ffeintrin_specs_[spec].family == FFEINTRIN_familyASC))))
return TRUE;
return FALSE;
}
/* Return kind type of intrinsic implementation. See ffeintrin_basictype,
its sibling. */
ffeinfoKindtype
ffeintrin_kindtype (ffeintrinSpec spec)
{
ffeintrinImp imp;
ffecomGfrt gfrt;
assert (spec < FFEINTRIN_spec);
imp = ffeintrin_specs_[spec].implementation;
assert (imp < FFEINTRIN_imp);
if (ffe_is_f2c ())
gfrt = ffeintrin_imps_[imp].gfrt_f2c;
else
gfrt = ffeintrin_imps_[imp].gfrt_gnu;
assert (gfrt != FFECOM_gfrt);
return ffecom_gfrt_kindtype (gfrt);
}
/* Return name of generic intrinsic. */
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffeintrin_name_generic (ffeintrinGen gen)
{
assert (gen < FFEINTRIN_gen);
return ffeintrin_gens_[gen].name;
}
/* Return name of intrinsic implementation. */
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
ffeintrin_name_implementation (ffeintrinImp imp)
{
assert (imp < FFEINTRIN_imp);
return ffeintrin_imps_[imp].name;
}
/* Return external/internal name of specific intrinsic. */
Virgin import of the GCC 2.95.1 compilers
1999-10-16 06:09:09 +00:00
const char *
Virgin import of gcc from EGCS 1.1.2
1999-08-26 09:30:50 +00:00
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_familyGNU:
state = ffe_intrinsic_state_gnu ();
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 ());
return state;
case FFEINTRIN_familyF2C:
state = ffe_intrinsic_state_f2c ();
return state;
case FFEINTRIN_familyF2U:
state = ffe_intrinsic_state_unix ();
return state;
case FFEINTRIN_familyBADU77:
state = ffe_intrinsic_state_badu77 ();
return state;
default:
assert ("bad family" == NULL);
return FFE_intrinsicstateDELETED;
}
}
Reference in New Issue Copy Permalink