aboutsummaryrefslogtreecommitdiff
path: root/gcc/f/intrin.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/f/intrin.c')
-rw-r--r--gcc/f/intrin.c84
1 files changed, 57 insertions, 27 deletions
diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
index 6e27d210142..dbf375b849f 100644
--- a/gcc/f/intrin.c
+++ b/gcc/f/intrin.c
@@ -1,6 +1,6 @@
/* intrin.c -- Recognize references to intrinsics
Copyright (C) 1995-1998 Free Software Foundation, Inc.
- Contributed by James Craig Burley (burley@gnu.org).
+ Contributed by James Craig Burley.
This file is part of GNU Fortran.
@@ -32,22 +32,22 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
struct _ffeintrin_name_
{
- char *name_uc;
- char *name_lc;
- char *name_ic;
+ const char *name_uc;
+ const char *name_lc;
+ const char *name_ic;
ffeintrinGen generic;
ffeintrinSpec specific;
};
struct _ffeintrin_gen_
{
- char *name; /* Name as seen in program. */
+ const char *name; /* Name as seen in program. */
ffeintrinSpec specs[2];
};
struct _ffeintrin_spec_
{
- char *name; /* Uppercase name as seen in source code,
+ const 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. */
@@ -57,13 +57,14 @@ struct _ffeintrin_spec_
struct _ffeintrin_imp_
{
- char *name; /* Name of implementation. */
+ const char *name; /* Name of implementation. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
ffecomGfrt gfrt_direct; /* library routine, direct-callable form. */
ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */
ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */
#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
- char *control;
+ const char *control;
+ char y2kbad;
};
static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
@@ -84,11 +85,13 @@ static struct _ffeintrin_name_ ffeintrin_names_[]
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
static struct _ffeintrin_gen_ ffeintrin_gens_[]
@@ -99,11 +102,13 @@ static struct _ffeintrin_gen_ ffeintrin_gens_[]
{ NAME, { SPEC1, SPEC2, }, },
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
static struct _ffeintrin_imp_ ffeintrin_imps_[]
@@ -115,10 +120,15 @@ static struct _ffeintrin_imp_ ffeintrin_imps_[]
#if FFECOM_targetCURRENT == FFECOM_targetGCC
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
- FFECOM_gfrt ## GFRTGNU, CONTROL },
+ 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 },
#elif FFECOM_targetCURRENT == FFECOM_targetFFE
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
- { NAME, CONTROL },
+ { NAME, CONTROL, FALSE },
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
+ { NAME, CONTROL, Y2KBAD },
#else
#error
#endif
@@ -127,6 +137,7 @@ static struct _ffeintrin_imp_ ffeintrin_imps_[]
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
static struct _ffeintrin_spec_ ffeintrin_specs_[]
@@ -137,10 +148,12 @@ static struct _ffeintrin_spec_ ffeintrin_specs_[]
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
{ NAME, CALLABLE, FAMILY, IMP, },
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
@@ -153,9 +166,9 @@ ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
ffelexToken t,
bool commit)
{
- char *c = ffeintrin_imps_[imp].control;
+ const char *c = ffeintrin_imps_[imp].control;
bool subr = (c[0] == '-');
- char *argc;
+ const char *argc;
ffebld arg;
ffeinfoBasictype bt;
ffeinfoKindtype kt;
@@ -1152,9 +1165,9 @@ ffeintrin_check_any_ (ffebld arglist)
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;
+ const char *uc = ((struct _ffeintrin_name_ *) intrinsic)->name_uc;
+ const char *lc = ((struct _ffeintrin_name_ *) intrinsic)->name_lc;
+ const char *ic = ((struct _ffeintrin_name_ *) intrinsic)->name_ic;
return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic);
}
@@ -1374,6 +1387,14 @@ ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t)
ffebad_string (ffeintrin_gens_[gen].name);
ffebad_finish ();
}
+ 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 ();
+ }
}
}
@@ -1408,7 +1429,7 @@ ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
ffeIntrinsicState state;
ffebad error;
bool any = FALSE;
- char *name;
+ const char *name;
op = ffebld_op (*expr);
assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
@@ -1489,6 +1510,14 @@ ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
ffebad_string (name);
ffebad_finish ();
}
+ 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 ();
+ }
}
}
@@ -1522,9 +1551,9 @@ void
ffeintrin_init_0 ()
{
int i;
- char *p1;
- char *p2;
- char *p3;
+ const char *p1;
+ const char *p2;
+ const char *p3;
int colon;
if (!ffe_is_do_internal_checks ())
@@ -1558,8 +1587,9 @@ ffeintrin_init_0 ()
break;
if ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
continue;
- if (! ISUPPER (*p1) || ! ISLOWER (*p2)
- || (*p1 != toupper (*p2)) || ((*p3 != *p1) && (*p3 != *p2)))
+ if (! ISUPPER ((unsigned char)*p1) || ! ISLOWER ((unsigned char)*p2)
+ || (*p1 != toupper ((unsigned char)*p2))
+ || ((*p3 != *p1) && (*p3 != *p2)))
break;
}
assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
@@ -1567,7 +1597,7 @@ ffeintrin_init_0 ()
for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i)
{
- char *c = ffeintrin_imps_[i].control;
+ const char *c = ffeintrin_imps_[i].control;
if (c[0] == '\0')
continue;
@@ -1745,7 +1775,7 @@ ffeintrin_is_actualarg (ffeintrinSpec spec)
/* Determine if name is intrinsic, return info.
- char *name; // C-string name of possible intrinsic.
+ const 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.
@@ -1757,7 +1787,7 @@ ffeintrin_is_actualarg (ffeintrinSpec spec)
// kind accordingly. */
bool
-ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit,
+ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
ffeintrinGen *xgen, ffeintrinSpec *xspec,
ffeintrinImp *ximp)
{
@@ -1968,7 +1998,7 @@ ffeintrin_kindtype (ffeintrinSpec spec)
/* Return name of generic intrinsic. */
-char *
+const char *
ffeintrin_name_generic (ffeintrinGen gen)
{
assert (gen < FFEINTRIN_gen);
@@ -1977,7 +2007,7 @@ ffeintrin_name_generic (ffeintrinGen gen)
/* Return name of intrinsic implementation. */
-char *
+const char *
ffeintrin_name_implementation (ffeintrinImp imp)
{
assert (imp < FFEINTRIN_imp);
@@ -1986,7 +2016,7 @@ ffeintrin_name_implementation (ffeintrinImp imp)
/* Return external/internal name of specific intrinsic. */
-char *
+const char *
ffeintrin_name_specific (ffeintrinSpec spec)
{
assert (spec < FFEINTRIN_spec);
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-20 13:40:10 +0000