Home | History | Annotate | Line # | Download | only in fortran
      1  1.1  mrg /* Build up a list of intrinsic subroutines and functions for the
      2  1.1  mrg    name-resolution stage.
      3  1.1  mrg    Copyright (C) 2000-2022 Free Software Foundation, Inc.
      4  1.1  mrg    Contributed by Andy Vaught & Katherine Holcomb
      5  1.1  mrg 
      6  1.1  mrg This file is part of GCC.
      7  1.1  mrg 
      8  1.1  mrg GCC is free software; you can redistribute it and/or modify it under
      9  1.1  mrg the terms of the GNU General Public License as published by the Free
     10  1.1  mrg Software Foundation; either version 3, or (at your option) any later
     11  1.1  mrg version.
     12  1.1  mrg 
     13  1.1  mrg GCC is distributed in the hope that it will be useful, but WITHOUT ANY
     14  1.1  mrg WARRANTY; without even the implied warranty of MERCHANTABILITY or
     15  1.1  mrg FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
     16  1.1  mrg for more details.
     17  1.1  mrg 
     18  1.1  mrg You should have received a copy of the GNU General Public License
     19  1.1  mrg along with GCC; see the file COPYING3.  If not see
     20  1.1  mrg <http://www.gnu.org/licenses/>.  */
     21  1.1  mrg 
     22  1.1  mrg #include "config.h"
     23  1.1  mrg #include "system.h"
     24  1.1  mrg #include "coretypes.h"
     25  1.1  mrg #include "options.h"
     26  1.1  mrg #include "gfortran.h"
     27  1.1  mrg #include "intrinsic.h"
     28  1.1  mrg 
     29  1.1  mrg /* Namespace to hold the resolved symbols for intrinsic subroutines.  */
     30  1.1  mrg static gfc_namespace *gfc_intrinsic_namespace;
     31  1.1  mrg 
     32  1.1  mrg bool gfc_init_expr_flag = false;
     33  1.1  mrg 
     34  1.1  mrg /* Pointers to an intrinsic function and its argument names that are being
     35  1.1  mrg    checked.  */
     36  1.1  mrg 
     37  1.1  mrg const char *gfc_current_intrinsic;
     38  1.1  mrg gfc_intrinsic_arg *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
     39  1.1  mrg locus *gfc_current_intrinsic_where;
     40  1.1  mrg 
     41  1.1  mrg static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
     42  1.1  mrg static gfc_intrinsic_sym *char_conversions;
     43  1.1  mrg static gfc_intrinsic_arg *next_arg;
     44  1.1  mrg 
     45  1.1  mrg static int nfunc, nsub, nargs, nconv, ncharconv;
     46  1.1  mrg 
     47  1.1  mrg static enum
     48  1.1  mrg { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
     49  1.1  mrg sizing;
     50  1.1  mrg 
     51  1.1  mrg enum klass
     52  1.1  mrg { CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL,
     53  1.1  mrg   CLASS_INQUIRY, CLASS_TRANSFORMATIONAL, CLASS_ATOMIC };
     54  1.1  mrg 
     55  1.1  mrg #define ACTUAL_NO	0
     56  1.1  mrg #define ACTUAL_YES	1
     57  1.1  mrg 
     58  1.1  mrg #define REQUIRED	0
     59  1.1  mrg #define OPTIONAL	1
     60  1.1  mrg 
     61  1.1  mrg 
     62  1.1  mrg /* Return a letter based on the passed type.  Used to construct the
     63  1.1  mrg    name of a type-dependent subroutine.  If logical_equals_int is
     64  1.1  mrg    true, we can treat a logical like an int.  */
     65  1.1  mrg 
     66  1.1  mrg char
     67  1.1  mrg gfc_type_letter (bt type, bool logical_equals_int)
     68  1.1  mrg {
     69  1.1  mrg   char c;
     70  1.1  mrg 
     71  1.1  mrg   switch (type)
     72  1.1  mrg     {
     73  1.1  mrg     case BT_LOGICAL:
     74  1.1  mrg       if (logical_equals_int)
     75  1.1  mrg 	c = 'i';
     76  1.1  mrg       else
     77  1.1  mrg 	c = 'l';
     78  1.1  mrg 
     79  1.1  mrg       break;
     80  1.1  mrg     case BT_CHARACTER:
     81  1.1  mrg       c = 's';
     82  1.1  mrg       break;
     83  1.1  mrg     case BT_INTEGER:
     84  1.1  mrg       c = 'i';
     85  1.1  mrg       break;
     86  1.1  mrg     case BT_REAL:
     87  1.1  mrg       c = 'r';
     88  1.1  mrg       break;
     89  1.1  mrg     case BT_COMPLEX:
     90  1.1  mrg       c = 'c';
     91  1.1  mrg       break;
     92  1.1  mrg 
     93  1.1  mrg     case BT_HOLLERITH:
     94  1.1  mrg       c = 'h';
     95  1.1  mrg       break;
     96  1.1  mrg 
     97  1.1  mrg     default:
     98  1.1  mrg       c = 'u';
     99  1.1  mrg       break;
    100  1.1  mrg     }
    101  1.1  mrg 
    102  1.1  mrg   return c;
    103  1.1  mrg }
    104  1.1  mrg 
    105  1.1  mrg 
    106  1.1  mrg /* Return kind that should be used for ABI purposes in libgfortran
    107  1.1  mrg    APIs.  Usually the same as ts->kind, except for BT_REAL/BT_COMPLEX
    108  1.1  mrg    for IEEE 754 quad format kind 16 where it returns 17.  */
    109  1.1  mrg 
    110  1.1  mrg int
    111  1.1  mrg gfc_type_abi_kind (bt type, int kind)
    112  1.1  mrg {
    113  1.1  mrg   switch (type)
    114  1.1  mrg     {
    115  1.1  mrg     case BT_REAL:
    116  1.1  mrg     case BT_COMPLEX:
    117  1.1  mrg       if (kind == 16)
    118  1.1  mrg 	for (int i = 0; gfc_real_kinds[i].kind != 0; i++)
    119  1.1  mrg 	  if (gfc_real_kinds[i].kind == kind)
    120  1.1  mrg 	    return gfc_real_kinds[i].abi_kind;
    121  1.1  mrg       return kind;
    122  1.1  mrg     default:
    123  1.1  mrg       return kind;
    124  1.1  mrg     }
    125  1.1  mrg }
    126  1.1  mrg 
    127  1.1  mrg /* Get a symbol for a resolved name. Note, if needed be, the elemental
    128  1.1  mrg    attribute has be added afterwards.  */
    129  1.1  mrg 
    130  1.1  mrg gfc_symbol *
    131  1.1  mrg gfc_get_intrinsic_sub_symbol (const char *name)
    132  1.1  mrg {
    133  1.1  mrg   gfc_symbol *sym;
    134  1.1  mrg 
    135  1.1  mrg   gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
    136  1.1  mrg   sym->attr.always_explicit = 1;
    137  1.1  mrg   sym->attr.subroutine = 1;
    138  1.1  mrg   sym->attr.flavor = FL_PROCEDURE;
    139  1.1  mrg   sym->attr.proc = PROC_INTRINSIC;
    140  1.1  mrg 
    141  1.1  mrg   gfc_commit_symbol (sym);
    142  1.1  mrg 
    143  1.1  mrg   return sym;
    144  1.1  mrg }
    145  1.1  mrg 
    146  1.1  mrg /* Get a symbol for a resolved function, with its special name.  The
    147  1.1  mrg    actual argument list needs to be set by the caller.  */
    148  1.1  mrg 
    149  1.1  mrg gfc_symbol *
    150  1.1  mrg gfc_get_intrinsic_function_symbol (gfc_expr *expr)
    151  1.1  mrg {
    152  1.1  mrg   gfc_symbol *sym;
    153  1.1  mrg 
    154  1.1  mrg   gfc_get_symbol (expr->value.function.name, gfc_intrinsic_namespace, &sym);
    155  1.1  mrg   sym->attr.external = 1;
    156  1.1  mrg   sym->attr.function = 1;
    157  1.1  mrg   sym->attr.always_explicit = 1;
    158  1.1  mrg   sym->attr.proc = PROC_INTRINSIC;
    159  1.1  mrg   sym->attr.flavor = FL_PROCEDURE;
    160  1.1  mrg   sym->result = sym;
    161  1.1  mrg   if (expr->rank > 0)
    162  1.1  mrg     {
    163  1.1  mrg       sym->attr.dimension = 1;
    164  1.1  mrg       sym->as = gfc_get_array_spec ();
    165  1.1  mrg       sym->as->type = AS_ASSUMED_SHAPE;
    166  1.1  mrg       sym->as->rank = expr->rank;
    167  1.1  mrg     }
    168  1.1  mrg   return sym;
    169  1.1  mrg }
    170  1.1  mrg 
    171  1.1  mrg /* Find a symbol for a resolved intrinsic procedure, return NULL if
    172  1.1  mrg    not found.  */
    173  1.1  mrg 
    174  1.1  mrg gfc_symbol *
    175  1.1  mrg gfc_find_intrinsic_symbol (gfc_expr *expr)
    176  1.1  mrg {
    177  1.1  mrg   gfc_symbol *sym;
    178  1.1  mrg   gfc_find_symbol (expr->value.function.name, gfc_intrinsic_namespace,
    179  1.1  mrg 		   0, &sym);
    180  1.1  mrg   return sym;
    181  1.1  mrg }
    182  1.1  mrg 
    183  1.1  mrg 
    184  1.1  mrg /* Return a pointer to the name of a conversion function given two
    185  1.1  mrg    typespecs.  */
    186  1.1  mrg 
    187  1.1  mrg static const char *
    188  1.1  mrg conv_name (gfc_typespec *from, gfc_typespec *to)
    189  1.1  mrg {
    190  1.1  mrg   return gfc_get_string ("__convert_%c%d_%c%d",
    191  1.1  mrg 			 gfc_type_letter (from->type), gfc_type_abi_kind (from),
    192  1.1  mrg 			 gfc_type_letter (to->type), gfc_type_abi_kind (to));
    193  1.1  mrg }
    194  1.1  mrg 
    195  1.1  mrg 
    196  1.1  mrg /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
    197  1.1  mrg    corresponds to the conversion.  Returns NULL if the conversion
    198  1.1  mrg    isn't found.  */
    199  1.1  mrg 
    200  1.1  mrg static gfc_intrinsic_sym *
    201  1.1  mrg find_conv (gfc_typespec *from, gfc_typespec *to)
    202  1.1  mrg {
    203  1.1  mrg   gfc_intrinsic_sym *sym;
    204  1.1  mrg   const char *target;
    205  1.1  mrg   int i;
    206  1.1  mrg 
    207  1.1  mrg   target = conv_name (from, to);
    208  1.1  mrg   sym = conversion;
    209  1.1  mrg 
    210  1.1  mrg   for (i = 0; i < nconv; i++, sym++)
    211  1.1  mrg     if (target == sym->name)
    212  1.1  mrg       return sym;
    213  1.1  mrg 
    214  1.1  mrg   return NULL;
    215  1.1  mrg }
    216  1.1  mrg 
    217  1.1  mrg 
    218  1.1  mrg /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
    219  1.1  mrg    that corresponds to the conversion.  Returns NULL if the conversion
    220  1.1  mrg    isn't found.  */
    221  1.1  mrg 
    222  1.1  mrg static gfc_intrinsic_sym *
    223  1.1  mrg find_char_conv (gfc_typespec *from, gfc_typespec *to)
    224  1.1  mrg {
    225  1.1  mrg   gfc_intrinsic_sym *sym;
    226  1.1  mrg   const char *target;
    227  1.1  mrg   int i;
    228  1.1  mrg 
    229  1.1  mrg   target = conv_name (from, to);
    230  1.1  mrg   sym = char_conversions;
    231  1.1  mrg 
    232  1.1  mrg   for (i = 0; i < ncharconv; i++, sym++)
    233  1.1  mrg     if (target == sym->name)
    234  1.1  mrg       return sym;
    235  1.1  mrg 
    236  1.1  mrg   return NULL;
    237  1.1  mrg }
    238  1.1  mrg 
    239  1.1  mrg 
    240  1.1  mrg /* Check TS29113, C407b for assumed type and C535b for assumed-rank,
    241  1.1  mrg    and a likewise check for NO_ARG_CHECK.  */
    242  1.1  mrg 
    243  1.1  mrg static bool
    244  1.1  mrg do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
    245  1.1  mrg {
    246  1.1  mrg   gfc_actual_arglist *a;
    247  1.1  mrg   bool ok = true;
    248  1.1  mrg 
    249  1.1  mrg   for (a = arg; a; a = a->next)
    250  1.1  mrg     {
    251  1.1  mrg       if (!a->expr)
    252  1.1  mrg 	continue;
    253  1.1  mrg 
    254  1.1  mrg       if (a->expr->expr_type == EXPR_VARIABLE
    255  1.1  mrg 	  && (a->expr->symtree->n.sym->attr.ext_attr
    256  1.1  mrg 	      & (1 << EXT_ATTR_NO_ARG_CHECK))
    257  1.1  mrg 	  && specific->id != GFC_ISYM_C_LOC
    258  1.1  mrg 	  && specific->id != GFC_ISYM_PRESENT)
    259  1.1  mrg 	{
    260  1.1  mrg 	  gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
    261  1.1  mrg 		     "permitted as argument to the intrinsic functions "
    262  1.1  mrg 		     "C_LOC and PRESENT", &a->expr->where);
    263  1.1  mrg 	  ok = false;
    264  1.1  mrg 	}
    265  1.1  mrg       else if (a->expr->ts.type == BT_ASSUMED
    266  1.1  mrg 	       && specific->id != GFC_ISYM_LBOUND
    267  1.1  mrg 	       && specific->id != GFC_ISYM_PRESENT
    268  1.1  mrg 	       && specific->id != GFC_ISYM_RANK
    269  1.1  mrg 	       && specific->id != GFC_ISYM_SHAPE
    270  1.1  mrg 	       && specific->id != GFC_ISYM_SIZE
    271  1.1  mrg 	       && specific->id != GFC_ISYM_SIZEOF
    272  1.1  mrg 	       && specific->id != GFC_ISYM_UBOUND
    273  1.1  mrg 	       && specific->id != GFC_ISYM_IS_CONTIGUOUS
    274  1.1  mrg 	       && specific->id != GFC_ISYM_C_LOC)
    275  1.1  mrg 	{
    276  1.1  mrg 	  gfc_error ("Assumed-type argument at %L is not permitted as actual"
    277  1.1  mrg 		     " argument to the intrinsic %s", &a->expr->where,
    278  1.1  mrg 		     gfc_current_intrinsic);
    279  1.1  mrg 	  ok = false;
    280  1.1  mrg 	}
    281  1.1  mrg       else if (a->expr->ts.type == BT_ASSUMED && a != arg)
    282  1.1  mrg 	{
    283  1.1  mrg 	  gfc_error ("Assumed-type argument at %L is only permitted as "
    284  1.1  mrg 		     "first actual argument to the intrinsic %s",
    285  1.1  mrg 		     &a->expr->where, gfc_current_intrinsic);
    286  1.1  mrg 	  ok = false;
    287  1.1  mrg 	}
    288  1.1  mrg       else if (a->expr->rank == -1 && !specific->inquiry)
    289  1.1  mrg 	{
    290  1.1  mrg 	  gfc_error ("Assumed-rank argument at %L is only permitted as actual "
    291  1.1  mrg 		     "argument to intrinsic inquiry functions",
    292  1.1  mrg 		     &a->expr->where);
    293  1.1  mrg 	  ok = false;
    294  1.1  mrg 	}
    295  1.1  mrg       else if (a->expr->rank == -1 && arg != a)
    296  1.1  mrg 	{
    297  1.1  mrg 	  gfc_error ("Assumed-rank argument at %L is only permitted as first "
    298  1.1  mrg 		     "actual argument to the intrinsic inquiry function %s",
    299  1.1  mrg 		     &a->expr->where, gfc_current_intrinsic);
    300  1.1  mrg 	  ok = false;
    301  1.1  mrg 	}
    302  1.1  mrg     }
    303  1.1  mrg 
    304  1.1  mrg   return ok;
    305  1.1  mrg }
    306  1.1  mrg 
    307  1.1  mrg 
    308  1.1  mrg /* Interface to the check functions.  We break apart an argument list
    309  1.1  mrg    and call the proper check function rather than forcing each
    310  1.1  mrg    function to manipulate the argument list.  */
    311  1.1  mrg 
    312  1.1  mrg static bool
    313  1.1  mrg do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
    314  1.1  mrg {
    315  1.1  mrg   gfc_expr *a1, *a2, *a3, *a4, *a5;
    316  1.1  mrg 
    317  1.1  mrg   if (arg == NULL)
    318  1.1  mrg     return (*specific->check.f0) ();
    319  1.1  mrg 
    320  1.1  mrg   a1 = arg->expr;
    321  1.1  mrg   arg = arg->next;
    322  1.1  mrg   if (arg == NULL)
    323  1.1  mrg     return (*specific->check.f1) (a1);
    324  1.1  mrg 
    325  1.1  mrg   a2 = arg->expr;
    326  1.1  mrg   arg = arg->next;
    327  1.1  mrg   if (arg == NULL)
    328  1.1  mrg     return (*specific->check.f2) (a1, a2);
    329  1.1  mrg 
    330  1.1  mrg   a3 = arg->expr;
    331  1.1  mrg   arg = arg->next;
    332  1.1  mrg   if (arg == NULL)
    333  1.1  mrg     return (*specific->check.f3) (a1, a2, a3);
    334  1.1  mrg 
    335  1.1  mrg   a4 = arg->expr;
    336  1.1  mrg   arg = arg->next;
    337  1.1  mrg   if (arg == NULL)
    338  1.1  mrg     return (*specific->check.f4) (a1, a2, a3, a4);
    339  1.1  mrg 
    340  1.1  mrg   a5 = arg->expr;
    341  1.1  mrg   arg = arg->next;
    342  1.1  mrg   if (arg == NULL)
    343  1.1  mrg     return (*specific->check.f5) (a1, a2, a3, a4, a5);
    344  1.1  mrg 
    345  1.1  mrg   gfc_internal_error ("do_check(): too many args");
    346  1.1  mrg }
    347  1.1  mrg 
    348  1.1  mrg 
    349  1.1  mrg /*********** Subroutines to build the intrinsic list ****************/
    350  1.1  mrg 
    351  1.1  mrg /* Add a single intrinsic symbol to the current list.
    352  1.1  mrg 
    353  1.1  mrg    Argument list:
    354  1.1  mrg       char *     name of function
    355  1.1  mrg       int	whether function is elemental
    356  1.1  mrg       int	If the function can be used as an actual argument [1]
    357  1.1  mrg       bt	 return type of function
    358  1.1  mrg       int	kind of return type of function
    359  1.1  mrg       int	Fortran standard version
    360  1.1  mrg       check      pointer to check function
    361  1.1  mrg       simplify   pointer to simplification function
    362  1.1  mrg       resolve    pointer to resolution function
    363  1.1  mrg 
    364  1.1  mrg    Optional arguments come in multiples of five:
    365  1.1  mrg       char *      name of argument
    366  1.1  mrg       bt          type of argument
    367  1.1  mrg       int         kind of argument
    368  1.1  mrg       int         arg optional flag (1=optional, 0=required)
    369  1.1  mrg       sym_intent  intent of argument
    370  1.1  mrg 
    371  1.1  mrg    The sequence is terminated by a NULL name.
    372  1.1  mrg 
    373  1.1  mrg 
    374  1.1  mrg  [1] Whether a function can or cannot be used as an actual argument is
    375  1.1  mrg      determined by its presence on the 13.6 list in Fortran 2003.  The
    376  1.1  mrg      following intrinsics, which are GNU extensions, are considered allowed
    377  1.1  mrg      as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
    378  1.1  mrg      ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT.  */
    379  1.1  mrg 
    380  1.1  mrg static void
    381  1.1  mrg add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
    382  1.1  mrg 	 int standard, gfc_check_f check, gfc_simplify_f simplify,
    383  1.1  mrg 	 gfc_resolve_f resolve, ...)
    384  1.1  mrg {
    385  1.1  mrg   char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
    386  1.1  mrg   int optional, first_flag;
    387  1.1  mrg   sym_intent intent;
    388  1.1  mrg   va_list argp;
    389  1.1  mrg 
    390  1.1  mrg   switch (sizing)
    391  1.1  mrg     {
    392  1.1  mrg     case SZ_SUBS:
    393  1.1  mrg       nsub++;
    394  1.1  mrg       break;
    395  1.1  mrg 
    396  1.1  mrg     case SZ_FUNCS:
    397  1.1  mrg       nfunc++;
    398  1.1  mrg       break;
    399  1.1  mrg 
    400  1.1  mrg     case SZ_NOTHING:
    401  1.1  mrg       next_sym->name = gfc_get_string ("%s", name);
    402  1.1  mrg 
    403  1.1  mrg       strcpy (buf, "_gfortran_");
    404  1.1  mrg       strcat (buf, name);
    405  1.1  mrg       next_sym->lib_name = gfc_get_string ("%s", buf);
    406  1.1  mrg 
    407  1.1  mrg       next_sym->pure = (cl != CLASS_IMPURE);
    408  1.1  mrg       next_sym->elemental = (cl == CLASS_ELEMENTAL);
    409  1.1  mrg       next_sym->inquiry = (cl == CLASS_INQUIRY);
    410  1.1  mrg       next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
    411  1.1  mrg       next_sym->actual_ok = actual_ok;
    412  1.1  mrg       next_sym->ts.type = type;
    413  1.1  mrg       next_sym->ts.kind = kind;
    414  1.1  mrg       next_sym->standard = standard;
    415  1.1  mrg       next_sym->simplify = simplify;
    416  1.1  mrg       next_sym->check = check;
    417  1.1  mrg       next_sym->resolve = resolve;
    418  1.1  mrg       next_sym->specific = 0;
    419  1.1  mrg       next_sym->generic = 0;
    420  1.1  mrg       next_sym->conversion = 0;
    421  1.1  mrg       next_sym->id = id;
    422  1.1  mrg       break;
    423  1.1  mrg 
    424  1.1  mrg     default:
    425  1.1  mrg       gfc_internal_error ("add_sym(): Bad sizing mode");
    426  1.1  mrg     }
    427  1.1  mrg 
    428  1.1  mrg   va_start (argp, resolve);
    429  1.1  mrg 
    430  1.1  mrg   first_flag = 1;
    431  1.1  mrg 
    432  1.1  mrg   for (;;)
    433  1.1  mrg     {
    434  1.1  mrg       name = va_arg (argp, char *);
    435  1.1  mrg       if (name == NULL)
    436  1.1  mrg 	break;
    437  1.1  mrg 
    438  1.1  mrg       type = (bt) va_arg (argp, int);
    439  1.1  mrg       kind = va_arg (argp, int);
    440  1.1  mrg       optional = va_arg (argp, int);
    441  1.1  mrg       intent = (sym_intent) va_arg (argp, int);
    442  1.1  mrg 
    443  1.1  mrg       if (sizing != SZ_NOTHING)
    444  1.1  mrg 	nargs++;
    445  1.1  mrg       else
    446  1.1  mrg 	{
    447  1.1  mrg 	  next_arg++;
    448  1.1  mrg 
    449  1.1  mrg 	  if (first_flag)
    450  1.1  mrg 	    next_sym->formal = next_arg;
    451  1.1  mrg 	  else
    452  1.1  mrg 	    (next_arg - 1)->next = next_arg;
    453  1.1  mrg 
    454  1.1  mrg 	  first_flag = 0;
    455  1.1  mrg 
    456  1.1  mrg 	  strcpy (next_arg->name, name);
    457  1.1  mrg 	  next_arg->ts.type = type;
    458  1.1  mrg 	  next_arg->ts.kind = kind;
    459  1.1  mrg 	  next_arg->optional = optional;
    460  1.1  mrg 	  next_arg->value = 0;
    461  1.1  mrg 	  next_arg->intent = intent;
    462  1.1  mrg 	}
    463  1.1  mrg     }
    464  1.1  mrg 
    465  1.1  mrg   va_end (argp);
    466  1.1  mrg 
    467  1.1  mrg   next_sym++;
    468  1.1  mrg }
    469  1.1  mrg 
    470  1.1  mrg 
    471  1.1  mrg /* Add a symbol to the function list where the function takes
    472  1.1  mrg    0 arguments.  */
    473  1.1  mrg 
    474  1.1  mrg static void
    475  1.1  mrg add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    476  1.1  mrg 	   int kind, int standard,
    477  1.1  mrg 	   bool (*check) (void),
    478  1.1  mrg 	   gfc_expr *(*simplify) (void),
    479  1.1  mrg 	   void (*resolve) (gfc_expr *))
    480  1.1  mrg {
    481  1.1  mrg   gfc_simplify_f sf;
    482  1.1  mrg   gfc_check_f cf;
    483  1.1  mrg   gfc_resolve_f rf;
    484  1.1  mrg 
    485  1.1  mrg   cf.f0 = check;
    486  1.1  mrg   sf.f0 = simplify;
    487  1.1  mrg   rf.f0 = resolve;
    488  1.1  mrg 
    489  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    490  1.1  mrg 	   (void *) 0);
    491  1.1  mrg }
    492  1.1  mrg 
    493  1.1  mrg 
    494  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    495  1.1  mrg    0 arguments.  */
    496  1.1  mrg 
    497  1.1  mrg static void
    498  1.1  mrg add_sym_0s (const char *name, gfc_isym_id id, int standard,
    499  1.1  mrg 	    void (*resolve) (gfc_code *))
    500  1.1  mrg {
    501  1.1  mrg   gfc_check_f cf;
    502  1.1  mrg   gfc_simplify_f sf;
    503  1.1  mrg   gfc_resolve_f rf;
    504  1.1  mrg 
    505  1.1  mrg   cf.f1 = NULL;
    506  1.1  mrg   sf.f1 = NULL;
    507  1.1  mrg   rf.s1 = resolve;
    508  1.1  mrg 
    509  1.1  mrg   add_sym (name, id, CLASS_IMPURE, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf,
    510  1.1  mrg 	   rf, (void *) 0);
    511  1.1  mrg }
    512  1.1  mrg 
    513  1.1  mrg 
    514  1.1  mrg /* Add a symbol to the function list where the function takes
    515  1.1  mrg    1 arguments.  */
    516  1.1  mrg 
    517  1.1  mrg static void
    518  1.1  mrg add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    519  1.1  mrg 	   int kind, int standard,
    520  1.1  mrg 	   bool (*check) (gfc_expr *),
    521  1.1  mrg 	   gfc_expr *(*simplify) (gfc_expr *),
    522  1.1  mrg 	   void (*resolve) (gfc_expr *, gfc_expr *),
    523  1.1  mrg 	   const char *a1, bt type1, int kind1, int optional1)
    524  1.1  mrg {
    525  1.1  mrg   gfc_check_f cf;
    526  1.1  mrg   gfc_simplify_f sf;
    527  1.1  mrg   gfc_resolve_f rf;
    528  1.1  mrg 
    529  1.1  mrg   cf.f1 = check;
    530  1.1  mrg   sf.f1 = simplify;
    531  1.1  mrg   rf.f1 = resolve;
    532  1.1  mrg 
    533  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    534  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    535  1.1  mrg 	   (void *) 0);
    536  1.1  mrg }
    537  1.1  mrg 
    538  1.1  mrg 
    539  1.1  mrg /* Add a symbol to the function list where the function takes
    540  1.1  mrg    1 arguments, specifying the intent of the argument.  */
    541  1.1  mrg 
    542  1.1  mrg static void
    543  1.1  mrg add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
    544  1.1  mrg 		  int actual_ok, bt type, int kind, int standard,
    545  1.1  mrg 		  bool (*check) (gfc_expr *),
    546  1.1  mrg 		  gfc_expr *(*simplify) (gfc_expr *),
    547  1.1  mrg 		  void (*resolve) (gfc_expr *, gfc_expr *),
    548  1.1  mrg 		  const char *a1, bt type1, int kind1, int optional1,
    549  1.1  mrg 		  sym_intent intent1)
    550  1.1  mrg {
    551  1.1  mrg   gfc_check_f cf;
    552  1.1  mrg   gfc_simplify_f sf;
    553  1.1  mrg   gfc_resolve_f rf;
    554  1.1  mrg 
    555  1.1  mrg   cf.f1 = check;
    556  1.1  mrg   sf.f1 = simplify;
    557  1.1  mrg   rf.f1 = resolve;
    558  1.1  mrg 
    559  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    560  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    561  1.1  mrg 	   (void *) 0);
    562  1.1  mrg }
    563  1.1  mrg 
    564  1.1  mrg 
    565  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    566  1.1  mrg    1 arguments, specifying the intent of the argument.  */
    567  1.1  mrg 
    568  1.1  mrg static void
    569  1.1  mrg add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
    570  1.1  mrg 	    int standard, bool (*check) (gfc_expr *),
    571  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *),
    572  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    573  1.1  mrg 	    sym_intent intent1)
    574  1.1  mrg {
    575  1.1  mrg   gfc_check_f cf;
    576  1.1  mrg   gfc_simplify_f sf;
    577  1.1  mrg   gfc_resolve_f rf;
    578  1.1  mrg 
    579  1.1  mrg   cf.f1 = check;
    580  1.1  mrg   sf.f1 = simplify;
    581  1.1  mrg   rf.s1 = resolve;
    582  1.1  mrg 
    583  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    584  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    585  1.1  mrg 	   (void *) 0);
    586  1.1  mrg }
    587  1.1  mrg 
    588  1.1  mrg /* Add a symbol to the subroutine ilst where the subroutine takes one
    589  1.1  mrg    printf-style character argument and a variable number of arguments
    590  1.1  mrg    to follow.  */
    591  1.1  mrg 
    592  1.1  mrg static void
    593  1.1  mrg add_sym_1p (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
    594  1.1  mrg 	    int standard, bool (*check) (gfc_actual_arglist *),
    595  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr*), void (*resolve) (gfc_code *),
    596  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1, sym_intent intent1)
    597  1.1  mrg {
    598  1.1  mrg   gfc_check_f cf;
    599  1.1  mrg   gfc_simplify_f sf;
    600  1.1  mrg   gfc_resolve_f rf;
    601  1.1  mrg 
    602  1.1  mrg   cf.f1m = check;
    603  1.1  mrg   sf.f1 = simplify;
    604  1.1  mrg   rf.s1 = resolve;
    605  1.1  mrg 
    606  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    607  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    608  1.1  mrg 	   (void *) 0);
    609  1.1  mrg }
    610  1.1  mrg 
    611  1.1  mrg 
    612  1.1  mrg /* Add a symbol from the MAX/MIN family of intrinsic functions to the
    613  1.1  mrg    function.  MAX et al take 2 or more arguments.  */
    614  1.1  mrg 
    615  1.1  mrg static void
    616  1.1  mrg add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    617  1.1  mrg 	    int kind, int standard,
    618  1.1  mrg 	    bool (*check) (gfc_actual_arglist *),
    619  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *),
    620  1.1  mrg 	    void (*resolve) (gfc_expr *, gfc_actual_arglist *),
    621  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    622  1.1  mrg 	    const char *a2, bt type2, int kind2, int optional2)
    623  1.1  mrg {
    624  1.1  mrg   gfc_check_f cf;
    625  1.1  mrg   gfc_simplify_f sf;
    626  1.1  mrg   gfc_resolve_f rf;
    627  1.1  mrg 
    628  1.1  mrg   cf.f1m = check;
    629  1.1  mrg   sf.f1 = simplify;
    630  1.1  mrg   rf.f1m = resolve;
    631  1.1  mrg 
    632  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    633  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    634  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    635  1.1  mrg 	   (void *) 0);
    636  1.1  mrg }
    637  1.1  mrg 
    638  1.1  mrg 
    639  1.1  mrg /* Add a symbol to the function list where the function takes
    640  1.1  mrg    2 arguments.  */
    641  1.1  mrg 
    642  1.1  mrg static void
    643  1.1  mrg add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    644  1.1  mrg 	   int kind, int standard,
    645  1.1  mrg 	   bool (*check) (gfc_expr *, gfc_expr *),
    646  1.1  mrg 	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
    647  1.1  mrg 	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
    648  1.1  mrg 	   const char *a1, bt type1, int kind1, int optional1,
    649  1.1  mrg 	   const char *a2, bt type2, int kind2, int optional2)
    650  1.1  mrg {
    651  1.1  mrg   gfc_check_f cf;
    652  1.1  mrg   gfc_simplify_f sf;
    653  1.1  mrg   gfc_resolve_f rf;
    654  1.1  mrg 
    655  1.1  mrg   cf.f2 = check;
    656  1.1  mrg   sf.f2 = simplify;
    657  1.1  mrg   rf.f2 = resolve;
    658  1.1  mrg 
    659  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    660  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    661  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    662  1.1  mrg 	   (void *) 0);
    663  1.1  mrg }
    664  1.1  mrg 
    665  1.1  mrg 
    666  1.1  mrg /* Add a symbol to the function list where the function takes
    667  1.1  mrg    2 arguments; same as add_sym_2 - but allows to specify the intent.  */
    668  1.1  mrg 
    669  1.1  mrg static void
    670  1.1  mrg add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
    671  1.1  mrg 		  int actual_ok, bt type, int kind, int standard,
    672  1.1  mrg 		  bool (*check) (gfc_expr *, gfc_expr *),
    673  1.1  mrg 		  gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
    674  1.1  mrg 		  void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
    675  1.1  mrg 		  const char *a1, bt type1, int kind1, int optional1,
    676  1.1  mrg 		  sym_intent intent1, const char *a2, bt type2, int kind2,
    677  1.1  mrg 		  int optional2, sym_intent intent2)
    678  1.1  mrg {
    679  1.1  mrg   gfc_check_f cf;
    680  1.1  mrg   gfc_simplify_f sf;
    681  1.1  mrg   gfc_resolve_f rf;
    682  1.1  mrg 
    683  1.1  mrg   cf.f2 = check;
    684  1.1  mrg   sf.f2 = simplify;
    685  1.1  mrg   rf.f2 = resolve;
    686  1.1  mrg 
    687  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    688  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    689  1.1  mrg 	   a2, type2, kind2, optional2, intent2,
    690  1.1  mrg 	   (void *) 0);
    691  1.1  mrg }
    692  1.1  mrg 
    693  1.1  mrg 
    694  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    695  1.1  mrg    2 arguments, specifying the intent of the arguments.  */
    696  1.1  mrg 
    697  1.1  mrg static void
    698  1.1  mrg add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
    699  1.1  mrg 	    int kind, int standard,
    700  1.1  mrg 	    bool (*check) (gfc_expr *, gfc_expr *),
    701  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
    702  1.1  mrg 	    void (*resolve) (gfc_code *),
    703  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    704  1.1  mrg 	    sym_intent intent1, const char *a2, bt type2, int kind2,
    705  1.1  mrg 	    int optional2, sym_intent intent2)
    706  1.1  mrg {
    707  1.1  mrg   gfc_check_f cf;
    708  1.1  mrg   gfc_simplify_f sf;
    709  1.1  mrg   gfc_resolve_f rf;
    710  1.1  mrg 
    711  1.1  mrg   cf.f2 = check;
    712  1.1  mrg   sf.f2 = simplify;
    713  1.1  mrg   rf.s1 = resolve;
    714  1.1  mrg 
    715  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    716  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    717  1.1  mrg 	   a2, type2, kind2, optional2, intent2,
    718  1.1  mrg 	   (void *) 0);
    719  1.1  mrg }
    720  1.1  mrg 
    721  1.1  mrg 
    722  1.1  mrg /* Add a symbol to the function list where the function takes
    723  1.1  mrg    3 arguments.  */
    724  1.1  mrg 
    725  1.1  mrg static void
    726  1.1  mrg add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    727  1.1  mrg 	   int kind, int standard,
    728  1.1  mrg 	   bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
    729  1.1  mrg 	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
    730  1.1  mrg 	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
    731  1.1  mrg 	   const char *a1, bt type1, int kind1, int optional1,
    732  1.1  mrg 	   const char *a2, bt type2, int kind2, int optional2,
    733  1.1  mrg 	   const char *a3, bt type3, int kind3, int optional3)
    734  1.1  mrg {
    735  1.1  mrg   gfc_check_f cf;
    736  1.1  mrg   gfc_simplify_f sf;
    737  1.1  mrg   gfc_resolve_f rf;
    738  1.1  mrg 
    739  1.1  mrg   cf.f3 = check;
    740  1.1  mrg   sf.f3 = simplify;
    741  1.1  mrg   rf.f3 = resolve;
    742  1.1  mrg 
    743  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    744  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    745  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    746  1.1  mrg 	   a3, type3, kind3, optional3, INTENT_IN,
    747  1.1  mrg 	   (void *) 0);
    748  1.1  mrg }
    749  1.1  mrg 
    750  1.1  mrg 
    751  1.1  mrg /* MINLOC and MAXLOC get special treatment because their
    752  1.1  mrg    argument might have to be reordered.  */
    753  1.1  mrg 
    754  1.1  mrg static void
    755  1.1  mrg add_sym_5ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    756  1.1  mrg 	     int kind, int standard,
    757  1.1  mrg 	     bool (*check) (gfc_actual_arglist *),
    758  1.1  mrg 	     gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
    759  1.1  mrg 				    gfc_expr *, gfc_expr *),
    760  1.1  mrg 	     void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
    761  1.1  mrg 			      gfc_expr *, gfc_expr *),
    762  1.1  mrg 	     const char *a1, bt type1, int kind1, int optional1,
    763  1.1  mrg 	     const char *a2, bt type2, int kind2, int optional2,
    764  1.1  mrg 	     const char *a3, bt type3, int kind3, int optional3,
    765  1.1  mrg 	     const char *a4, bt type4, int kind4, int optional4,
    766  1.1  mrg 	     const char *a5, bt type5, int kind5, int optional5)
    767  1.1  mrg {
    768  1.1  mrg   gfc_check_f cf;
    769  1.1  mrg   gfc_simplify_f sf;
    770  1.1  mrg   gfc_resolve_f rf;
    771  1.1  mrg 
    772  1.1  mrg   cf.f5ml = check;
    773  1.1  mrg   sf.f5 = simplify;
    774  1.1  mrg   rf.f5 = resolve;
    775  1.1  mrg 
    776  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    777  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    778  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    779  1.1  mrg 	   a3, type3, kind3, optional3, INTENT_IN,
    780  1.1  mrg 	   a4, type4, kind4, optional4, INTENT_IN,
    781  1.1  mrg 	   a5, type5, kind5, optional5, INTENT_IN,
    782  1.1  mrg 	   (void *) 0);
    783  1.1  mrg }
    784  1.1  mrg 
    785  1.1  mrg /* Similar for FINDLOC.  */
    786  1.1  mrg 
    787  1.1  mrg static void
    788  1.1  mrg add_sym_6fl (const char *name, gfc_isym_id id, enum klass cl, int actual_ok,
    789  1.1  mrg 	     bt type, int kind, int standard,
    790  1.1  mrg 	     bool (*check) (gfc_actual_arglist *),
    791  1.1  mrg 	     gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
    792  1.1  mrg 				    gfc_expr *, gfc_expr *, gfc_expr *),
    793  1.1  mrg 	     void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
    794  1.1  mrg 			      gfc_expr *, gfc_expr *, gfc_expr *),
    795  1.1  mrg 	     const char *a1, bt type1, int kind1, int optional1,
    796  1.1  mrg 	     const char *a2, bt type2, int kind2, int optional2,
    797  1.1  mrg 	     const char *a3, bt type3, int kind3, int optional3,
    798  1.1  mrg 	     const char *a4, bt type4, int kind4, int optional4,
    799  1.1  mrg 	     const char *a5, bt type5, int kind5, int optional5,
    800  1.1  mrg 	     const char *a6, bt type6, int kind6, int optional6)
    801  1.1  mrg 
    802  1.1  mrg {
    803  1.1  mrg   gfc_check_f cf;
    804  1.1  mrg   gfc_simplify_f sf;
    805  1.1  mrg   gfc_resolve_f rf;
    806  1.1  mrg 
    807  1.1  mrg   cf.f6fl = check;
    808  1.1  mrg   sf.f6 = simplify;
    809  1.1  mrg   rf.f6 = resolve;
    810  1.1  mrg 
    811  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    812  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    813  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    814  1.1  mrg 	   a3, type3, kind3, optional3, INTENT_IN,
    815  1.1  mrg 	   a4, type4, kind4, optional4, INTENT_IN,
    816  1.1  mrg 	   a5, type5, kind5, optional5, INTENT_IN,
    817  1.1  mrg 	   a6, type6, kind6, optional6, INTENT_IN,
    818  1.1  mrg 	   (void *) 0);
    819  1.1  mrg }
    820  1.1  mrg 
    821  1.1  mrg 
    822  1.1  mrg /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
    823  1.1  mrg    their argument also might have to be reordered.  */
    824  1.1  mrg 
    825  1.1  mrg static void
    826  1.1  mrg add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    827  1.1  mrg 	      int kind, int standard,
    828  1.1  mrg 	      bool (*check) (gfc_actual_arglist *),
    829  1.1  mrg 	      gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
    830  1.1  mrg 	      void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
    831  1.1  mrg 	      const char *a1, bt type1, int kind1, int optional1,
    832  1.1  mrg 	      const char *a2, bt type2, int kind2, int optional2,
    833  1.1  mrg 	      const char *a3, bt type3, int kind3, int optional3)
    834  1.1  mrg {
    835  1.1  mrg   gfc_check_f cf;
    836  1.1  mrg   gfc_simplify_f sf;
    837  1.1  mrg   gfc_resolve_f rf;
    838  1.1  mrg 
    839  1.1  mrg   cf.f3red = check;
    840  1.1  mrg   sf.f3 = simplify;
    841  1.1  mrg   rf.f3 = resolve;
    842  1.1  mrg 
    843  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    844  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    845  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    846  1.1  mrg 	   a3, type3, kind3, optional3, INTENT_IN,
    847  1.1  mrg 	   (void *) 0);
    848  1.1  mrg }
    849  1.1  mrg 
    850  1.1  mrg 
    851  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    852  1.1  mrg    3 arguments, specifying the intent of the arguments.  */
    853  1.1  mrg 
    854  1.1  mrg static void
    855  1.1  mrg add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
    856  1.1  mrg 	    int kind, int standard,
    857  1.1  mrg 	    bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
    858  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
    859  1.1  mrg 	    void (*resolve) (gfc_code *),
    860  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    861  1.1  mrg 	    sym_intent intent1, const char *a2, bt type2, int kind2,
    862  1.1  mrg 	    int optional2, sym_intent intent2, const char *a3, bt type3,
    863  1.1  mrg 	    int kind3, int optional3, sym_intent intent3)
    864  1.1  mrg {
    865  1.1  mrg   gfc_check_f cf;
    866  1.1  mrg   gfc_simplify_f sf;
    867  1.1  mrg   gfc_resolve_f rf;
    868  1.1  mrg 
    869  1.1  mrg   cf.f3 = check;
    870  1.1  mrg   sf.f3 = simplify;
    871  1.1  mrg   rf.s1 = resolve;
    872  1.1  mrg 
    873  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    874  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    875  1.1  mrg 	   a2, type2, kind2, optional2, intent2,
    876  1.1  mrg 	   a3, type3, kind3, optional3, intent3,
    877  1.1  mrg 	   (void *) 0);
    878  1.1  mrg }
    879  1.1  mrg 
    880  1.1  mrg 
    881  1.1  mrg /* Add a symbol to the function list where the function takes
    882  1.1  mrg    4 arguments.  */
    883  1.1  mrg 
    884  1.1  mrg static void
    885  1.1  mrg add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
    886  1.1  mrg 	   int kind, int standard,
    887  1.1  mrg 	   bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
    888  1.1  mrg 	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
    889  1.1  mrg 				  gfc_expr *),
    890  1.1  mrg 	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
    891  1.1  mrg 			    gfc_expr *),
    892  1.1  mrg 	   const char *a1, bt type1, int kind1, int optional1,
    893  1.1  mrg 	   const char *a2, bt type2, int kind2, int optional2,
    894  1.1  mrg 	   const char *a3, bt type3, int kind3, int optional3,
    895  1.1  mrg 	   const char *a4, bt type4, int kind4, int optional4 )
    896  1.1  mrg {
    897  1.1  mrg   gfc_check_f cf;
    898  1.1  mrg   gfc_simplify_f sf;
    899  1.1  mrg   gfc_resolve_f rf;
    900  1.1  mrg 
    901  1.1  mrg   cf.f4 = check;
    902  1.1  mrg   sf.f4 = simplify;
    903  1.1  mrg   rf.f4 = resolve;
    904  1.1  mrg 
    905  1.1  mrg   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
    906  1.1  mrg 	   a1, type1, kind1, optional1, INTENT_IN,
    907  1.1  mrg 	   a2, type2, kind2, optional2, INTENT_IN,
    908  1.1  mrg 	   a3, type3, kind3, optional3, INTENT_IN,
    909  1.1  mrg 	   a4, type4, kind4, optional4, INTENT_IN,
    910  1.1  mrg 	   (void *) 0);
    911  1.1  mrg }
    912  1.1  mrg 
    913  1.1  mrg 
    914  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    915  1.1  mrg    4 arguments.  */
    916  1.1  mrg 
    917  1.1  mrg static void
    918  1.1  mrg add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
    919  1.1  mrg 	    int standard,
    920  1.1  mrg 	    bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
    921  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
    922  1.1  mrg 				   gfc_expr *),
    923  1.1  mrg 	    void (*resolve) (gfc_code *),
    924  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    925  1.1  mrg 	    sym_intent intent1, const char *a2, bt type2, int kind2,
    926  1.1  mrg 	    int optional2, sym_intent intent2, const char *a3, bt type3,
    927  1.1  mrg 	    int kind3, int optional3, sym_intent intent3, const char *a4,
    928  1.1  mrg 	    bt type4, int kind4, int optional4, sym_intent intent4)
    929  1.1  mrg {
    930  1.1  mrg   gfc_check_f cf;
    931  1.1  mrg   gfc_simplify_f sf;
    932  1.1  mrg   gfc_resolve_f rf;
    933  1.1  mrg 
    934  1.1  mrg   cf.f4 = check;
    935  1.1  mrg   sf.f4 = simplify;
    936  1.1  mrg   rf.s1 = resolve;
    937  1.1  mrg 
    938  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    939  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    940  1.1  mrg 	   a2, type2, kind2, optional2, intent2,
    941  1.1  mrg 	   a3, type3, kind3, optional3, intent3,
    942  1.1  mrg 	   a4, type4, kind4, optional4, intent4,
    943  1.1  mrg 	   (void *) 0);
    944  1.1  mrg }
    945  1.1  mrg 
    946  1.1  mrg 
    947  1.1  mrg /* Add a symbol to the subroutine list where the subroutine takes
    948  1.1  mrg    5 arguments.  */
    949  1.1  mrg 
    950  1.1  mrg static void
    951  1.1  mrg add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
    952  1.1  mrg 	    int standard,
    953  1.1  mrg 	    bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
    954  1.1  mrg 			  gfc_expr *),
    955  1.1  mrg 	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
    956  1.1  mrg 				   gfc_expr *, gfc_expr *),
    957  1.1  mrg 	    void (*resolve) (gfc_code *),
    958  1.1  mrg 	    const char *a1, bt type1, int kind1, int optional1,
    959  1.1  mrg 	    sym_intent intent1, const char *a2, bt type2, int kind2,
    960  1.1  mrg 	    int optional2, sym_intent intent2, const char *a3, bt type3,
    961  1.1  mrg 	    int kind3, int optional3, sym_intent intent3, const char *a4,
    962  1.1  mrg 	    bt type4, int kind4, int optional4, sym_intent intent4,
    963  1.1  mrg 	    const char *a5, bt type5, int kind5, int optional5,
    964  1.1  mrg 	    sym_intent intent5)
    965  1.1  mrg {
    966  1.1  mrg   gfc_check_f cf;
    967  1.1  mrg   gfc_simplify_f sf;
    968  1.1  mrg   gfc_resolve_f rf;
    969  1.1  mrg 
    970  1.1  mrg   cf.f5 = check;
    971  1.1  mrg   sf.f5 = simplify;
    972  1.1  mrg   rf.s1 = resolve;
    973  1.1  mrg 
    974  1.1  mrg   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
    975  1.1  mrg 	   a1, type1, kind1, optional1, intent1,
    976  1.1  mrg 	   a2, type2, kind2, optional2, intent2,
    977  1.1  mrg 	   a3, type3, kind3, optional3, intent3,
    978  1.1  mrg 	   a4, type4, kind4, optional4, intent4,
    979  1.1  mrg 	   a5, type5, kind5, optional5, intent5,
    980  1.1  mrg 	   (void *) 0);
    981  1.1  mrg }
    982  1.1  mrg 
    983  1.1  mrg 
    984  1.1  mrg /* Locate an intrinsic symbol given a base pointer, number of elements
    985  1.1  mrg    in the table and a pointer to a name.  Returns the NULL pointer if
    986  1.1  mrg    a name is not found.  */
    987  1.1  mrg 
    988  1.1  mrg static gfc_intrinsic_sym *
    989  1.1  mrg find_sym (gfc_intrinsic_sym *start, int n, const char *name)
    990  1.1  mrg {
    991  1.1  mrg   /* name may be a user-supplied string, so we must first make sure
    992  1.1  mrg      that we're comparing against a pointer into the global string
    993  1.1  mrg      table.  */
    994  1.1  mrg   const char *p = gfc_get_string ("%s", name);
    995  1.1  mrg 
    996  1.1  mrg   while (n > 0)
    997  1.1  mrg     {
    998  1.1  mrg       if (p == start->name)
    999  1.1  mrg 	return start;
   1000  1.1  mrg 
   1001  1.1  mrg       start++;
   1002  1.1  mrg       n--;
   1003  1.1  mrg     }
   1004  1.1  mrg 
   1005  1.1  mrg   return NULL;
   1006  1.1  mrg }
   1007  1.1  mrg 
   1008  1.1  mrg 
   1009  1.1  mrg gfc_isym_id
   1010  1.1  mrg gfc_isym_id_by_intmod (intmod_id from_intmod, int intmod_sym_id)
   1011  1.1  mrg {
   1012  1.1  mrg   if (from_intmod == INTMOD_NONE)
   1013  1.1  mrg     return (gfc_isym_id) intmod_sym_id;
   1014  1.1  mrg   else if (from_intmod == INTMOD_ISO_C_BINDING)
   1015  1.1  mrg     return (gfc_isym_id) c_interop_kinds_table[intmod_sym_id].value;
   1016  1.1  mrg   else if (from_intmod == INTMOD_ISO_FORTRAN_ENV)
   1017  1.1  mrg     switch (intmod_sym_id)
   1018  1.1  mrg       {
   1019  1.1  mrg #define NAMED_SUBROUTINE(a,b,c,d) \
   1020  1.1  mrg       case a: \
   1021  1.1  mrg 	return (gfc_isym_id) c;
   1022  1.1  mrg #define NAMED_FUNCTION(a,b,c,d) \
   1023  1.1  mrg       case a: \
   1024  1.1  mrg 	return (gfc_isym_id) c;
   1025  1.1  mrg #include "iso-fortran-env.def"
   1026  1.1  mrg       default:
   1027  1.1  mrg 	gcc_unreachable ();
   1028  1.1  mrg       }
   1029  1.1  mrg   else
   1030  1.1  mrg     gcc_unreachable ();
   1031  1.1  mrg   return (gfc_isym_id) 0;
   1032  1.1  mrg }
   1033  1.1  mrg 
   1034  1.1  mrg 
   1035  1.1  mrg gfc_isym_id
   1036  1.1  mrg gfc_isym_id_by_intmod_sym (gfc_symbol *sym)
   1037  1.1  mrg {
   1038  1.1  mrg   return gfc_isym_id_by_intmod (sym->from_intmod, sym->intmod_sym_id);
   1039  1.1  mrg }
   1040  1.1  mrg 
   1041  1.1  mrg 
   1042  1.1  mrg gfc_intrinsic_sym *
   1043  1.1  mrg gfc_intrinsic_subroutine_by_id (gfc_isym_id id)
   1044  1.1  mrg {
   1045  1.1  mrg   gfc_intrinsic_sym *start = subroutines;
   1046  1.1  mrg   int n = nsub;
   1047  1.1  mrg 
   1048  1.1  mrg   while (true)
   1049  1.1  mrg     {
   1050  1.1  mrg       gcc_assert (n > 0);
   1051  1.1  mrg       if (id == start->id)
   1052  1.1  mrg 	return start;
   1053  1.1  mrg 
   1054  1.1  mrg       start++;
   1055  1.1  mrg       n--;
   1056  1.1  mrg     }
   1057  1.1  mrg }
   1058  1.1  mrg 
   1059  1.1  mrg 
   1060  1.1  mrg gfc_intrinsic_sym *
   1061  1.1  mrg gfc_intrinsic_function_by_id (gfc_isym_id id)
   1062  1.1  mrg {
   1063  1.1  mrg   gfc_intrinsic_sym *start = functions;
   1064  1.1  mrg   int n = nfunc;
   1065  1.1  mrg 
   1066  1.1  mrg   while (true)
   1067  1.1  mrg     {
   1068  1.1  mrg       gcc_assert (n > 0);
   1069  1.1  mrg       if (id == start->id)
   1070  1.1  mrg 	return start;
   1071  1.1  mrg 
   1072  1.1  mrg       start++;
   1073  1.1  mrg       n--;
   1074  1.1  mrg     }
   1075  1.1  mrg }
   1076  1.1  mrg 
   1077  1.1  mrg 
   1078  1.1  mrg /* Given a name, find a function in the intrinsic function table.
   1079  1.1  mrg    Returns NULL if not found.  */
   1080  1.1  mrg 
   1081  1.1  mrg gfc_intrinsic_sym *
   1082  1.1  mrg gfc_find_function (const char *name)
   1083  1.1  mrg {
   1084  1.1  mrg   gfc_intrinsic_sym *sym;
   1085  1.1  mrg 
   1086  1.1  mrg   sym = find_sym (functions, nfunc, name);
   1087  1.1  mrg   if (!sym || sym->from_module)
   1088  1.1  mrg     sym = find_sym (conversion, nconv, name);
   1089  1.1  mrg 
   1090  1.1  mrg   return (!sym || sym->from_module) ? NULL : sym;
   1091  1.1  mrg }
   1092  1.1  mrg 
   1093  1.1  mrg 
   1094  1.1  mrg /* Given a name, find a function in the intrinsic subroutine table.
   1095  1.1  mrg    Returns NULL if not found.  */
   1096  1.1  mrg 
   1097  1.1  mrg gfc_intrinsic_sym *
   1098  1.1  mrg gfc_find_subroutine (const char *name)
   1099  1.1  mrg {
   1100  1.1  mrg   gfc_intrinsic_sym *sym;
   1101  1.1  mrg   sym = find_sym (subroutines, nsub, name);
   1102  1.1  mrg   return (!sym || sym->from_module) ? NULL : sym;
   1103  1.1  mrg }
   1104  1.1  mrg 
   1105  1.1  mrg 
   1106  1.1  mrg /* Given a string, figure out if it is the name of a generic intrinsic
   1107  1.1  mrg    function or not.  */
   1108  1.1  mrg 
   1109  1.1  mrg int
   1110  1.1  mrg gfc_generic_intrinsic (const char *name)
   1111  1.1  mrg {
   1112  1.1  mrg   gfc_intrinsic_sym *sym;
   1113  1.1  mrg 
   1114  1.1  mrg   sym = gfc_find_function (name);
   1115  1.1  mrg   return (!sym || sym->from_module) ? 0 : sym->generic;
   1116  1.1  mrg }
   1117  1.1  mrg 
   1118  1.1  mrg 
   1119  1.1  mrg /* Given a string, figure out if it is the name of a specific
   1120  1.1  mrg    intrinsic function or not.  */
   1121  1.1  mrg 
   1122  1.1  mrg int
   1123  1.1  mrg gfc_specific_intrinsic (const char *name)
   1124  1.1  mrg {
   1125  1.1  mrg   gfc_intrinsic_sym *sym;
   1126  1.1  mrg 
   1127  1.1  mrg   sym = gfc_find_function (name);
   1128  1.1  mrg   return (!sym || sym->from_module) ? 0 : sym->specific;
   1129  1.1  mrg }
   1130  1.1  mrg 
   1131  1.1  mrg 
   1132  1.1  mrg /* Given a string, figure out if it is the name of an intrinsic function
   1133  1.1  mrg    or subroutine allowed as an actual argument or not.  */
   1134  1.1  mrg int
   1135  1.1  mrg gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
   1136  1.1  mrg {
   1137  1.1  mrg   gfc_intrinsic_sym *sym;
   1138  1.1  mrg 
   1139  1.1  mrg   /* Intrinsic subroutines are not allowed as actual arguments.  */
   1140  1.1  mrg   if (subroutine_flag)
   1141  1.1  mrg     return 0;
   1142  1.1  mrg   else
   1143  1.1  mrg     {
   1144  1.1  mrg       sym = gfc_find_function (name);
   1145  1.1  mrg       return (sym == NULL) ? 0 : sym->actual_ok;
   1146  1.1  mrg     }
   1147  1.1  mrg }
   1148  1.1  mrg 
   1149  1.1  mrg 
   1150  1.1  mrg /* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
   1151  1.1  mrg    If its name refers to an intrinsic, but this intrinsic is not included in
   1152  1.1  mrg    the selected standard, this returns FALSE and sets the symbol's external
   1153  1.1  mrg    attribute.  */
   1154  1.1  mrg 
   1155  1.1  mrg bool
   1156  1.1  mrg gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
   1157  1.1  mrg {
   1158  1.1  mrg   gfc_intrinsic_sym* isym;
   1159  1.1  mrg   const char* symstd;
   1160  1.1  mrg 
   1161  1.1  mrg   /* If INTRINSIC attribute is already known, return.  */
   1162  1.1  mrg   if (sym->attr.intrinsic)
   1163  1.1  mrg     return true;
   1164  1.1  mrg 
   1165  1.1  mrg   /* Check for attributes which prevent the symbol from being INTRINSIC.  */
   1166  1.1  mrg   if (sym->attr.external || sym->attr.contained
   1167  1.1  mrg       || sym->attr.recursive
   1168  1.1  mrg       || sym->attr.if_source == IFSRC_IFBODY)
   1169  1.1  mrg     return false;
   1170  1.1  mrg 
   1171  1.1  mrg   if (subroutine_flag)
   1172  1.1  mrg     isym = gfc_find_subroutine (sym->name);
   1173  1.1  mrg   else
   1174  1.1  mrg     isym = gfc_find_function (sym->name);
   1175  1.1  mrg 
   1176  1.1  mrg   /* No such intrinsic available at all?  */
   1177  1.1  mrg   if (!isym)
   1178  1.1  mrg     return false;
   1179  1.1  mrg 
   1180  1.1  mrg   /* See if this intrinsic is allowed in the current standard.  */
   1181  1.1  mrg   if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc)
   1182  1.1  mrg       && !sym->attr.artificial)
   1183  1.1  mrg     {
   1184  1.1  mrg       if (sym->attr.proc == PROC_UNKNOWN && warn_intrinsics_std)
   1185  1.1  mrg 	gfc_warning_now (OPT_Wintrinsics_std, "The intrinsic %qs at %L is not "
   1186  1.1  mrg 			 "included in the selected standard but %s and %qs will"
   1187  1.1  mrg 			 " be treated as if declared EXTERNAL.  Use an"
   1188  1.1  mrg 			 " appropriate %<-std=%> option or define"
   1189  1.1  mrg 			 " %<-fall-intrinsics%> to allow this intrinsic.",
   1190  1.1  mrg 			 sym->name, &loc, symstd, sym->name);
   1191  1.1  mrg 
   1192  1.1  mrg       return false;
   1193  1.1  mrg     }
   1194  1.1  mrg 
   1195  1.1  mrg   return true;
   1196  1.1  mrg }
   1197  1.1  mrg 
   1198  1.1  mrg 
   1199  1.1  mrg /* Collect a set of intrinsic functions into a generic collection.
   1200  1.1  mrg    The first argument is the name of the generic function, which is
   1201  1.1  mrg    also the name of a specific function.  The rest of the specifics
   1202  1.1  mrg    currently in the table are placed into the list of specific
   1203  1.1  mrg    functions associated with that generic.
   1204  1.1  mrg 
   1205  1.1  mrg    PR fortran/32778
   1206  1.1  mrg    FIXME: Remove the argument STANDARD if no regressions are
   1207  1.1  mrg           encountered. Change all callers (approx. 360).
   1208  1.1  mrg */
   1209  1.1  mrg 
   1210  1.1  mrg static void
   1211  1.1  mrg make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
   1212  1.1  mrg {
   1213  1.1  mrg   gfc_intrinsic_sym *g;
   1214  1.1  mrg 
   1215  1.1  mrg   if (sizing != SZ_NOTHING)
   1216  1.1  mrg     return;
   1217  1.1  mrg 
   1218  1.1  mrg   g = gfc_find_function (name);
   1219  1.1  mrg   if (g == NULL)
   1220  1.1  mrg     gfc_internal_error ("make_generic(): Cannot find generic symbol %qs",
   1221  1.1  mrg 			name);
   1222  1.1  mrg 
   1223  1.1  mrg   gcc_assert (g->id == id);
   1224  1.1  mrg 
   1225  1.1  mrg   g->generic = 1;
   1226  1.1  mrg   g->specific = 1;
   1227  1.1  mrg   if ((g + 1)->name != NULL)
   1228  1.1  mrg     g->specific_head = g + 1;
   1229  1.1  mrg   g++;
   1230  1.1  mrg 
   1231  1.1  mrg   while (g->name != NULL)
   1232  1.1  mrg     {
   1233  1.1  mrg       g->next = g + 1;
   1234  1.1  mrg       g->specific = 1;
   1235  1.1  mrg       g++;
   1236  1.1  mrg     }
   1237  1.1  mrg 
   1238  1.1  mrg   g--;
   1239  1.1  mrg   g->next = NULL;
   1240  1.1  mrg }
   1241  1.1  mrg 
   1242  1.1  mrg 
   1243  1.1  mrg /* Create a duplicate intrinsic function entry for the current
   1244  1.1  mrg    function, the only differences being the alternate name and
   1245  1.1  mrg    a different standard if necessary. Note that we use argument
   1246  1.1  mrg    lists more than once, but all argument lists are freed as a
   1247  1.1  mrg    single block.  */
   1248  1.1  mrg 
   1249  1.1  mrg static void
   1250  1.1  mrg make_alias (const char *name, int standard)
   1251  1.1  mrg {
   1252  1.1  mrg   switch (sizing)
   1253  1.1  mrg     {
   1254  1.1  mrg     case SZ_FUNCS:
   1255  1.1  mrg       nfunc++;
   1256  1.1  mrg       break;
   1257  1.1  mrg 
   1258  1.1  mrg     case SZ_SUBS:
   1259  1.1  mrg       nsub++;
   1260  1.1  mrg       break;
   1261  1.1  mrg 
   1262  1.1  mrg     case SZ_NOTHING:
   1263  1.1  mrg       next_sym[0] = next_sym[-1];
   1264  1.1  mrg       next_sym->name = gfc_get_string ("%s", name);
   1265  1.1  mrg       next_sym->standard = standard;
   1266  1.1  mrg       next_sym++;
   1267  1.1  mrg       break;
   1268  1.1  mrg 
   1269  1.1  mrg     default:
   1270  1.1  mrg       break;
   1271  1.1  mrg     }
   1272  1.1  mrg }
   1273  1.1  mrg 
   1274  1.1  mrg 
   1275  1.1  mrg /* Make the current subroutine noreturn.  */
   1276  1.1  mrg 
   1277  1.1  mrg static void
   1278  1.1  mrg make_noreturn (void)
   1279  1.1  mrg {
   1280  1.1  mrg   if (sizing == SZ_NOTHING)
   1281  1.1  mrg     next_sym[-1].noreturn = 1;
   1282  1.1  mrg }
   1283  1.1  mrg 
   1284  1.1  mrg 
   1285  1.1  mrg /* Mark current intrinsic as module intrinsic.  */
   1286  1.1  mrg static void
   1287  1.1  mrg make_from_module (void)
   1288  1.1  mrg {
   1289  1.1  mrg   if (sizing == SZ_NOTHING)
   1290  1.1  mrg     next_sym[-1].from_module = 1;
   1291  1.1  mrg }
   1292  1.1  mrg 
   1293  1.1  mrg 
   1294  1.1  mrg /* Mark the current subroutine as having a variable number of
   1295  1.1  mrg    arguments.  */
   1296  1.1  mrg 
   1297  1.1  mrg static void
   1298  1.1  mrg make_vararg (void)
   1299  1.1  mrg {
   1300  1.1  mrg   if (sizing == SZ_NOTHING)
   1301  1.1  mrg     next_sym[-1].vararg = 1;
   1302  1.1  mrg }
   1303  1.1  mrg 
   1304  1.1  mrg /* Set the attr.value of the current procedure.  */
   1305  1.1  mrg 
   1306  1.1  mrg static void
   1307  1.1  mrg set_attr_value (int n, ...)
   1308  1.1  mrg {
   1309  1.1  mrg   gfc_intrinsic_arg *arg;
   1310  1.1  mrg   va_list argp;
   1311  1.1  mrg   int i;
   1312  1.1  mrg 
   1313  1.1  mrg   if (sizing != SZ_NOTHING)
   1314  1.1  mrg     return;
   1315  1.1  mrg 
   1316  1.1  mrg   va_start (argp, n);
   1317  1.1  mrg   arg = next_sym[-1].formal;
   1318  1.1  mrg 
   1319  1.1  mrg   for (i = 0; i < n; i++)
   1320  1.1  mrg     {
   1321  1.1  mrg       gcc_assert (arg != NULL);
   1322  1.1  mrg       arg->value = va_arg (argp, int);
   1323  1.1  mrg       arg = arg->next;
   1324  1.1  mrg     }
   1325  1.1  mrg   va_end (argp);
   1326  1.1  mrg }
   1327  1.1  mrg 
   1328  1.1  mrg 
   1329  1.1  mrg /* Add intrinsic functions.  */
   1330  1.1  mrg 
   1331  1.1  mrg static void
   1332  1.1  mrg add_functions (void)
   1333  1.1  mrg {
   1334  1.1  mrg   /* Argument names.  These are used as argument keywords and so need to
   1335  1.1  mrg     match the documentation.  Please keep this list in sorted order.  */
   1336  1.1  mrg   const char
   1337  1.1  mrg     *a = "a", *a1 = "a1", *a2 = "a2", *ar = "array", *b = "b",
   1338  1.1  mrg     *bck = "back", *bd = "boundary", *c = "c", *c_ptr_1 = "c_ptr_1",
   1339  1.1  mrg     *c_ptr_2 = "c_ptr_2", *ca = "coarray", *com = "command",
   1340  1.1  mrg     *dist = "distance", *dm = "dim", *f = "field", *failed="failed",
   1341  1.1  mrg     *fs = "fsource", *han = "handler", *i = "i",
   1342  1.1  mrg     *image = "image", *j = "j", *kind = "kind",
   1343  1.1  mrg     *l = "l", *ln = "len", *level = "level", *m = "matrix", *ma = "matrix_a",
   1344  1.1  mrg     *mb = "matrix_b", *md = "mode", *mo = "mold", *msk = "mask",
   1345  1.1  mrg     *n = "n", *ncopies= "ncopies", *nm = "name", *num = "number",
   1346  1.1  mrg     *ord = "order", *p = "p", *p1 = "path1", *p2 = "path2",
   1347  1.1  mrg     *pad = "pad", *pid = "pid", *pos = "pos", *pt = "pointer",
   1348  1.1  mrg     *r = "r", *s = "s", *set = "set", *sh = "shift", *shp = "shape",
   1349  1.1  mrg     *sig = "sig", *src = "source", *ssg = "substring",
   1350  1.1  mrg     *sta = "string_a", *stb = "string_b", *stg = "string",
   1351  1.1  mrg     *sub = "sub", *sz = "size", *tg = "target", *team = "team", *tm = "time",
   1352  1.1  mrg     *ts = "tsource", *ut = "unit", *v = "vector", *va = "vector_a",
   1353  1.1  mrg     *vb = "vector_b", *vl = "values", *val = "value", *x = "x", *y = "y",
   1354  1.1  mrg     *z = "z";
   1355  1.1  mrg 
   1356  1.1  mrg   int di, dr, dd, dl, dc, dz, ii;
   1357  1.1  mrg 
   1358  1.1  mrg   di = gfc_default_integer_kind;
   1359  1.1  mrg   dr = gfc_default_real_kind;
   1360  1.1  mrg   dd = gfc_default_double_kind;
   1361  1.1  mrg   dl = gfc_default_logical_kind;
   1362  1.1  mrg   dc = gfc_default_character_kind;
   1363  1.1  mrg   dz = gfc_default_complex_kind;
   1364  1.1  mrg   ii = gfc_index_integer_kind;
   1365  1.1  mrg 
   1366  1.1  mrg   add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1367  1.1  mrg 	     gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
   1368  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   1369  1.1  mrg 
   1370  1.1  mrg   if (flag_dec_intrinsic_ints)
   1371  1.1  mrg     {
   1372  1.1  mrg       make_alias ("babs", GFC_STD_GNU);
   1373  1.1  mrg       make_alias ("iiabs", GFC_STD_GNU);
   1374  1.1  mrg       make_alias ("jiabs", GFC_STD_GNU);
   1375  1.1  mrg       make_alias ("kiabs", GFC_STD_GNU);
   1376  1.1  mrg     }
   1377  1.1  mrg 
   1378  1.1  mrg   add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   1379  1.1  mrg 	     NULL, gfc_simplify_abs, gfc_resolve_abs,
   1380  1.1  mrg 	     a, BT_INTEGER, di, REQUIRED);
   1381  1.1  mrg 
   1382  1.1  mrg   add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1383  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
   1384  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   1385  1.1  mrg 
   1386  1.1  mrg   add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1387  1.1  mrg 	     NULL, gfc_simplify_abs, gfc_resolve_abs,
   1388  1.1  mrg 	     a, BT_COMPLEX, dz, REQUIRED);
   1389  1.1  mrg 
   1390  1.1  mrg   add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
   1391  1.1  mrg 	     NULL, gfc_simplify_abs, gfc_resolve_abs,
   1392  1.1  mrg 	     a, BT_COMPLEX, dd, REQUIRED);
   1393  1.1  mrg 
   1394  1.1  mrg   make_alias ("cdabs", GFC_STD_GNU);
   1395  1.1  mrg 
   1396  1.1  mrg   make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
   1397  1.1  mrg 
   1398  1.1  mrg   /* The checking function for ACCESS is called gfc_check_access_func
   1399  1.1  mrg      because the name gfc_check_access is already used in module.cc.  */
   1400  1.1  mrg   add_sym_2 ("access", GFC_ISYM_ACCESS, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   1401  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_access_func, NULL, gfc_resolve_access,
   1402  1.1  mrg 	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
   1403  1.1  mrg 
   1404  1.1  mrg   make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
   1405  1.1  mrg 
   1406  1.1  mrg   add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
   1407  1.1  mrg 	     BT_CHARACTER, dc, GFC_STD_F95,
   1408  1.1  mrg 	     gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
   1409  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1410  1.1  mrg 
   1411  1.1  mrg   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
   1412  1.1  mrg 
   1413  1.1  mrg   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1414  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
   1415  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1416  1.1  mrg 
   1417  1.1  mrg   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1418  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
   1419  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1420  1.1  mrg 
   1421  1.1  mrg   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
   1422  1.1  mrg 
   1423  1.1  mrg   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
   1424  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
   1425  1.1  mrg 	     gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
   1426  1.1  mrg 
   1427  1.1  mrg   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
   1428  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
   1429  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1430  1.1  mrg 
   1431  1.1  mrg   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
   1432  1.1  mrg 
   1433  1.1  mrg   add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
   1434  1.1  mrg 	     BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
   1435  1.1  mrg 	     gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
   1436  1.1  mrg 
   1437  1.1  mrg   make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
   1438  1.1  mrg 
   1439  1.1  mrg   add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
   1440  1.1  mrg 	     BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
   1441  1.1  mrg 	     gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
   1442  1.1  mrg 
   1443  1.1  mrg   make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
   1444  1.1  mrg 
   1445  1.1  mrg   add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1446  1.1  mrg 	     gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
   1447  1.1  mrg 	     z, BT_COMPLEX, dz, REQUIRED);
   1448  1.1  mrg 
   1449  1.1  mrg   make_alias ("imag", GFC_STD_GNU);
   1450  1.1  mrg   make_alias ("imagpart", GFC_STD_GNU);
   1451  1.1  mrg 
   1452  1.1  mrg   add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
   1453  1.1  mrg 	     NULL, gfc_simplify_aimag, gfc_resolve_aimag,
   1454  1.1  mrg 	     z, BT_COMPLEX, dd, REQUIRED);
   1455  1.1  mrg 
   1456  1.1  mrg   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
   1457  1.1  mrg 
   1458  1.1  mrg   add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1459  1.1  mrg 	     gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
   1460  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1461  1.1  mrg 
   1462  1.1  mrg   add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1463  1.1  mrg 	     NULL, gfc_simplify_dint, gfc_resolve_dint,
   1464  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   1465  1.1  mrg 
   1466  1.1  mrg   make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
   1467  1.1  mrg 
   1468  1.1  mrg   add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
   1469  1.1  mrg 	     gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
   1470  1.1  mrg 	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
   1471  1.1  mrg 
   1472  1.1  mrg   make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
   1473  1.1  mrg 
   1474  1.1  mrg   add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
   1475  1.1  mrg 	     gfc_check_allocated, NULL, NULL,
   1476  1.1  mrg 	     ar, BT_UNKNOWN, 0, REQUIRED);
   1477  1.1  mrg 
   1478  1.1  mrg   make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
   1479  1.1  mrg 
   1480  1.1  mrg   add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1481  1.1  mrg 	     gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
   1482  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1483  1.1  mrg 
   1484  1.1  mrg   add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1485  1.1  mrg 	     NULL, gfc_simplify_dnint, gfc_resolve_dnint,
   1486  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   1487  1.1  mrg 
   1488  1.1  mrg   make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
   1489  1.1  mrg 
   1490  1.1  mrg   add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
   1491  1.1  mrg 	     gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
   1492  1.1  mrg 	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
   1493  1.1  mrg 
   1494  1.1  mrg   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
   1495  1.1  mrg 
   1496  1.1  mrg   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1497  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
   1498  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1499  1.1  mrg 
   1500  1.1  mrg   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1501  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
   1502  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1503  1.1  mrg 
   1504  1.1  mrg   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
   1505  1.1  mrg 
   1506  1.1  mrg   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
   1507  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
   1508  1.1  mrg 	     gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
   1509  1.1  mrg 
   1510  1.1  mrg   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
   1511  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
   1512  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1513  1.1  mrg 
   1514  1.1  mrg   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
   1515  1.1  mrg 
   1516  1.1  mrg   add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
   1517  1.1  mrg 	     GFC_STD_F95, gfc_check_associated, NULL, NULL,
   1518  1.1  mrg 	     pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
   1519  1.1  mrg 
   1520  1.1  mrg   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
   1521  1.1  mrg 
   1522  1.1  mrg   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1523  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
   1524  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1525  1.1  mrg 
   1526  1.1  mrg   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1527  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
   1528  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1529  1.1  mrg 
   1530  1.1  mrg   /* Two-argument version of atan, equivalent to atan2.  */
   1531  1.1  mrg   add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
   1532  1.1  mrg 	     gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
   1533  1.1  mrg 	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
   1534  1.1  mrg 
   1535  1.1  mrg   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
   1536  1.1  mrg 
   1537  1.1  mrg   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
   1538  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
   1539  1.1  mrg 	     gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
   1540  1.1  mrg 
   1541  1.1  mrg   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
   1542  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
   1543  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1544  1.1  mrg 
   1545  1.1  mrg   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
   1546  1.1  mrg 
   1547  1.1  mrg   add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1548  1.1  mrg 	     gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
   1549  1.1  mrg 	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
   1550  1.1  mrg 
   1551  1.1  mrg   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1552  1.1  mrg 	     gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
   1553  1.1  mrg 	     y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
   1554  1.1  mrg 
   1555  1.1  mrg   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
   1556  1.1  mrg 
   1557  1.1  mrg   /* Bessel and Neumann functions for G77 compatibility.  */
   1558  1.1  mrg   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1559  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
   1560  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1561  1.1  mrg 
   1562  1.1  mrg   make_alias ("bessel_j0", GFC_STD_F2008);
   1563  1.1  mrg 
   1564  1.1  mrg   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1565  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
   1566  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1567  1.1  mrg 
   1568  1.1  mrg   make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
   1569  1.1  mrg 
   1570  1.1  mrg   add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1571  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
   1572  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1573  1.1  mrg 
   1574  1.1  mrg   make_alias ("bessel_j1", GFC_STD_F2008);
   1575  1.1  mrg 
   1576  1.1  mrg   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1577  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
   1578  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1579  1.1  mrg 
   1580  1.1  mrg   make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
   1581  1.1  mrg 
   1582  1.1  mrg   add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1583  1.1  mrg 	     gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
   1584  1.1  mrg 	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
   1585  1.1  mrg 
   1586  1.1  mrg   make_alias ("bessel_jn", GFC_STD_F2008);
   1587  1.1  mrg 
   1588  1.1  mrg   add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1589  1.1  mrg 	     gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
   1590  1.1  mrg 	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
   1591  1.1  mrg 
   1592  1.1  mrg   add_sym_3 ("bessel_jn", GFC_ISYM_JN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
   1593  1.1  mrg 	     gfc_check_bessel_n2, gfc_simplify_bessel_jn2, gfc_resolve_bessel_n2,
   1594  1.1  mrg 	     "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
   1595  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1596  1.1  mrg   set_attr_value (3, true, true, true);
   1597  1.1  mrg 
   1598  1.1  mrg   make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
   1599  1.1  mrg 
   1600  1.1  mrg   add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1601  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
   1602  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1603  1.1  mrg 
   1604  1.1  mrg   make_alias ("bessel_y0", GFC_STD_F2008);
   1605  1.1  mrg 
   1606  1.1  mrg   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1607  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
   1608  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1609  1.1  mrg 
   1610  1.1  mrg   make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
   1611  1.1  mrg 
   1612  1.1  mrg   add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1613  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
   1614  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1615  1.1  mrg 
   1616  1.1  mrg   make_alias ("bessel_y1", GFC_STD_F2008);
   1617  1.1  mrg 
   1618  1.1  mrg   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1619  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
   1620  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1621  1.1  mrg 
   1622  1.1  mrg   make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
   1623  1.1  mrg 
   1624  1.1  mrg   add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   1625  1.1  mrg 	     gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
   1626  1.1  mrg 	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
   1627  1.1  mrg 
   1628  1.1  mrg   make_alias ("bessel_yn", GFC_STD_F2008);
   1629  1.1  mrg 
   1630  1.1  mrg   add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   1631  1.1  mrg 	     gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
   1632  1.1  mrg 	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
   1633  1.1  mrg 
   1634  1.1  mrg   add_sym_3 ("bessel_yn", GFC_ISYM_YN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
   1635  1.1  mrg 	     gfc_check_bessel_n2, gfc_simplify_bessel_yn2, gfc_resolve_bessel_n2,
   1636  1.1  mrg 	     "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
   1637  1.1  mrg 	      x, BT_REAL, dr, REQUIRED);
   1638  1.1  mrg   set_attr_value (3, true, true, true);
   1639  1.1  mrg 
   1640  1.1  mrg   make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
   1641  1.1  mrg 
   1642  1.1  mrg   add_sym_2 ("bge", GFC_ISYM_BGE, CLASS_ELEMENTAL, ACTUAL_NO,
   1643  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2008,
   1644  1.1  mrg 	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bge, NULL,
   1645  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   1646  1.1  mrg 
   1647  1.1  mrg   make_generic ("bge", GFC_ISYM_BGE, GFC_STD_F2008);
   1648  1.1  mrg 
   1649  1.1  mrg   add_sym_2 ("bgt", GFC_ISYM_BGT, CLASS_ELEMENTAL, ACTUAL_NO,
   1650  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2008,
   1651  1.1  mrg 	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bgt, NULL,
   1652  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   1653  1.1  mrg 
   1654  1.1  mrg   make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
   1655  1.1  mrg 
   1656  1.1  mrg   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   1657  1.1  mrg 	     gfc_check_i, gfc_simplify_bit_size, NULL,
   1658  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   1659  1.1  mrg 
   1660  1.1  mrg   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
   1661  1.1  mrg 
   1662  1.1  mrg   add_sym_2 ("ble", GFC_ISYM_BLE, CLASS_ELEMENTAL, ACTUAL_NO,
   1663  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2008,
   1664  1.1  mrg 	     gfc_check_bge_bgt_ble_blt, gfc_simplify_ble, NULL,
   1665  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   1666  1.1  mrg 
   1667  1.1  mrg   make_generic ("ble", GFC_ISYM_BLE, GFC_STD_F2008);
   1668  1.1  mrg 
   1669  1.1  mrg   add_sym_2 ("blt", GFC_ISYM_BLT, CLASS_ELEMENTAL, ACTUAL_NO,
   1670  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2008,
   1671  1.1  mrg 	     gfc_check_bge_bgt_ble_blt, gfc_simplify_blt, NULL,
   1672  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   1673  1.1  mrg 
   1674  1.1  mrg   make_generic ("blt", GFC_ISYM_BLT, GFC_STD_F2008);
   1675  1.1  mrg 
   1676  1.1  mrg   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
   1677  1.1  mrg 	     gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
   1678  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
   1679  1.1  mrg 
   1680  1.1  mrg   if (flag_dec_intrinsic_ints)
   1681  1.1  mrg     {
   1682  1.1  mrg       make_alias ("bbtest", GFC_STD_GNU);
   1683  1.1  mrg       make_alias ("bitest", GFC_STD_GNU);
   1684  1.1  mrg       make_alias ("bjtest", GFC_STD_GNU);
   1685  1.1  mrg       make_alias ("bktest", GFC_STD_GNU);
   1686  1.1  mrg     }
   1687  1.1  mrg 
   1688  1.1  mrg   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
   1689  1.1  mrg 
   1690  1.1  mrg   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   1691  1.1  mrg 	     gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
   1692  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1693  1.1  mrg 
   1694  1.1  mrg   make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
   1695  1.1  mrg 
   1696  1.1  mrg   add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
   1697  1.1  mrg 	     gfc_check_char, gfc_simplify_char, gfc_resolve_char,
   1698  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1699  1.1  mrg 
   1700  1.1  mrg   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
   1701  1.1  mrg 
   1702  1.1  mrg   add_sym_1 ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   1703  1.1  mrg 	     GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
   1704  1.1  mrg 	     nm, BT_CHARACTER, dc, REQUIRED);
   1705  1.1  mrg 
   1706  1.1  mrg   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
   1707  1.1  mrg 
   1708  1.1  mrg   add_sym_2 ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   1709  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_chmod, NULL, gfc_resolve_chmod,
   1710  1.1  mrg 	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
   1711  1.1  mrg 
   1712  1.1  mrg   make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
   1713  1.1  mrg 
   1714  1.1  mrg   add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
   1715  1.1  mrg 	     gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
   1716  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
   1717  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   1718  1.1  mrg 
   1719  1.1  mrg   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
   1720  1.1  mrg 
   1721  1.1  mrg   add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
   1722  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
   1723  1.1  mrg 
   1724  1.1  mrg   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
   1725  1.1  mrg 		GFC_STD_F2003);
   1726  1.1  mrg 
   1727  1.1  mrg   add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
   1728  1.1  mrg 	     gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
   1729  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
   1730  1.1  mrg 
   1731  1.1  mrg   make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
   1732  1.1  mrg 
   1733  1.1  mrg   /* Making dcmplx a specific of cmplx causes cmplx to return a double
   1734  1.1  mrg      complex instead of the default complex.  */
   1735  1.1  mrg 
   1736  1.1  mrg   add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
   1737  1.1  mrg 	     gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
   1738  1.1  mrg 	     x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
   1739  1.1  mrg 
   1740  1.1  mrg   make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
   1741  1.1  mrg 
   1742  1.1  mrg   add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   1743  1.1  mrg 	     gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
   1744  1.1  mrg 	     z, BT_COMPLEX, dz, REQUIRED);
   1745  1.1  mrg 
   1746  1.1  mrg   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
   1747  1.1  mrg 	     NULL, gfc_simplify_conjg, gfc_resolve_conjg,
   1748  1.1  mrg 	     z, BT_COMPLEX, dd, REQUIRED);
   1749  1.1  mrg 
   1750  1.1  mrg   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
   1751  1.1  mrg 
   1752  1.1  mrg   add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1753  1.1  mrg 	     gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
   1754  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1755  1.1  mrg 
   1756  1.1  mrg   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1757  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
   1758  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1759  1.1  mrg 
   1760  1.1  mrg   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   1761  1.1  mrg 	     NULL, gfc_simplify_cos, gfc_resolve_cos,
   1762  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   1763  1.1  mrg 
   1764  1.1  mrg   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
   1765  1.1  mrg 	     NULL, gfc_simplify_cos, gfc_resolve_cos,
   1766  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   1767  1.1  mrg 
   1768  1.1  mrg   make_alias ("cdcos", GFC_STD_GNU);
   1769  1.1  mrg 
   1770  1.1  mrg   make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
   1771  1.1  mrg 
   1772  1.1  mrg   add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1773  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
   1774  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1775  1.1  mrg 
   1776  1.1  mrg   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1777  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
   1778  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1779  1.1  mrg 
   1780  1.1  mrg   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
   1781  1.1  mrg 
   1782  1.1  mrg   add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
   1783  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   1784  1.1  mrg 	     gfc_check_count, gfc_simplify_count, gfc_resolve_count,
   1785  1.1  mrg 	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   1786  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   1787  1.1  mrg 
   1788  1.1  mrg   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
   1789  1.1  mrg 
   1790  1.1  mrg   add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
   1791  1.1  mrg 	     BT_REAL, dr, GFC_STD_F95,
   1792  1.1  mrg 	     gfc_check_cshift, gfc_simplify_cshift, gfc_resolve_cshift,
   1793  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED,
   1794  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED,
   1795  1.1  mrg 	     dm, BT_INTEGER, ii, OPTIONAL);
   1796  1.1  mrg 
   1797  1.1  mrg   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
   1798  1.1  mrg 
   1799  1.1  mrg   add_sym_1 ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
   1800  1.1  mrg 	     0, GFC_STD_GNU, gfc_check_ctime, NULL, gfc_resolve_ctime,
   1801  1.1  mrg 	     tm, BT_INTEGER, di, REQUIRED);
   1802  1.1  mrg 
   1803  1.1  mrg   make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
   1804  1.1  mrg 
   1805  1.1  mrg   add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
   1806  1.1  mrg 	     gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
   1807  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   1808  1.1  mrg 
   1809  1.1  mrg   make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
   1810  1.1  mrg 
   1811  1.1  mrg   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   1812  1.1  mrg 	     gfc_check_digits, gfc_simplify_digits, NULL,
   1813  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED);
   1814  1.1  mrg 
   1815  1.1  mrg   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
   1816  1.1  mrg 
   1817  1.1  mrg   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   1818  1.1  mrg 	     gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
   1819  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
   1820  1.1  mrg 
   1821  1.1  mrg   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   1822  1.1  mrg 	     NULL, gfc_simplify_dim, gfc_resolve_dim,
   1823  1.1  mrg 	     x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
   1824  1.1  mrg 
   1825  1.1  mrg   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1826  1.1  mrg 	     gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
   1827  1.1  mrg 	     x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
   1828  1.1  mrg 
   1829  1.1  mrg   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
   1830  1.1  mrg 
   1831  1.1  mrg   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
   1832  1.1  mrg 	     GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
   1833  1.1  mrg 	     va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
   1834  1.1  mrg 
   1835  1.1  mrg   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
   1836  1.1  mrg 
   1837  1.1  mrg   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1838  1.1  mrg 	     gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
   1839  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
   1840  1.1  mrg 
   1841  1.1  mrg   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
   1842  1.1  mrg 
   1843  1.1  mrg   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO,
   1844  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU, NULL, gfc_simplify_dreal, NULL,
   1845  1.1  mrg 	     a, BT_COMPLEX, dd, REQUIRED);
   1846  1.1  mrg 
   1847  1.1  mrg   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
   1848  1.1  mrg 
   1849  1.1  mrg   add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
   1850  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   1851  1.1  mrg 	     gfc_check_dshift, gfc_simplify_dshiftl, gfc_resolve_dshift,
   1852  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   1853  1.1  mrg 	     j, BT_INTEGER, di, REQUIRED,
   1854  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED);
   1855  1.1  mrg 
   1856  1.1  mrg   make_generic ("dshiftl", GFC_ISYM_DSHIFTL, GFC_STD_F2008);
   1857  1.1  mrg 
   1858  1.1  mrg   add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
   1859  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   1860  1.1  mrg 	     gfc_check_dshift, gfc_simplify_dshiftr, gfc_resolve_dshift,
   1861  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   1862  1.1  mrg 	     j, BT_INTEGER, di, REQUIRED,
   1863  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED);
   1864  1.1  mrg 
   1865  1.1  mrg   make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
   1866  1.1  mrg 
   1867  1.1  mrg   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   1868  1.1  mrg 	     gfc_check_eoshift, gfc_simplify_eoshift, gfc_resolve_eoshift,
   1869  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
   1870  1.1  mrg 	     bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
   1871  1.1  mrg 
   1872  1.1  mrg   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
   1873  1.1  mrg 
   1874  1.1  mrg   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr,
   1875  1.1  mrg 	     GFC_STD_F95, gfc_check_fn_r, gfc_simplify_epsilon, NULL,
   1876  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1877  1.1  mrg 
   1878  1.1  mrg   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
   1879  1.1  mrg 
   1880  1.1  mrg   /* G77 compatibility for the ERF() and ERFC() functions.  */
   1881  1.1  mrg   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   1882  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
   1883  1.1  mrg 	     gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
   1884  1.1  mrg 
   1885  1.1  mrg   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
   1886  1.1  mrg 	     GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
   1887  1.1  mrg 	     gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
   1888  1.1  mrg 
   1889  1.1  mrg   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
   1890  1.1  mrg 
   1891  1.1  mrg   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   1892  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
   1893  1.1  mrg 	     gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
   1894  1.1  mrg 
   1895  1.1  mrg   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
   1896  1.1  mrg 	     GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
   1897  1.1  mrg 	     gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
   1898  1.1  mrg 
   1899  1.1  mrg   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
   1900  1.1  mrg 
   1901  1.1  mrg   add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
   1902  1.1  mrg 	     BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
   1903  1.1  mrg 	     gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
   1904  1.1  mrg 	     dr, REQUIRED);
   1905  1.1  mrg 
   1906  1.1  mrg   make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
   1907  1.1  mrg 
   1908  1.1  mrg   /* G77 compatibility */
   1909  1.1  mrg   add_sym_1 ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
   1910  1.1  mrg 	     4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
   1911  1.1  mrg 	     x, BT_REAL, 4, REQUIRED);
   1912  1.1  mrg 
   1913  1.1  mrg   make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
   1914  1.1  mrg 
   1915  1.1  mrg   add_sym_1 ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
   1916  1.1  mrg 	     4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
   1917  1.1  mrg 	     x, BT_REAL, 4, REQUIRED);
   1918  1.1  mrg 
   1919  1.1  mrg   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
   1920  1.1  mrg 
   1921  1.1  mrg   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
   1922  1.1  mrg 	     gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
   1923  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1924  1.1  mrg 
   1925  1.1  mrg   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   1926  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
   1927  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   1928  1.1  mrg 
   1929  1.1  mrg   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   1930  1.1  mrg 	     NULL, gfc_simplify_exp, gfc_resolve_exp,
   1931  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   1932  1.1  mrg 
   1933  1.1  mrg   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
   1934  1.1  mrg 	     NULL, gfc_simplify_exp, gfc_resolve_exp,
   1935  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   1936  1.1  mrg 
   1937  1.1  mrg   make_alias ("cdexp", GFC_STD_GNU);
   1938  1.1  mrg 
   1939  1.1  mrg   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
   1940  1.1  mrg 
   1941  1.1  mrg   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
   1942  1.1  mrg 	     GFC_STD_F95, gfc_check_fn_r, gfc_simplify_exponent, gfc_resolve_exponent,
   1943  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1944  1.1  mrg 
   1945  1.1  mrg   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
   1946  1.1  mrg 
   1947  1.1  mrg   add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
   1948  1.1  mrg 	     ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
   1949  1.1  mrg 	     gfc_check_same_type_as, gfc_simplify_extends_type_of,
   1950  1.1  mrg 	     gfc_resolve_extends_type_of,
   1951  1.1  mrg 	     a, BT_UNKNOWN, 0, REQUIRED,
   1952  1.1  mrg 	     mo, BT_UNKNOWN, 0, REQUIRED);
   1953  1.1  mrg 
   1954  1.1  mrg   add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL,
   1955  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
   1956  1.1  mrg 	     gfc_check_failed_or_stopped_images,
   1957  1.1  mrg 	     gfc_simplify_failed_or_stopped_images,
   1958  1.1  mrg 	     gfc_resolve_failed_images, team, BT_VOID, di, OPTIONAL,
   1959  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   1960  1.1  mrg 
   1961  1.1  mrg   add_sym_0 ("fdate",  GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
   1962  1.1  mrg 	     dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
   1963  1.1  mrg 
   1964  1.1  mrg   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
   1965  1.1  mrg 
   1966  1.1  mrg   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   1967  1.1  mrg 	     gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
   1968  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   1969  1.1  mrg 
   1970  1.1  mrg   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
   1971  1.1  mrg 
   1972  1.1  mrg   /* G77 compatible fnum */
   1973  1.1  mrg   add_sym_1 ("fnum", GFC_ISYM_FNUM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   1974  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_fnum, NULL, gfc_resolve_fnum,
   1975  1.1  mrg 	     ut, BT_INTEGER, di, REQUIRED);
   1976  1.1  mrg 
   1977  1.1  mrg   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
   1978  1.1  mrg 
   1979  1.1  mrg   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   1980  1.1  mrg 	     GFC_STD_F95, gfc_check_fn_r, gfc_simplify_fraction, gfc_resolve_fraction,
   1981  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   1982  1.1  mrg 
   1983  1.1  mrg   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
   1984  1.1  mrg 
   1985  1.1  mrg   add_sym_2_intent ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, ACTUAL_NO,
   1986  1.1  mrg 		    BT_INTEGER, di, GFC_STD_GNU,
   1987  1.1  mrg 		    gfc_check_fstat, NULL, gfc_resolve_fstat,
   1988  1.1  mrg 		    ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   1989  1.1  mrg 		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
   1990  1.1  mrg 
   1991  1.1  mrg   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
   1992  1.1  mrg 
   1993  1.1  mrg   add_sym_1 ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   1994  1.1  mrg 	     ii, GFC_STD_GNU, gfc_check_ftell, NULL, gfc_resolve_ftell,
   1995  1.1  mrg 	     ut, BT_INTEGER, di, REQUIRED);
   1996  1.1  mrg 
   1997  1.1  mrg   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
   1998  1.1  mrg 
   1999  1.1  mrg   add_sym_2_intent ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, ACTUAL_NO,
   2000  1.1  mrg 		    BT_INTEGER, di, GFC_STD_GNU,
   2001  1.1  mrg 		    gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
   2002  1.1  mrg 		    ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   2003  1.1  mrg 		    c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   2004  1.1  mrg 
   2005  1.1  mrg   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
   2006  1.1  mrg 
   2007  1.1  mrg   add_sym_1_intent ("fget", GFC_ISYM_FGET, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2008  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fget,
   2009  1.1  mrg 	     c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   2010  1.1  mrg 
   2011  1.1  mrg   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
   2012  1.1  mrg 
   2013  1.1  mrg   add_sym_2 ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2014  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_fgetputc, NULL, gfc_resolve_fputc,
   2015  1.1  mrg 	     ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
   2016  1.1  mrg 
   2017  1.1  mrg   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
   2018  1.1  mrg 
   2019  1.1  mrg   add_sym_1 ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2020  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fput,
   2021  1.1  mrg 	     c, BT_CHARACTER, dc, REQUIRED);
   2022  1.1  mrg 
   2023  1.1  mrg   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
   2024  1.1  mrg 
   2025  1.1  mrg   add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   2026  1.1  mrg 	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
   2027  1.1  mrg 	     gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
   2028  1.1  mrg 
   2029  1.1  mrg   add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   2030  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
   2031  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2032  1.1  mrg 
   2033  1.1  mrg   make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
   2034  1.1  mrg 
   2035  1.1  mrg   /* Unix IDs (g77 compatibility)  */
   2036  1.1  mrg   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2037  1.1  mrg 	     di,  GFC_STD_GNU, NULL, NULL, gfc_resolve_getcwd,
   2038  1.1  mrg 	     c, BT_CHARACTER, dc, REQUIRED);
   2039  1.1  mrg 
   2040  1.1  mrg   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
   2041  1.1  mrg 
   2042  1.1  mrg   add_sym_0 ("getgid", GFC_ISYM_GETGID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2043  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getgid);
   2044  1.1  mrg 
   2045  1.1  mrg   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
   2046  1.1  mrg 
   2047  1.1  mrg   add_sym_0 ("getpid", GFC_ISYM_GETPID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2048  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getpid);
   2049  1.1  mrg 
   2050  1.1  mrg   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
   2051  1.1  mrg 
   2052  1.1  mrg   add_sym_1 ("get_team", GFC_ISYM_GET_TEAM, CLASS_TRANSFORMATIONAL,
   2053  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
   2054  1.1  mrg 	     gfc_check_get_team, NULL, gfc_resolve_get_team,
   2055  1.1  mrg 	     level, BT_INTEGER, di, OPTIONAL);
   2056  1.1  mrg 
   2057  1.1  mrg   add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2058  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
   2059  1.1  mrg 
   2060  1.1  mrg   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
   2061  1.1  mrg 
   2062  1.1  mrg   add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, ACTUAL_NO,
   2063  1.1  mrg 		    BT_INTEGER, di, GFC_STD_GNU,
   2064  1.1  mrg 		    gfc_check_hostnm, NULL, gfc_resolve_hostnm,
   2065  1.1  mrg 		    c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   2066  1.1  mrg 
   2067  1.1  mrg   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
   2068  1.1  mrg 
   2069  1.1  mrg   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2070  1.1  mrg 	     gfc_check_huge, gfc_simplify_huge, NULL,
   2071  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED);
   2072  1.1  mrg 
   2073  1.1  mrg   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
   2074  1.1  mrg 
   2075  1.1  mrg   add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
   2076  1.1  mrg 	     BT_REAL, dr, GFC_STD_F2008,
   2077  1.1  mrg 	     gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
   2078  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
   2079  1.1  mrg 
   2080  1.1  mrg   make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
   2081  1.1  mrg 
   2082  1.1  mrg   add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
   2083  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   2084  1.1  mrg 	     gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
   2085  1.1  mrg 	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2086  1.1  mrg 
   2087  1.1  mrg   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
   2088  1.1  mrg 
   2089  1.1  mrg   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
   2090  1.1  mrg 	     GFC_STD_F95,
   2091  1.1  mrg 	     gfc_check_iand_ieor_ior, gfc_simplify_iand, gfc_resolve_iand,
   2092  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   2093  1.1  mrg 
   2094  1.1  mrg   if (flag_dec_intrinsic_ints)
   2095  1.1  mrg     {
   2096  1.1  mrg       make_alias ("biand", GFC_STD_GNU);
   2097  1.1  mrg       make_alias ("iiand", GFC_STD_GNU);
   2098  1.1  mrg       make_alias ("jiand", GFC_STD_GNU);
   2099  1.1  mrg       make_alias ("kiand", GFC_STD_GNU);
   2100  1.1  mrg     }
   2101  1.1  mrg 
   2102  1.1  mrg   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
   2103  1.1  mrg 
   2104  1.1  mrg   add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
   2105  1.1  mrg 	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_and, gfc_resolve_and,
   2106  1.1  mrg 	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
   2107  1.1  mrg 
   2108  1.1  mrg   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
   2109  1.1  mrg 
   2110  1.1  mrg   add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
   2111  1.1  mrg 		gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
   2112  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2113  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2114  1.1  mrg 
   2115  1.1  mrg   make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
   2116  1.1  mrg 
   2117  1.1  mrg   add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
   2118  1.1  mrg 		gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
   2119  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2120  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2121  1.1  mrg 
   2122  1.1  mrg   make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
   2123  1.1  mrg 
   2124  1.1  mrg   add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2125  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, NULL);
   2126  1.1  mrg 
   2127  1.1  mrg   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
   2128  1.1  mrg 
   2129  1.1  mrg   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2130  1.1  mrg 	     gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
   2131  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
   2132  1.1  mrg 
   2133  1.1  mrg   if (flag_dec_intrinsic_ints)
   2134  1.1  mrg     {
   2135  1.1  mrg       make_alias ("bbclr", GFC_STD_GNU);
   2136  1.1  mrg       make_alias ("iibclr", GFC_STD_GNU);
   2137  1.1  mrg       make_alias ("jibclr", GFC_STD_GNU);
   2138  1.1  mrg       make_alias ("kibclr", GFC_STD_GNU);
   2139  1.1  mrg     }
   2140  1.1  mrg 
   2141  1.1  mrg   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
   2142  1.1  mrg 
   2143  1.1  mrg   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2144  1.1  mrg 	     gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
   2145  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
   2146  1.1  mrg 	     ln, BT_INTEGER, di, REQUIRED);
   2147  1.1  mrg 
   2148  1.1  mrg   if (flag_dec_intrinsic_ints)
   2149  1.1  mrg     {
   2150  1.1  mrg       make_alias ("bbits", GFC_STD_GNU);
   2151  1.1  mrg       make_alias ("iibits", GFC_STD_GNU);
   2152  1.1  mrg       make_alias ("jibits", GFC_STD_GNU);
   2153  1.1  mrg       make_alias ("kibits", GFC_STD_GNU);
   2154  1.1  mrg     }
   2155  1.1  mrg 
   2156  1.1  mrg   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
   2157  1.1  mrg 
   2158  1.1  mrg   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2159  1.1  mrg 	     gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
   2160  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
   2161  1.1  mrg 
   2162  1.1  mrg   if (flag_dec_intrinsic_ints)
   2163  1.1  mrg     {
   2164  1.1  mrg       make_alias ("bbset", GFC_STD_GNU);
   2165  1.1  mrg       make_alias ("iibset", GFC_STD_GNU);
   2166  1.1  mrg       make_alias ("jibset", GFC_STD_GNU);
   2167  1.1  mrg       make_alias ("kibset", GFC_STD_GNU);
   2168  1.1  mrg     }
   2169  1.1  mrg 
   2170  1.1  mrg   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
   2171  1.1  mrg 
   2172  1.1  mrg   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
   2173  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F77,
   2174  1.1  mrg 	     gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
   2175  1.1  mrg 	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2176  1.1  mrg 
   2177  1.1  mrg   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
   2178  1.1  mrg 
   2179  1.1  mrg   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
   2180  1.1  mrg 	     GFC_STD_F95,
   2181  1.1  mrg 	     gfc_check_iand_ieor_ior, gfc_simplify_ieor, gfc_resolve_ieor,
   2182  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   2183  1.1  mrg 
   2184  1.1  mrg   if (flag_dec_intrinsic_ints)
   2185  1.1  mrg     {
   2186  1.1  mrg       make_alias ("bieor", GFC_STD_GNU);
   2187  1.1  mrg       make_alias ("iieor", GFC_STD_GNU);
   2188  1.1  mrg       make_alias ("jieor", GFC_STD_GNU);
   2189  1.1  mrg       make_alias ("kieor", GFC_STD_GNU);
   2190  1.1  mrg     }
   2191  1.1  mrg 
   2192  1.1  mrg   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
   2193  1.1  mrg 
   2194  1.1  mrg   add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
   2195  1.1  mrg 	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
   2196  1.1  mrg 	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
   2197  1.1  mrg 
   2198  1.1  mrg   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
   2199  1.1  mrg 
   2200  1.1  mrg   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2201  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
   2202  1.1  mrg 
   2203  1.1  mrg   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
   2204  1.1  mrg 
   2205  1.1  mrg   add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
   2206  1.1  mrg 	     gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
   2207  1.1  mrg 	     ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
   2208  1.1  mrg 
   2209  1.1  mrg   add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
   2210  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2018, gfc_check_image_status,
   2211  1.1  mrg 	     gfc_simplify_image_status, gfc_resolve_image_status, image,
   2212  1.1  mrg 	     BT_INTEGER, di, REQUIRED, team, BT_VOID, di, OPTIONAL);
   2213  1.1  mrg 
   2214  1.1  mrg   /* The resolution function for INDEX is called gfc_resolve_index_func
   2215  1.1  mrg      because the name gfc_resolve_index is already used in resolve.cc.  */
   2216  1.1  mrg   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
   2217  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F77,
   2218  1.1  mrg 	     gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
   2219  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
   2220  1.1  mrg 	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
   2221  1.1  mrg 
   2222  1.1  mrg   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
   2223  1.1  mrg 
   2224  1.1  mrg   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2225  1.1  mrg 	     gfc_check_int, gfc_simplify_int, gfc_resolve_int,
   2226  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2227  1.1  mrg 
   2228  1.1  mrg   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2229  1.1  mrg 	     NULL, gfc_simplify_ifix, NULL,
   2230  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2231  1.1  mrg 
   2232  1.1  mrg   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2233  1.1  mrg 	     NULL, gfc_simplify_idint, NULL,
   2234  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   2235  1.1  mrg 
   2236  1.1  mrg   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
   2237  1.1  mrg 
   2238  1.1  mrg   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
   2239  1.1  mrg 	     gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
   2240  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2241  1.1  mrg 
   2242  1.1  mrg   make_alias ("short", GFC_STD_GNU);
   2243  1.1  mrg 
   2244  1.1  mrg   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
   2245  1.1  mrg 
   2246  1.1  mrg   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
   2247  1.1  mrg 	     gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
   2248  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2249  1.1  mrg 
   2250  1.1  mrg   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
   2251  1.1  mrg 
   2252  1.1  mrg   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
   2253  1.1  mrg 	     gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
   2254  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2255  1.1  mrg 
   2256  1.1  mrg   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
   2257  1.1  mrg 
   2258  1.1  mrg   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
   2259  1.1  mrg 	     GFC_STD_F95,
   2260  1.1  mrg 	     gfc_check_iand_ieor_ior, gfc_simplify_ior, gfc_resolve_ior,
   2261  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
   2262  1.1  mrg 
   2263  1.1  mrg   if (flag_dec_intrinsic_ints)
   2264  1.1  mrg     {
   2265  1.1  mrg       make_alias ("bior", GFC_STD_GNU);
   2266  1.1  mrg       make_alias ("iior", GFC_STD_GNU);
   2267  1.1  mrg       make_alias ("jior", GFC_STD_GNU);
   2268  1.1  mrg       make_alias ("kior", GFC_STD_GNU);
   2269  1.1  mrg     }
   2270  1.1  mrg 
   2271  1.1  mrg   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
   2272  1.1  mrg 
   2273  1.1  mrg   add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
   2274  1.1  mrg 	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
   2275  1.1  mrg 	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
   2276  1.1  mrg 
   2277  1.1  mrg   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
   2278  1.1  mrg 
   2279  1.1  mrg   add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
   2280  1.1  mrg 		gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
   2281  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2282  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2283  1.1  mrg 
   2284  1.1  mrg   make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
   2285  1.1  mrg 
   2286  1.1  mrg   /* The following function is for G77 compatibility.  */
   2287  1.1  mrg   add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2288  1.1  mrg 	     4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
   2289  1.1  mrg 	     i, BT_INTEGER, 4, OPTIONAL);
   2290  1.1  mrg 
   2291  1.1  mrg   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
   2292  1.1  mrg 
   2293  1.1  mrg   add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
   2294  1.1  mrg 	     dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
   2295  1.1  mrg 	     ut, BT_INTEGER, di, REQUIRED);
   2296  1.1  mrg 
   2297  1.1  mrg   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
   2298  1.1  mrg 
   2299  1.1  mrg   add_sym_1 ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, CLASS_INQUIRY, ACTUAL_NO,
   2300  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2008,
   2301  1.1  mrg 	     gfc_check_is_contiguous, gfc_simplify_is_contiguous,
   2302  1.1  mrg 	     gfc_resolve_is_contiguous,
   2303  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED);
   2304  1.1  mrg 
   2305  1.1  mrg   make_generic ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, GFC_STD_F2008);
   2306  1.1  mrg 
   2307  1.1  mrg   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
   2308  1.1  mrg 	     CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
   2309  1.1  mrg 	     gfc_check_i, gfc_simplify_is_iostat_end, NULL,
   2310  1.1  mrg 	     i, BT_INTEGER, 0, REQUIRED);
   2311  1.1  mrg 
   2312  1.1  mrg   make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
   2313  1.1  mrg 
   2314  1.1  mrg   add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
   2315  1.1  mrg 	     CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
   2316  1.1  mrg 	     gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
   2317  1.1  mrg 	     i, BT_INTEGER, 0, REQUIRED);
   2318  1.1  mrg 
   2319  1.1  mrg   make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
   2320  1.1  mrg 
   2321  1.1  mrg   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
   2322  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_GNU,
   2323  1.1  mrg 	     gfc_check_isnan, gfc_simplify_isnan, NULL,
   2324  1.1  mrg 	     x, BT_REAL, 0, REQUIRED);
   2325  1.1  mrg 
   2326  1.1  mrg   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
   2327  1.1  mrg 
   2328  1.1  mrg   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
   2329  1.1  mrg 	     BT_INTEGER, di, GFC_STD_GNU,
   2330  1.1  mrg 	     gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
   2331  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
   2332  1.1  mrg 
   2333  1.1  mrg   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
   2334  1.1  mrg 
   2335  1.1  mrg   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
   2336  1.1  mrg 	     BT_INTEGER, di, GFC_STD_GNU,
   2337  1.1  mrg 	     gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
   2338  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
   2339  1.1  mrg 
   2340  1.1  mrg   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
   2341  1.1  mrg 
   2342  1.1  mrg   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2343  1.1  mrg 	     gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
   2344  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
   2345  1.1  mrg 
   2346  1.1  mrg   if (flag_dec_intrinsic_ints)
   2347  1.1  mrg     {
   2348  1.1  mrg       make_alias ("bshft", GFC_STD_GNU);
   2349  1.1  mrg       make_alias ("iishft", GFC_STD_GNU);
   2350  1.1  mrg       make_alias ("jishft", GFC_STD_GNU);
   2351  1.1  mrg       make_alias ("kishft", GFC_STD_GNU);
   2352  1.1  mrg     }
   2353  1.1  mrg 
   2354  1.1  mrg   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
   2355  1.1  mrg 
   2356  1.1  mrg   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2357  1.1  mrg 	     gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
   2358  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
   2359  1.1  mrg 	     sz, BT_INTEGER, di, OPTIONAL);
   2360  1.1  mrg 
   2361  1.1  mrg   if (flag_dec_intrinsic_ints)
   2362  1.1  mrg     {
   2363  1.1  mrg       make_alias ("bshftc", GFC_STD_GNU);
   2364  1.1  mrg       make_alias ("iishftc", GFC_STD_GNU);
   2365  1.1  mrg       make_alias ("jishftc", GFC_STD_GNU);
   2366  1.1  mrg       make_alias ("kishftc", GFC_STD_GNU);
   2367  1.1  mrg     }
   2368  1.1  mrg 
   2369  1.1  mrg   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
   2370  1.1  mrg 
   2371  1.1  mrg   add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2372  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_kill, NULL, NULL,
   2373  1.1  mrg 	     pid, BT_INTEGER, di, REQUIRED, sig, BT_INTEGER, di, REQUIRED);
   2374  1.1  mrg 
   2375  1.1  mrg   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
   2376  1.1  mrg 
   2377  1.1  mrg   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2378  1.1  mrg 	     gfc_check_kind, gfc_simplify_kind, NULL,
   2379  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2380  1.1  mrg 
   2381  1.1  mrg   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
   2382  1.1  mrg 
   2383  1.1  mrg   add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
   2384  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   2385  1.1  mrg 	     gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
   2386  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
   2387  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   2388  1.1  mrg 
   2389  1.1  mrg   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
   2390  1.1  mrg 
   2391  1.1  mrg   add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
   2392  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2393  1.1  mrg 	     gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
   2394  1.1  mrg 	     ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2395  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   2396  1.1  mrg 
   2397  1.1  mrg   make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
   2398  1.1  mrg 
   2399  1.1  mrg   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
   2400  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2401  1.1  mrg 	     gfc_check_i, gfc_simplify_leadz, NULL,
   2402  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   2403  1.1  mrg 
   2404  1.1  mrg   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
   2405  1.1  mrg 
   2406  1.1  mrg   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
   2407  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F77,
   2408  1.1  mrg 	     gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
   2409  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2410  1.1  mrg 
   2411  1.1  mrg   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
   2412  1.1  mrg 
   2413  1.1  mrg   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
   2414  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   2415  1.1  mrg 	     gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
   2416  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2417  1.1  mrg 
   2418  1.1  mrg   make_alias ("lnblnk", GFC_STD_GNU);
   2419  1.1  mrg 
   2420  1.1  mrg   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
   2421  1.1  mrg 
   2422  1.1  mrg   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
   2423  1.1  mrg 	     dr, GFC_STD_GNU,
   2424  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
   2425  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2426  1.1  mrg 
   2427  1.1  mrg   make_alias ("log_gamma", GFC_STD_F2008);
   2428  1.1  mrg 
   2429  1.1  mrg   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   2430  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
   2431  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2432  1.1  mrg 
   2433  1.1  mrg   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   2434  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
   2435  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2436  1.1  mrg 
   2437  1.1  mrg   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
   2438  1.1  mrg 
   2439  1.1  mrg 
   2440  1.1  mrg   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
   2441  1.1  mrg 	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
   2442  1.1  mrg 	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
   2443  1.1  mrg 
   2444  1.1  mrg   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
   2445  1.1  mrg 
   2446  1.1  mrg   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
   2447  1.1  mrg 	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
   2448  1.1  mrg 	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
   2449  1.1  mrg 
   2450  1.1  mrg   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
   2451  1.1  mrg 
   2452  1.1  mrg   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
   2453  1.1  mrg 	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
   2454  1.1  mrg 	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
   2455  1.1  mrg 
   2456  1.1  mrg   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
   2457  1.1  mrg 
   2458  1.1  mrg   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
   2459  1.1  mrg 	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
   2460  1.1  mrg 	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
   2461  1.1  mrg 
   2462  1.1  mrg   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
   2463  1.1  mrg 
   2464  1.1  mrg   add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   2465  1.1  mrg 	     GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
   2466  1.1  mrg 	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
   2467  1.1  mrg 
   2468  1.1  mrg   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
   2469  1.1  mrg 
   2470  1.1  mrg   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2471  1.1  mrg 	     gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
   2472  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2473  1.1  mrg 
   2474  1.1  mrg   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   2475  1.1  mrg 	     NULL, gfc_simplify_log, gfc_resolve_log,
   2476  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2477  1.1  mrg 
   2478  1.1  mrg   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   2479  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
   2480  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   2481  1.1  mrg 
   2482  1.1  mrg   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   2483  1.1  mrg 	     NULL, gfc_simplify_log, gfc_resolve_log,
   2484  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   2485  1.1  mrg 
   2486  1.1  mrg   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
   2487  1.1  mrg 	     NULL, gfc_simplify_log, gfc_resolve_log,
   2488  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   2489  1.1  mrg 
   2490  1.1  mrg   make_alias ("cdlog", GFC_STD_GNU);
   2491  1.1  mrg 
   2492  1.1  mrg   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
   2493  1.1  mrg 
   2494  1.1  mrg   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2495  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
   2496  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2497  1.1  mrg 
   2498  1.1  mrg   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   2499  1.1  mrg 	     NULL, gfc_simplify_log10, gfc_resolve_log10,
   2500  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2501  1.1  mrg 
   2502  1.1  mrg   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   2503  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
   2504  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   2505  1.1  mrg 
   2506  1.1  mrg   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
   2507  1.1  mrg 
   2508  1.1  mrg   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
   2509  1.1  mrg 	     gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
   2510  1.1  mrg 	     l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2511  1.1  mrg 
   2512  1.1  mrg   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
   2513  1.1  mrg 
   2514  1.1  mrg   add_sym_2_intent ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO,
   2515  1.1  mrg 		    BT_INTEGER, di, GFC_STD_GNU,
   2516  1.1  mrg 		    gfc_check_stat, NULL, gfc_resolve_lstat,
   2517  1.1  mrg 		    nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   2518  1.1  mrg 		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
   2519  1.1  mrg 
   2520  1.1  mrg   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
   2521  1.1  mrg 
   2522  1.1  mrg   add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
   2523  1.1  mrg 	     GFC_STD_GNU, gfc_check_malloc, NULL, NULL,
   2524  1.1  mrg 	     sz, BT_INTEGER, di, REQUIRED);
   2525  1.1  mrg 
   2526  1.1  mrg   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
   2527  1.1  mrg 
   2528  1.1  mrg   add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
   2529  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2530  1.1  mrg 	     gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
   2531  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2532  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   2533  1.1  mrg 
   2534  1.1  mrg   make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
   2535  1.1  mrg 
   2536  1.1  mrg   add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
   2537  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2538  1.1  mrg 	     gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
   2539  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2540  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   2541  1.1  mrg 
   2542  1.1  mrg   make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
   2543  1.1  mrg 
   2544  1.1  mrg   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2545  1.1  mrg 	     gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
   2546  1.1  mrg 	     ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
   2547  1.1  mrg 
   2548  1.1  mrg   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
   2549  1.1  mrg 
   2550  1.1  mrg   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
   2551  1.1  mrg      int(max).  The max function must take at least two arguments.  */
   2552  1.1  mrg 
   2553  1.1  mrg   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
   2554  1.1  mrg 	     gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
   2555  1.1  mrg 	     a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
   2556  1.1  mrg 
   2557  1.1  mrg   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2558  1.1  mrg 	     gfc_check_min_max_integer, gfc_simplify_max, NULL,
   2559  1.1  mrg 	     a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
   2560  1.1  mrg 
   2561  1.1  mrg   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2562  1.1  mrg 	     gfc_check_min_max_integer, gfc_simplify_max, NULL,
   2563  1.1  mrg 	     a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
   2564  1.1  mrg 
   2565  1.1  mrg   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2566  1.1  mrg 	     gfc_check_min_max_real, gfc_simplify_max, NULL,
   2567  1.1  mrg 	     a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
   2568  1.1  mrg 
   2569  1.1  mrg   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2570  1.1  mrg 	     gfc_check_min_max_real, gfc_simplify_max, NULL,
   2571  1.1  mrg 	     a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
   2572  1.1  mrg 
   2573  1.1  mrg   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
   2574  1.1  mrg 	     gfc_check_min_max_double, gfc_simplify_max, NULL,
   2575  1.1  mrg 	     a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
   2576  1.1  mrg 
   2577  1.1  mrg   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
   2578  1.1  mrg 
   2579  1.1  mrg   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
   2580  1.1  mrg 	     di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_maxexponent, NULL,
   2581  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED);
   2582  1.1  mrg 
   2583  1.1  mrg   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
   2584  1.1  mrg 
   2585  1.1  mrg   add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2586  1.1  mrg 	       gfc_check_minloc_maxloc, gfc_simplify_maxloc, gfc_resolve_maxloc,
   2587  1.1  mrg 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2588  1.1  mrg 	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
   2589  1.1  mrg 	       bck, BT_LOGICAL, dl, OPTIONAL);
   2590  1.1  mrg 
   2591  1.1  mrg   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
   2592  1.1  mrg 
   2593  1.1  mrg   add_sym_6fl ("findloc", GFC_ISYM_FINDLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
   2594  1.1  mrg 	       BT_INTEGER, di, GFC_STD_F2008,
   2595  1.1  mrg 	       gfc_check_findloc, gfc_simplify_findloc, gfc_resolve_findloc,
   2596  1.1  mrg 	       ar, BT_REAL, dr, REQUIRED, val, BT_REAL, dr, REQUIRED,
   2597  1.1  mrg 	       dm, BT_INTEGER, ii, OPTIONAL, msk, BT_LOGICAL, dl, OPTIONAL,
   2598  1.1  mrg 	       kind, BT_INTEGER, di, OPTIONAL, bck, BT_LOGICAL, dl, OPTIONAL);
   2599  1.1  mrg 
   2600  1.1  mrg   make_generic ("findloc", GFC_ISYM_FINDLOC, GFC_STD_F2008);
   2601  1.1  mrg 
   2602  1.1  mrg   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2603  1.1  mrg 		gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
   2604  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2605  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2606  1.1  mrg 
   2607  1.1  mrg   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
   2608  1.1  mrg 
   2609  1.1  mrg   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   2610  1.1  mrg 	     GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
   2611  1.1  mrg 
   2612  1.1  mrg   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
   2613  1.1  mrg 
   2614  1.1  mrg   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   2615  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
   2616  1.1  mrg 
   2617  1.1  mrg   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
   2618  1.1  mrg 
   2619  1.1  mrg   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2620  1.1  mrg 	     gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
   2621  1.1  mrg 	     ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
   2622  1.1  mrg 	     msk, BT_LOGICAL, dl, REQUIRED);
   2623  1.1  mrg 
   2624  1.1  mrg   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
   2625  1.1  mrg 
   2626  1.1  mrg   add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
   2627  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2628  1.1  mrg 	     gfc_check_merge_bits, gfc_simplify_merge_bits,
   2629  1.1  mrg 	     gfc_resolve_merge_bits,
   2630  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2631  1.1  mrg 	     j, BT_INTEGER, di, REQUIRED,
   2632  1.1  mrg 	     msk, BT_INTEGER, di, REQUIRED);
   2633  1.1  mrg 
   2634  1.1  mrg   make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
   2635  1.1  mrg 
   2636  1.1  mrg   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
   2637  1.1  mrg      int(min).  */
   2638  1.1  mrg 
   2639  1.1  mrg   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
   2640  1.1  mrg 	      gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
   2641  1.1  mrg 	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
   2642  1.1  mrg 
   2643  1.1  mrg   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2644  1.1  mrg 	      gfc_check_min_max_integer, gfc_simplify_min, NULL,
   2645  1.1  mrg 	      a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
   2646  1.1  mrg 
   2647  1.1  mrg   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2648  1.1  mrg 	      gfc_check_min_max_integer, gfc_simplify_min, NULL,
   2649  1.1  mrg 	      a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
   2650  1.1  mrg 
   2651  1.1  mrg   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2652  1.1  mrg 	      gfc_check_min_max_real, gfc_simplify_min, NULL,
   2653  1.1  mrg 	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
   2654  1.1  mrg 
   2655  1.1  mrg   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
   2656  1.1  mrg 	      gfc_check_min_max_real, gfc_simplify_min, NULL,
   2657  1.1  mrg 	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
   2658  1.1  mrg 
   2659  1.1  mrg   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
   2660  1.1  mrg 	      gfc_check_min_max_double, gfc_simplify_min, NULL,
   2661  1.1  mrg 	      a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
   2662  1.1  mrg 
   2663  1.1  mrg   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
   2664  1.1  mrg 
   2665  1.1  mrg   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
   2666  1.1  mrg 	     di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_minexponent, NULL,
   2667  1.1  mrg 	     x, BT_UNKNOWN, dr, REQUIRED);
   2668  1.1  mrg 
   2669  1.1  mrg   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
   2670  1.1  mrg 
   2671  1.1  mrg   add_sym_5ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2672  1.1  mrg 	       gfc_check_minloc_maxloc, gfc_simplify_minloc, gfc_resolve_minloc,
   2673  1.1  mrg 	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2674  1.1  mrg 	       msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
   2675  1.1  mrg 	       bck, BT_LOGICAL, dl, OPTIONAL);
   2676  1.1  mrg 
   2677  1.1  mrg   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
   2678  1.1  mrg 
   2679  1.1  mrg   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2680  1.1  mrg 		gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
   2681  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2682  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2683  1.1  mrg 
   2684  1.1  mrg   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
   2685  1.1  mrg 
   2686  1.1  mrg   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   2687  1.1  mrg 	     gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
   2688  1.1  mrg 	     a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
   2689  1.1  mrg 
   2690  1.1  mrg   if (flag_dec_intrinsic_ints)
   2691  1.1  mrg     {
   2692  1.1  mrg       make_alias ("bmod", GFC_STD_GNU);
   2693  1.1  mrg       make_alias ("imod", GFC_STD_GNU);
   2694  1.1  mrg       make_alias ("jmod", GFC_STD_GNU);
   2695  1.1  mrg       make_alias ("kmod", GFC_STD_GNU);
   2696  1.1  mrg     }
   2697  1.1  mrg 
   2698  1.1  mrg   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   2699  1.1  mrg 	     NULL, gfc_simplify_mod, gfc_resolve_mod,
   2700  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
   2701  1.1  mrg 
   2702  1.1  mrg   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   2703  1.1  mrg 	     gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
   2704  1.1  mrg 	     a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
   2705  1.1  mrg 
   2706  1.1  mrg   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
   2707  1.1  mrg 
   2708  1.1  mrg   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
   2709  1.1  mrg 	     gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
   2710  1.1  mrg 	     a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
   2711  1.1  mrg 
   2712  1.1  mrg   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
   2713  1.1  mrg 
   2714  1.1  mrg   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2715  1.1  mrg 	     gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
   2716  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
   2717  1.1  mrg 
   2718  1.1  mrg   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
   2719  1.1  mrg 
   2720  1.1  mrg   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
   2721  1.1  mrg 	     GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
   2722  1.1  mrg 	     a, BT_CHARACTER, dc, REQUIRED);
   2723  1.1  mrg 
   2724  1.1  mrg   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
   2725  1.1  mrg 
   2726  1.1  mrg   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   2727  1.1  mrg 	     gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
   2728  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2729  1.1  mrg 
   2730  1.1  mrg   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   2731  1.1  mrg 	     gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
   2732  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   2733  1.1  mrg 
   2734  1.1  mrg   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
   2735  1.1  mrg 
   2736  1.1  mrg   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2737  1.1  mrg 	     gfc_check_i, gfc_simplify_not, gfc_resolve_not,
   2738  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   2739  1.1  mrg 
   2740  1.1  mrg   if (flag_dec_intrinsic_ints)
   2741  1.1  mrg     {
   2742  1.1  mrg       make_alias ("bnot", GFC_STD_GNU);
   2743  1.1  mrg       make_alias ("inot", GFC_STD_GNU);
   2744  1.1  mrg       make_alias ("jnot", GFC_STD_GNU);
   2745  1.1  mrg       make_alias ("knot", GFC_STD_GNU);
   2746  1.1  mrg     }
   2747  1.1  mrg 
   2748  1.1  mrg   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
   2749  1.1  mrg 
   2750  1.1  mrg   add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
   2751  1.1  mrg 	     GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
   2752  1.1  mrg 	     x, BT_REAL, dr, REQUIRED,
   2753  1.1  mrg 	     dm, BT_INTEGER, ii, OPTIONAL);
   2754  1.1  mrg 
   2755  1.1  mrg   make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
   2756  1.1  mrg 
   2757  1.1  mrg   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2758  1.1  mrg 	     gfc_check_null, gfc_simplify_null, NULL,
   2759  1.1  mrg 	     mo, BT_INTEGER, di, OPTIONAL);
   2760  1.1  mrg 
   2761  1.1  mrg   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
   2762  1.1  mrg 
   2763  1.1  mrg   add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_TRANSFORMATIONAL,
   2764  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
   2765  1.1  mrg 	     gfc_check_num_images, gfc_simplify_num_images, NULL,
   2766  1.1  mrg 	     dist, BT_INTEGER, di, OPTIONAL,
   2767  1.1  mrg 	     failed, BT_LOGICAL, dl, OPTIONAL);
   2768  1.1  mrg 
   2769  1.1  mrg   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2770  1.1  mrg 	     gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
   2771  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
   2772  1.1  mrg 	     v, BT_REAL, dr, OPTIONAL);
   2773  1.1  mrg 
   2774  1.1  mrg   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
   2775  1.1  mrg 
   2776  1.1  mrg 
   2777  1.1  mrg   add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
   2778  1.1  mrg 	     GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
   2779  1.1  mrg 	     msk, BT_LOGICAL, dl, REQUIRED,
   2780  1.1  mrg 	     dm, BT_INTEGER, ii, OPTIONAL);
   2781  1.1  mrg 
   2782  1.1  mrg   make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
   2783  1.1  mrg 
   2784  1.1  mrg   add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
   2785  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2786  1.1  mrg 	     gfc_check_i, gfc_simplify_popcnt, NULL,
   2787  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   2788  1.1  mrg 
   2789  1.1  mrg   make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
   2790  1.1  mrg 
   2791  1.1  mrg   add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
   2792  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2793  1.1  mrg 	     gfc_check_i, gfc_simplify_poppar, NULL,
   2794  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   2795  1.1  mrg 
   2796  1.1  mrg   make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
   2797  1.1  mrg 
   2798  1.1  mrg   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2799  1.1  mrg 	     gfc_check_precision, gfc_simplify_precision, NULL,
   2800  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   2801  1.1  mrg 
   2802  1.1  mrg   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
   2803  1.1  mrg 
   2804  1.1  mrg   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
   2805  1.1  mrg 		    BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
   2806  1.1  mrg 		    a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
   2807  1.1  mrg 
   2808  1.1  mrg   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
   2809  1.1  mrg 
   2810  1.1  mrg   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2811  1.1  mrg 		gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
   2812  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   2813  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   2814  1.1  mrg 
   2815  1.1  mrg   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
   2816  1.1  mrg 
   2817  1.1  mrg   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2818  1.1  mrg 	     gfc_check_radix, gfc_simplify_radix, NULL,
   2819  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   2820  1.1  mrg 
   2821  1.1  mrg   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
   2822  1.1  mrg 
   2823  1.1  mrg   /* The following function is for G77 compatibility.  */
   2824  1.1  mrg   add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
   2825  1.1  mrg 	     4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
   2826  1.1  mrg 	     i, BT_INTEGER, 4, OPTIONAL);
   2827  1.1  mrg 
   2828  1.1  mrg   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
   2829  1.1  mrg      use slightly different shoddy multiplicative congruential PRNG.  */
   2830  1.1  mrg   make_alias ("ran", GFC_STD_GNU);
   2831  1.1  mrg 
   2832  1.1  mrg   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
   2833  1.1  mrg 
   2834  1.1  mrg   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2835  1.1  mrg 	     gfc_check_range, gfc_simplify_range, NULL,
   2836  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2837  1.1  mrg 
   2838  1.1  mrg   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
   2839  1.1  mrg 
   2840  1.1  mrg   add_sym_1 ("rank", GFC_ISYM_RANK, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
   2841  1.1  mrg 	     GFC_STD_F2018, gfc_check_rank, gfc_simplify_rank, gfc_resolve_rank,
   2842  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2843  1.1  mrg   make_generic ("rank", GFC_ISYM_RANK, GFC_STD_F2018);
   2844  1.1  mrg 
   2845  1.1  mrg   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2846  1.1  mrg 	     gfc_check_real, gfc_simplify_real, gfc_resolve_real,
   2847  1.1  mrg 	     a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
   2848  1.1  mrg 
   2849  1.1  mrg   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
   2850  1.1  mrg 
   2851  1.1  mrg   /* This provides compatibility with g77.  */
   2852  1.1  mrg   add_sym_1 ("realpart", GFC_ISYM_REALPART, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
   2853  1.1  mrg 	     gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
   2854  1.1  mrg 	     a, BT_UNKNOWN, dr, REQUIRED);
   2855  1.1  mrg 
   2856  1.1  mrg   make_generic ("realpart", GFC_ISYM_REALPART, GFC_STD_F77);
   2857  1.1  mrg 
   2858  1.1  mrg   add_sym_1 ("float", GFC_ISYM_FLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2859  1.1  mrg 	     gfc_check_float, gfc_simplify_float, NULL,
   2860  1.1  mrg 	     a, BT_INTEGER, di, REQUIRED);
   2861  1.1  mrg 
   2862  1.1  mrg   if (flag_dec_intrinsic_ints)
   2863  1.1  mrg     {
   2864  1.1  mrg       make_alias ("floati", GFC_STD_GNU);
   2865  1.1  mrg       make_alias ("floatj", GFC_STD_GNU);
   2866  1.1  mrg       make_alias ("floatk", GFC_STD_GNU);
   2867  1.1  mrg     }
   2868  1.1  mrg 
   2869  1.1  mrg   make_generic ("float", GFC_ISYM_FLOAT, GFC_STD_F77);
   2870  1.1  mrg 
   2871  1.1  mrg   add_sym_1 ("dfloat", GFC_ISYM_DFLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
   2872  1.1  mrg 	     gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
   2873  1.1  mrg 	     a, BT_REAL, dr, REQUIRED);
   2874  1.1  mrg 
   2875  1.1  mrg   make_generic ("dfloat", GFC_ISYM_DFLOAT, GFC_STD_F77);
   2876  1.1  mrg 
   2877  1.1  mrg   add_sym_1 ("sngl", GFC_ISYM_SNGL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
   2878  1.1  mrg 	     gfc_check_sngl, gfc_simplify_sngl, NULL,
   2879  1.1  mrg 	     a, BT_REAL, dd, REQUIRED);
   2880  1.1  mrg 
   2881  1.1  mrg   make_generic ("sngl", GFC_ISYM_SNGL, GFC_STD_F77);
   2882  1.1  mrg 
   2883  1.1  mrg   add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   2884  1.1  mrg 	     GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
   2885  1.1  mrg 	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
   2886  1.1  mrg 
   2887  1.1  mrg   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
   2888  1.1  mrg 
   2889  1.1  mrg   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
   2890  1.1  mrg 	     gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
   2891  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
   2892  1.1  mrg 
   2893  1.1  mrg   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
   2894  1.1  mrg 
   2895  1.1  mrg   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2896  1.1  mrg 	     gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
   2897  1.1  mrg 	     src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
   2898  1.1  mrg 	     pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
   2899  1.1  mrg 
   2900  1.1  mrg   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
   2901  1.1  mrg 
   2902  1.1  mrg   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   2903  1.1  mrg 	     GFC_STD_F95, gfc_check_fn_r, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
   2904  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2905  1.1  mrg 
   2906  1.1  mrg   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
   2907  1.1  mrg 
   2908  1.1  mrg   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
   2909  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2003,
   2910  1.1  mrg 	     gfc_check_same_type_as, gfc_simplify_same_type_as, NULL,
   2911  1.1  mrg 	     a, BT_UNKNOWN, 0, REQUIRED,
   2912  1.1  mrg 	     b, BT_UNKNOWN, 0, REQUIRED);
   2913  1.1  mrg 
   2914  1.1  mrg   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2915  1.1  mrg 	     gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
   2916  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
   2917  1.1  mrg 
   2918  1.1  mrg   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
   2919  1.1  mrg 
   2920  1.1  mrg   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
   2921  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   2922  1.1  mrg 	     gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
   2923  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
   2924  1.1  mrg 	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
   2925  1.1  mrg 
   2926  1.1  mrg   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
   2927  1.1  mrg 
   2928  1.1  mrg   /* Added for G77 compatibility garbage.  */
   2929  1.1  mrg   add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
   2930  1.1  mrg 	     4, GFC_STD_GNU, NULL, NULL, NULL);
   2931  1.1  mrg 
   2932  1.1  mrg   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
   2933  1.1  mrg 
   2934  1.1  mrg   /* Added for G77 compatibility.  */
   2935  1.1  mrg   add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
   2936  1.1  mrg 	     dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
   2937  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   2938  1.1  mrg 
   2939  1.1  mrg   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
   2940  1.1  mrg 
   2941  1.1  mrg   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
   2942  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
   2943  1.1  mrg 	     gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
   2944  1.1  mrg 	     NULL, nm, BT_CHARACTER, dc, REQUIRED);
   2945  1.1  mrg 
   2946  1.1  mrg   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
   2947  1.1  mrg 
   2948  1.1  mrg   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
   2949  1.1  mrg 	     GFC_STD_F95, gfc_check_selected_int_kind,
   2950  1.1  mrg 	     gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
   2951  1.1  mrg 
   2952  1.1  mrg   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
   2953  1.1  mrg 
   2954  1.1  mrg   add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
   2955  1.1  mrg 	     GFC_STD_F95, gfc_check_selected_real_kind,
   2956  1.1  mrg 	     gfc_simplify_selected_real_kind, NULL,
   2957  1.1  mrg 	     p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
   2958  1.1  mrg 	     "radix", BT_INTEGER, di, OPTIONAL);
   2959  1.1  mrg 
   2960  1.1  mrg   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
   2961  1.1  mrg 
   2962  1.1  mrg   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   2963  1.1  mrg 	     gfc_check_set_exponent, gfc_simplify_set_exponent,
   2964  1.1  mrg 	     gfc_resolve_set_exponent,
   2965  1.1  mrg 	     x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
   2966  1.1  mrg 
   2967  1.1  mrg   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
   2968  1.1  mrg 
   2969  1.1  mrg   add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
   2970  1.1  mrg 	     gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
   2971  1.1  mrg 	     src, BT_REAL, dr, REQUIRED,
   2972  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   2973  1.1  mrg 
   2974  1.1  mrg   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
   2975  1.1  mrg 
   2976  1.1  mrg   add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
   2977  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2978  1.1  mrg 	     gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
   2979  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2980  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED);
   2981  1.1  mrg 
   2982  1.1  mrg   make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
   2983  1.1  mrg 
   2984  1.1  mrg   add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
   2985  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2986  1.1  mrg 	     gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
   2987  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2988  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED);
   2989  1.1  mrg 
   2990  1.1  mrg   make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
   2991  1.1  mrg 
   2992  1.1  mrg   add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
   2993  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   2994  1.1  mrg 	     gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
   2995  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED,
   2996  1.1  mrg 	     sh, BT_INTEGER, di, REQUIRED);
   2997  1.1  mrg 
   2998  1.1  mrg   make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
   2999  1.1  mrg 
   3000  1.1  mrg   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3001  1.1  mrg 	     gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
   3002  1.1  mrg 	     a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
   3003  1.1  mrg 
   3004  1.1  mrg   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
   3005  1.1  mrg 	     NULL, gfc_simplify_sign, gfc_resolve_sign,
   3006  1.1  mrg 	     a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
   3007  1.1  mrg 
   3008  1.1  mrg   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3009  1.1  mrg 	     gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
   3010  1.1  mrg 	     a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
   3011  1.1  mrg 
   3012  1.1  mrg   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
   3013  1.1  mrg 
   3014  1.1  mrg   add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   3015  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
   3016  1.1  mrg 	     num, BT_INTEGER, di, REQUIRED, han, BT_VOID, 0, REQUIRED);
   3017  1.1  mrg 
   3018  1.1  mrg   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
   3019  1.1  mrg 
   3020  1.1  mrg   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3021  1.1  mrg 	     gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
   3022  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3023  1.1  mrg 
   3024  1.1  mrg   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3025  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
   3026  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3027  1.1  mrg 
   3028  1.1  mrg   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   3029  1.1  mrg 	     NULL, gfc_simplify_sin, gfc_resolve_sin,
   3030  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   3031  1.1  mrg 
   3032  1.1  mrg   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
   3033  1.1  mrg 	     NULL, gfc_simplify_sin, gfc_resolve_sin,
   3034  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   3035  1.1  mrg 
   3036  1.1  mrg   make_alias ("cdsin", GFC_STD_GNU);
   3037  1.1  mrg 
   3038  1.1  mrg   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
   3039  1.1  mrg 
   3040  1.1  mrg   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3041  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
   3042  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3043  1.1  mrg 
   3044  1.1  mrg   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3045  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
   3046  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3047  1.1  mrg 
   3048  1.1  mrg   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
   3049  1.1  mrg 
   3050  1.1  mrg   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
   3051  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   3052  1.1  mrg 	     gfc_check_size, gfc_simplify_size, gfc_resolve_size,
   3053  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   3054  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   3055  1.1  mrg 
   3056  1.1  mrg   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
   3057  1.1  mrg 
   3058  1.1  mrg   /* Obtain the stride for a given dimensions; to be used only internally.
   3059  1.1  mrg      "make_from_module" makes it inaccessible for external users.  */
   3060  1.1  mrg   add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
   3061  1.1  mrg 	     BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
   3062  1.1  mrg 	     NULL, NULL, gfc_resolve_stride,
   3063  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
   3064  1.1  mrg   make_from_module();
   3065  1.1  mrg 
   3066  1.1  mrg   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
   3067  1.1  mrg 	     BT_INTEGER, ii, GFC_STD_GNU,
   3068  1.1  mrg 	     gfc_check_sizeof, gfc_simplify_sizeof, NULL,
   3069  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   3070  1.1  mrg 
   3071  1.1  mrg   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
   3072  1.1  mrg 
   3073  1.1  mrg   /* The following functions are part of ISO_C_BINDING.  */
   3074  1.1  mrg   add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
   3075  1.1  mrg 	     BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
   3076  1.1  mrg 	     c_ptr_1, BT_VOID, 0, REQUIRED,
   3077  1.1  mrg 	     c_ptr_2, BT_VOID, 0, OPTIONAL);
   3078  1.1  mrg   make_from_module();
   3079  1.1  mrg 
   3080  1.1  mrg   add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
   3081  1.1  mrg 	     BT_VOID, 0, GFC_STD_F2003,
   3082  1.1  mrg 	     gfc_check_c_loc, NULL, gfc_resolve_c_loc,
   3083  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   3084  1.1  mrg   make_from_module();
   3085  1.1  mrg 
   3086  1.1  mrg   add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
   3087  1.1  mrg 	     BT_VOID, 0, GFC_STD_F2003,
   3088  1.1  mrg 	     gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
   3089  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   3090  1.1  mrg   make_from_module();
   3091  1.1  mrg 
   3092  1.1  mrg   add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
   3093  1.1  mrg 	     BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
   3094  1.1  mrg 	     gfc_check_c_sizeof, gfc_simplify_sizeof, NULL,
   3095  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   3096  1.1  mrg   make_from_module();
   3097  1.1  mrg 
   3098  1.1  mrg   /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV.  */
   3099  1.1  mrg   add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
   3100  1.1  mrg 	     ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
   3101  1.1  mrg 	     NULL, gfc_simplify_compiler_options, NULL);
   3102  1.1  mrg   make_from_module();
   3103  1.1  mrg 
   3104  1.1  mrg   add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
   3105  1.1  mrg 	     ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
   3106  1.1  mrg 	     NULL, gfc_simplify_compiler_version, NULL);
   3107  1.1  mrg   make_from_module();
   3108  1.1  mrg 
   3109  1.1  mrg   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
   3110  1.1  mrg 	     GFC_STD_F95, gfc_check_fn_r, gfc_simplify_spacing, gfc_resolve_spacing,
   3111  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3112  1.1  mrg 
   3113  1.1  mrg   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
   3114  1.1  mrg 
   3115  1.1  mrg   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3116  1.1  mrg 	     gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
   3117  1.1  mrg 	     src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
   3118  1.1  mrg 	     ncopies, BT_INTEGER, di, REQUIRED);
   3119  1.1  mrg 
   3120  1.1  mrg   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
   3121  1.1  mrg 
   3122  1.1  mrg   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3123  1.1  mrg 	     gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
   3124  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3125  1.1  mrg 
   3126  1.1  mrg   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3127  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
   3128  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3129  1.1  mrg 
   3130  1.1  mrg   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
   3131  1.1  mrg 	     NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
   3132  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   3133  1.1  mrg 
   3134  1.1  mrg   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
   3135  1.1  mrg 	     NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
   3136  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   3137  1.1  mrg 
   3138  1.1  mrg   make_alias ("cdsqrt", GFC_STD_GNU);
   3139  1.1  mrg 
   3140  1.1  mrg   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
   3141  1.1  mrg 
   3142  1.1  mrg   add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
   3143  1.1  mrg 		    BT_INTEGER, di, GFC_STD_GNU,
   3144  1.1  mrg 		    gfc_check_stat, NULL, gfc_resolve_stat,
   3145  1.1  mrg 		    nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3146  1.1  mrg 		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
   3147  1.1  mrg 
   3148  1.1  mrg   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
   3149  1.1  mrg 
   3150  1.1  mrg   add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
   3151  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
   3152  1.1  mrg 	     gfc_check_failed_or_stopped_images,
   3153  1.1  mrg 	     gfc_simplify_failed_or_stopped_images,
   3154  1.1  mrg 	     gfc_resolve_stopped_images, team, BT_VOID, di, OPTIONAL,
   3155  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   3156  1.1  mrg 
   3157  1.1  mrg   add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
   3158  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   3159  1.1  mrg 	     gfc_check_storage_size, gfc_simplify_storage_size,
   3160  1.1  mrg 	     gfc_resolve_storage_size,
   3161  1.1  mrg 	     a, BT_UNKNOWN, 0, REQUIRED,
   3162  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   3163  1.1  mrg 
   3164  1.1  mrg   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3165  1.1  mrg 		gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
   3166  1.1  mrg 		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   3167  1.1  mrg 		msk, BT_LOGICAL, dl, OPTIONAL);
   3168  1.1  mrg 
   3169  1.1  mrg   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
   3170  1.1  mrg 
   3171  1.1  mrg   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   3172  1.1  mrg 	     GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
   3173  1.1  mrg 	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
   3174  1.1  mrg 
   3175  1.1  mrg   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
   3176  1.1  mrg 
   3177  1.1  mrg   add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   3178  1.1  mrg 	     GFC_STD_GNU, NULL, NULL, NULL,
   3179  1.1  mrg 	     com, BT_CHARACTER, dc, REQUIRED);
   3180  1.1  mrg 
   3181  1.1  mrg   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
   3182  1.1  mrg 
   3183  1.1  mrg   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3184  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
   3185  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3186  1.1  mrg 
   3187  1.1  mrg   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3188  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
   3189  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3190  1.1  mrg 
   3191  1.1  mrg   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
   3192  1.1  mrg 
   3193  1.1  mrg   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
   3194  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
   3195  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3196  1.1  mrg 
   3197  1.1  mrg   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
   3198  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
   3199  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3200  1.1  mrg 
   3201  1.1  mrg   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
   3202  1.1  mrg 
   3203  1.1  mrg   add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER, CLASS_TRANSFORMATIONAL,
   3204  1.1  mrg 	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
   3205  1.1  mrg 	     gfc_check_team_number, NULL, gfc_resolve_team_number,
   3206  1.1  mrg 	     team, BT_DERIVED, di, OPTIONAL);
   3207  1.1  mrg 
   3208  1.1  mrg   add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
   3209  1.1  mrg 	     gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
   3210  1.1  mrg 	     ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
   3211  1.1  mrg 	     dist, BT_INTEGER, di, OPTIONAL);
   3212  1.1  mrg 
   3213  1.1  mrg   add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   3214  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
   3215  1.1  mrg 
   3216  1.1  mrg   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
   3217  1.1  mrg 
   3218  1.1  mrg   add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   3219  1.1  mrg 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
   3220  1.1  mrg 
   3221  1.1  mrg   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
   3222  1.1  mrg 
   3223  1.1  mrg   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3224  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED);
   3225  1.1  mrg 
   3226  1.1  mrg   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
   3227  1.1  mrg 
   3228  1.1  mrg   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
   3229  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F2008,
   3230  1.1  mrg 	     gfc_check_i, gfc_simplify_trailz, NULL,
   3231  1.1  mrg 	     i, BT_INTEGER, di, REQUIRED);
   3232  1.1  mrg 
   3233  1.1  mrg   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
   3234  1.1  mrg 
   3235  1.1  mrg   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3236  1.1  mrg 	     gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
   3237  1.1  mrg 	     src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
   3238  1.1  mrg 	     sz, BT_INTEGER, di, OPTIONAL);
   3239  1.1  mrg 
   3240  1.1  mrg   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
   3241  1.1  mrg 
   3242  1.1  mrg   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3243  1.1  mrg 	     gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
   3244  1.1  mrg 	     m, BT_REAL, dr, REQUIRED);
   3245  1.1  mrg 
   3246  1.1  mrg   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
   3247  1.1  mrg 
   3248  1.1  mrg   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
   3249  1.1  mrg 	     gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
   3250  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED);
   3251  1.1  mrg 
   3252  1.1  mrg   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
   3253  1.1  mrg 
   3254  1.1  mrg   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
   3255  1.1  mrg 	     0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
   3256  1.1  mrg 	     ut, BT_INTEGER, di, REQUIRED);
   3257  1.1  mrg 
   3258  1.1  mrg   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
   3259  1.1  mrg 
   3260  1.1  mrg   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
   3261  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   3262  1.1  mrg 	     gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
   3263  1.1  mrg 	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   3264  1.1  mrg 	     kind, BT_INTEGER, di, OPTIONAL);
   3265  1.1  mrg 
   3266  1.1  mrg   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
   3267  1.1  mrg 
   3268  1.1  mrg   add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
   3269  1.1  mrg 	    BT_INTEGER, di, GFC_STD_F2008,
   3270  1.1  mrg 	    gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
   3271  1.1  mrg 	    ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
   3272  1.1  mrg 	    kind, BT_INTEGER, di, OPTIONAL);
   3273  1.1  mrg 
   3274  1.1  mrg   make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
   3275  1.1  mrg 
   3276  1.1  mrg   /* g77 compatibility for UMASK.  */
   3277  1.1  mrg   add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
   3278  1.1  mrg 	     GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
   3279  1.1  mrg 	     msk, BT_INTEGER, di, REQUIRED);
   3280  1.1  mrg 
   3281  1.1  mrg   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
   3282  1.1  mrg 
   3283  1.1  mrg   /* g77 compatibility for UNLINK.  */
   3284  1.1  mrg   add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
   3285  1.1  mrg 	     di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
   3286  1.1  mrg 	     "path", BT_CHARACTER, dc, REQUIRED);
   3287  1.1  mrg 
   3288  1.1  mrg   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
   3289  1.1  mrg 
   3290  1.1  mrg   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
   3291  1.1  mrg 	     gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
   3292  1.1  mrg 	     v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
   3293  1.1  mrg 	     f, BT_REAL, dr, REQUIRED);
   3294  1.1  mrg 
   3295  1.1  mrg   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
   3296  1.1  mrg 
   3297  1.1  mrg   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
   3298  1.1  mrg 	     BT_INTEGER, di, GFC_STD_F95,
   3299  1.1  mrg 	     gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
   3300  1.1  mrg 	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
   3301  1.1  mrg 	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
   3302  1.1  mrg 
   3303  1.1  mrg   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
   3304  1.1  mrg 
   3305  1.1  mrg   add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
   3306  1.1  mrg 	     GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
   3307  1.1  mrg 	     x, BT_UNKNOWN, 0, REQUIRED);
   3308  1.1  mrg 
   3309  1.1  mrg   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
   3310  1.1  mrg 
   3311  1.1  mrg 
   3312  1.1  mrg   /* The next of intrinsic subprogram are the degree trignometric functions.
   3313  1.1  mrg      These were hidden behind the -fdec-math option, but are now simply
   3314  1.1  mrg      included as extensions to the set of intrinsic subprograms.  */
   3315  1.1  mrg 
   3316  1.1  mrg   add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
   3317  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3318  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd,
   3319  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3320  1.1  mrg 
   3321  1.1  mrg   add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
   3322  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3323  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd,
   3324  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3325  1.1  mrg 
   3326  1.1  mrg   make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_GNU);
   3327  1.1  mrg 
   3328  1.1  mrg   add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
   3329  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3330  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd,
   3331  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3332  1.1  mrg 
   3333  1.1  mrg   add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
   3334  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3335  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd,
   3336  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3337  1.1  mrg 
   3338  1.1  mrg   make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_GNU);
   3339  1.1  mrg 
   3340  1.1  mrg   add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3341  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3342  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
   3343  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3344  1.1  mrg 
   3345  1.1  mrg   add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3346  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3347  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd,
   3348  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3349  1.1  mrg 
   3350  1.1  mrg   make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_GNU);
   3351  1.1  mrg 
   3352  1.1  mrg   add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
   3353  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3354  1.1  mrg 	     gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
   3355  1.1  mrg 	     y, BT_REAL, dr, REQUIRED,
   3356  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3357  1.1  mrg 
   3358  1.1  mrg   add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
   3359  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3360  1.1  mrg 	     gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
   3361  1.1  mrg 	     y, BT_REAL, dd, REQUIRED,
   3362  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3363  1.1  mrg 
   3364  1.1  mrg   make_generic ("atan2d", GFC_ISYM_ATAN2D, GFC_STD_GNU);
   3365  1.1  mrg 
   3366  1.1  mrg   add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
   3367  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3368  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd,
   3369  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3370  1.1  mrg 
   3371  1.1  mrg   add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
   3372  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3373  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd,
   3374  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3375  1.1  mrg 
   3376  1.1  mrg   make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_GNU);
   3377  1.1  mrg 
   3378  1.1  mrg   add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
   3379  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3380  1.1  mrg 	     gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd,
   3381  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3382  1.1  mrg 
   3383  1.1  mrg   add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
   3384  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3385  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trigd,
   3386  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3387  1.1  mrg 
   3388  1.1  mrg   add_sym_1 ("ccotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
   3389  1.1  mrg 	     BT_COMPLEX, dz, GFC_STD_GNU,
   3390  1.1  mrg 	     NULL, gfc_simplify_cotan, gfc_resolve_trigd,
   3391  1.1  mrg 	     x, BT_COMPLEX, dz, REQUIRED);
   3392  1.1  mrg 
   3393  1.1  mrg   add_sym_1 ("zcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
   3394  1.1  mrg 	     BT_COMPLEX, dd, GFC_STD_GNU,
   3395  1.1  mrg 	     NULL, gfc_simplify_cotan, gfc_resolve_trigd,
   3396  1.1  mrg 	     x, BT_COMPLEX, dd, REQUIRED);
   3397  1.1  mrg 
   3398  1.1  mrg   make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
   3399  1.1  mrg 
   3400  1.1  mrg   add_sym_1 ("cotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3401  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3402  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trigd,
   3403  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3404  1.1  mrg 
   3405  1.1  mrg   add_sym_1 ("dcotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3406  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3407  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trigd,
   3408  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3409  1.1  mrg 
   3410  1.1  mrg   make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU);
   3411  1.1  mrg 
   3412  1.1  mrg   add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
   3413  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3414  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd,
   3415  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3416  1.1  mrg 
   3417  1.1  mrg   add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
   3418  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3419  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd,
   3420  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3421  1.1  mrg 
   3422  1.1  mrg   make_generic ("sind", GFC_ISYM_SIND, GFC_STD_GNU);
   3423  1.1  mrg 
   3424  1.1  mrg   add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3425  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU,
   3426  1.1  mrg 	     gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd,
   3427  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3428  1.1  mrg 
   3429  1.1  mrg   add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
   3430  1.1  mrg 	     BT_REAL, dd, GFC_STD_GNU,
   3431  1.1  mrg 	     gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd,
   3432  1.1  mrg 	     x, BT_REAL, dd, REQUIRED);
   3433  1.1  mrg 
   3434  1.1  mrg   make_generic ("tand", GFC_ISYM_TAND, GFC_STD_GNU);
   3435  1.1  mrg 
   3436  1.1  mrg   /* The following function is internally used for coarray libray functions.
   3437  1.1  mrg      "make_from_module" makes it inaccessible for external users.  */
   3438  1.1  mrg   add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
   3439  1.1  mrg 	     BT_REAL, dr, GFC_STD_GNU, NULL, NULL, NULL,
   3440  1.1  mrg 	     x, BT_REAL, dr, REQUIRED);
   3441  1.1  mrg   make_from_module();
   3442  1.1  mrg }
   3443  1.1  mrg 
   3444  1.1  mrg 
   3445  1.1  mrg /* Add intrinsic subroutines.  */
   3446  1.1  mrg 
   3447  1.1  mrg static void
   3448  1.1  mrg add_subroutines (void)
   3449  1.1  mrg {
   3450  1.1  mrg   /* Argument names.  These are used as argument keywords and so need to
   3451  1.1  mrg      match the documentation.  Please keep this list in sorted order.  */
   3452  1.1  mrg   static const char
   3453  1.1  mrg     *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
   3454  1.1  mrg     *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
   3455  1.1  mrg     *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
   3456  1.1  mrg     *length = "length", *ln = "len", *md = "mode", *msk = "mask",
   3457  1.1  mrg     *name = "name", *num = "number", *of = "offset", *old = "old",
   3458  1.1  mrg     *p1 = "path1", *p2 = "path2", *pid = "pid", *pos = "pos",
   3459  1.1  mrg     *pt = "put", *ptr = "ptr", *res = "result",
   3460  1.1  mrg     *result_image = "result_image", *sec = "seconds", *sig = "sig",
   3461  1.1  mrg     *st = "status", *stat = "stat", *sz = "size", *t = "to",
   3462  1.1  mrg     *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
   3463  1.1  mrg     *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
   3464  1.1  mrg 
   3465  1.1  mrg   int di, dr, dc, dl, ii;
   3466  1.1  mrg 
   3467  1.1  mrg   di = gfc_default_integer_kind;
   3468  1.1  mrg   dr = gfc_default_real_kind;
   3469  1.1  mrg   dc = gfc_default_character_kind;
   3470  1.1  mrg   dl = gfc_default_logical_kind;
   3471  1.1  mrg   ii = gfc_index_integer_kind;
   3472  1.1  mrg 
   3473  1.1  mrg   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
   3474  1.1  mrg 
   3475  1.1  mrg   make_noreturn();
   3476  1.1  mrg 
   3477  1.1  mrg   add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
   3478  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2008,
   3479  1.1  mrg 	      gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
   3480  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3481  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3482  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3483  1.1  mrg 
   3484  1.1  mrg   add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
   3485  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2008,
   3486  1.1  mrg 	      gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
   3487  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3488  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3489  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3490  1.1  mrg 
   3491  1.1  mrg   add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS, CLASS_ATOMIC,
   3492  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3493  1.1  mrg 	      gfc_check_atomic_cas, NULL, NULL,
   3494  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_INOUT,
   3495  1.1  mrg 	      "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3496  1.1  mrg 	      "compare", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3497  1.1  mrg 	      "new", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3498  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3499  1.1  mrg 
   3500  1.1  mrg   add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD, CLASS_ATOMIC,
   3501  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3502  1.1  mrg 	      gfc_check_atomic_op, NULL, NULL,
   3503  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3504  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3505  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3506  1.1  mrg 
   3507  1.1  mrg   add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND, CLASS_ATOMIC,
   3508  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3509  1.1  mrg 	      gfc_check_atomic_op, NULL, NULL,
   3510  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3511  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3512  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3513  1.1  mrg 
   3514  1.1  mrg   add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR, CLASS_ATOMIC,
   3515  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3516  1.1  mrg 	      gfc_check_atomic_op, NULL, NULL,
   3517  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3518  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3519  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3520  1.1  mrg 
   3521  1.1  mrg   add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR, CLASS_ATOMIC,
   3522  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3523  1.1  mrg 	      gfc_check_atomic_op, NULL, NULL,
   3524  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3525  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3526  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3527  1.1  mrg 
   3528  1.1  mrg   add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD, CLASS_ATOMIC,
   3529  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3530  1.1  mrg 	      gfc_check_atomic_fetch_op, NULL, NULL,
   3531  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3532  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3533  1.1  mrg 	      "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3534  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3535  1.1  mrg 
   3536  1.1  mrg   add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND, CLASS_ATOMIC,
   3537  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3538  1.1  mrg 	      gfc_check_atomic_fetch_op, NULL, NULL,
   3539  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3540  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3541  1.1  mrg 	      "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3542  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3543  1.1  mrg 
   3544  1.1  mrg   add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR, CLASS_ATOMIC,
   3545  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3546  1.1  mrg 	      gfc_check_atomic_fetch_op, NULL, NULL,
   3547  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3548  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3549  1.1  mrg 	      "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3550  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3551  1.1  mrg 
   3552  1.1  mrg   add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR, CLASS_ATOMIC,
   3553  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3554  1.1  mrg 	      gfc_check_atomic_fetch_op, NULL, NULL,
   3555  1.1  mrg 	      "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3556  1.1  mrg 	      "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3557  1.1  mrg 	      "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3558  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3559  1.1  mrg 
   3560  1.1  mrg   add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
   3561  1.1  mrg 
   3562  1.1  mrg   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
   3563  1.1  mrg 	      GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
   3564  1.1  mrg 	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
   3565  1.1  mrg 
   3566  1.1  mrg   add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY, CLASS_ATOMIC,
   3567  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3568  1.1  mrg 	      gfc_check_event_query, NULL, gfc_resolve_event_query,
   3569  1.1  mrg 	      "event", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3570  1.1  mrg 	      c, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3571  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3572  1.1  mrg 
   3573  1.1  mrg   /* More G77 compatibility garbage.  */
   3574  1.1  mrg   add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3575  1.1  mrg 	      gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
   3576  1.1  mrg 	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3577  1.1  mrg 	      res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3578  1.1  mrg 
   3579  1.1  mrg   add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3580  1.1  mrg 	      gfc_check_itime_idate, NULL, gfc_resolve_idate,
   3581  1.1  mrg 	      vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
   3582  1.1  mrg 
   3583  1.1  mrg   add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3584  1.1  mrg 	      gfc_check_itime_idate, NULL, gfc_resolve_itime,
   3585  1.1  mrg 	      vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
   3586  1.1  mrg 
   3587  1.1  mrg   add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3588  1.1  mrg 	      gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
   3589  1.1  mrg 	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3590  1.1  mrg 	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
   3591  1.1  mrg 
   3592  1.1  mrg   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
   3593  1.1  mrg 	      GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
   3594  1.1  mrg 	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3595  1.1  mrg 	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
   3596  1.1  mrg 
   3597  1.1  mrg   add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
   3598  1.1  mrg 	      GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
   3599  1.1  mrg 	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
   3600  1.1  mrg 
   3601  1.1  mrg   add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3602  1.1  mrg 	      gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
   3603  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3604  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3605  1.1  mrg 
   3606  1.1  mrg   add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3607  1.1  mrg 	      gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
   3608  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3609  1.1  mrg 	      md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3610  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3611  1.1  mrg 
   3612  1.1  mrg   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
   3613  1.1  mrg 	      0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
   3614  1.1  mrg 	      dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3615  1.1  mrg 	      tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3616  1.1  mrg 	      zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3617  1.1  mrg 	      vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3618  1.1  mrg 
   3619  1.1  mrg   /* More G77 compatibility garbage.  */
   3620  1.1  mrg   add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3621  1.1  mrg 	      gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
   3622  1.1  mrg 	      vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
   3623  1.1  mrg 	      tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
   3624  1.1  mrg 
   3625  1.1  mrg   add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3626  1.1  mrg 	      gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
   3627  1.1  mrg 	      vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
   3628  1.1  mrg 	      tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
   3629  1.1  mrg 
   3630  1.1  mrg   add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
   3631  1.1  mrg 	      CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
   3632  1.1  mrg 	      NULL, NULL, gfc_resolve_execute_command_line,
   3633  1.1  mrg 	      "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3634  1.1  mrg 	      "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
   3635  1.1  mrg 	      "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
   3636  1.1  mrg 	      "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3637  1.1  mrg 	      "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3638  1.1  mrg 
   3639  1.1  mrg   add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3640  1.1  mrg 	      gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
   3641  1.1  mrg 	      dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3642  1.1  mrg 
   3643  1.1  mrg   add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
   3644  1.1  mrg 	      0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
   3645  1.1  mrg 	      res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3646  1.1  mrg 
   3647  1.1  mrg   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
   3648  1.1  mrg 	      GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
   3649  1.1  mrg 	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
   3650  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3651  1.1  mrg 
   3652  1.1  mrg   add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
   3653  1.1  mrg 	      0, GFC_STD_GNU, NULL, NULL, NULL,
   3654  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3655  1.1  mrg 	      val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3656  1.1  mrg 
   3657  1.1  mrg   add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
   3658  1.1  mrg 	      0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
   3659  1.1  mrg 	      pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3660  1.1  mrg 	      val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3661  1.1  mrg 
   3662  1.1  mrg   add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
   3663  1.1  mrg 	      0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
   3664  1.1  mrg 	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3665  1.1  mrg 
   3666  1.1  mrg   /* F2003 commandline routines.  */
   3667  1.1  mrg 
   3668  1.1  mrg   add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
   3669  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2003,
   3670  1.1  mrg 	      NULL, NULL, gfc_resolve_get_command,
   3671  1.1  mrg 	      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3672  1.1  mrg 	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3673  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3674  1.1  mrg 
   3675  1.1  mrg   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
   3676  1.1  mrg 	      CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
   3677  1.1  mrg 	      gfc_resolve_get_command_argument,
   3678  1.1  mrg 	      num, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3679  1.1  mrg 	      val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3680  1.1  mrg 	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3681  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3682  1.1  mrg 
   3683  1.1  mrg   /* F2003 subroutine to get environment variables.  */
   3684  1.1  mrg 
   3685  1.1  mrg   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
   3686  1.1  mrg 	      CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
   3687  1.1  mrg 	      NULL, NULL, gfc_resolve_get_environment_variable,
   3688  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3689  1.1  mrg 	      val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
   3690  1.1  mrg 	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3691  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3692  1.1  mrg 	      trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
   3693  1.1  mrg 
   3694  1.1  mrg   add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
   3695  1.1  mrg 	      GFC_STD_F2003,
   3696  1.1  mrg 	      gfc_check_move_alloc, NULL, NULL,
   3697  1.1  mrg 	      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
   3698  1.1  mrg 	      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
   3699  1.1  mrg 
   3700  1.1  mrg   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
   3701  1.1  mrg 	      GFC_STD_F95, gfc_check_mvbits, NULL, gfc_resolve_mvbits,
   3702  1.1  mrg 	      f, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3703  1.1  mrg 	      fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3704  1.1  mrg 	      ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3705  1.1  mrg 	      t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
   3706  1.1  mrg 	      tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
   3707  1.1  mrg 
   3708  1.1  mrg   if (flag_dec_intrinsic_ints)
   3709  1.1  mrg     {
   3710  1.1  mrg       make_alias ("bmvbits", GFC_STD_GNU);
   3711  1.1  mrg       make_alias ("imvbits", GFC_STD_GNU);
   3712  1.1  mrg       make_alias ("jmvbits", GFC_STD_GNU);
   3713  1.1  mrg       make_alias ("kmvbits", GFC_STD_GNU);
   3714  1.1  mrg     }
   3715  1.1  mrg 
   3716  1.1  mrg   add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
   3717  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3718  1.1  mrg 	      gfc_check_random_init, NULL, gfc_resolve_random_init,
   3719  1.1  mrg 	      "repeatable",     BT_LOGICAL, dl, REQUIRED, INTENT_IN,
   3720  1.1  mrg 	      "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
   3721  1.1  mrg 
   3722  1.1  mrg   add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
   3723  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F95,
   3724  1.1  mrg 	      gfc_check_random_number, NULL, gfc_resolve_random_number,
   3725  1.1  mrg 	      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
   3726  1.1  mrg 
   3727  1.1  mrg   add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
   3728  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F95,
   3729  1.1  mrg 	      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
   3730  1.1  mrg 	      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3731  1.1  mrg 	      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3732  1.1  mrg 	      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3733  1.1  mrg 
   3734  1.1  mrg   /* The following subroutines are part of ISO_C_BINDING.  */
   3735  1.1  mrg 
   3736  1.1  mrg   add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
   3737  1.1  mrg 	      GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
   3738  1.1  mrg 	      "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
   3739  1.1  mrg 	      "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
   3740  1.1  mrg 	      "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
   3741  1.1  mrg   make_from_module();
   3742  1.1  mrg 
   3743  1.1  mrg   add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
   3744  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
   3745  1.1  mrg 	      NULL, NULL,
   3746  1.1  mrg 	      "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
   3747  1.1  mrg 	      "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
   3748  1.1  mrg   make_from_module();
   3749  1.1  mrg 
   3750  1.1  mrg   /* Internal subroutine for emitting a runtime error.  */
   3751  1.1  mrg 
   3752  1.1  mrg   add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR, CLASS_IMPURE,
   3753  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_GNU,
   3754  1.1  mrg 	      gfc_check_fe_runtime_error, NULL, gfc_resolve_fe_runtime_error,
   3755  1.1  mrg 	      "msg", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
   3756  1.1  mrg 
   3757  1.1  mrg   make_noreturn ();
   3758  1.1  mrg   make_vararg ();
   3759  1.1  mrg   make_from_module ();
   3760  1.1  mrg 
   3761  1.1  mrg   /* Coarray collectives.  */
   3762  1.1  mrg   add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST, CLASS_IMPURE,
   3763  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3764  1.1  mrg 	      gfc_check_co_broadcast, NULL, NULL,
   3765  1.1  mrg 	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
   3766  1.1  mrg 	      "source_image", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3767  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3768  1.1  mrg 	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3769  1.1  mrg 
   3770  1.1  mrg   add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
   3771  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3772  1.1  mrg 	      gfc_check_co_minmax, NULL, NULL,
   3773  1.1  mrg 	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
   3774  1.1  mrg 	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3775  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3776  1.1  mrg 	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3777  1.1  mrg 
   3778  1.1  mrg   add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
   3779  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3780  1.1  mrg 	      gfc_check_co_minmax, NULL, NULL,
   3781  1.1  mrg 	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
   3782  1.1  mrg 	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3783  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3784  1.1  mrg 	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3785  1.1  mrg 
   3786  1.1  mrg   add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
   3787  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3788  1.1  mrg 	      gfc_check_co_sum, NULL, NULL,
   3789  1.1  mrg 	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
   3790  1.1  mrg 	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3791  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3792  1.1  mrg 	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3793  1.1  mrg 
   3794  1.1  mrg   add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE, CLASS_IMPURE,
   3795  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F2018,
   3796  1.1  mrg 	      gfc_check_co_reduce, NULL, NULL,
   3797  1.1  mrg 	      a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
   3798  1.1  mrg 	      "operation", BT_INTEGER, di, REQUIRED, INTENT_IN,
   3799  1.1  mrg 	      result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
   3800  1.1  mrg 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3801  1.1  mrg 	      errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
   3802  1.1  mrg 
   3803  1.1  mrg 
   3804  1.1  mrg   /* The following subroutine is internally used for coarray libray functions.
   3805  1.1  mrg      "make_from_module" makes it inaccessible for external users.  */
   3806  1.1  mrg   add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
   3807  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
   3808  1.1  mrg 	      "x", BT_REAL, dr, REQUIRED, INTENT_OUT,
   3809  1.1  mrg 	      "y", BT_REAL, dr, REQUIRED, INTENT_IN);
   3810  1.1  mrg   make_from_module();
   3811  1.1  mrg 
   3812  1.1  mrg 
   3813  1.1  mrg   /* More G77 compatibility garbage.  */
   3814  1.1  mrg   add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3815  1.1  mrg 	      gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
   3816  1.1  mrg 	      sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3817  1.1  mrg 	      han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
   3818  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3819  1.1  mrg 
   3820  1.1  mrg   add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
   3821  1.1  mrg 	      di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
   3822  1.1  mrg 	      "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
   3823  1.1  mrg 
   3824  1.1  mrg   add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3825  1.1  mrg 	      gfc_check_exit, NULL, gfc_resolve_exit,
   3826  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
   3827  1.1  mrg 
   3828  1.1  mrg   make_noreturn();
   3829  1.1  mrg 
   3830  1.1  mrg   add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3831  1.1  mrg 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
   3832  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3833  1.1  mrg 	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
   3834  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3835  1.1  mrg 
   3836  1.1  mrg   add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3837  1.1  mrg 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
   3838  1.1  mrg 	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
   3839  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3840  1.1  mrg 
   3841  1.1  mrg   add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3842  1.1  mrg 	      gfc_check_flush, NULL, gfc_resolve_flush,
   3843  1.1  mrg 	      ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
   3844  1.1  mrg 
   3845  1.1  mrg   add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3846  1.1  mrg 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
   3847  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3848  1.1  mrg 	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3849  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3850  1.1  mrg 
   3851  1.1  mrg   add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3852  1.1  mrg 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
   3853  1.1  mrg 	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3854  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3855  1.1  mrg 
   3856  1.1  mrg   add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3857  1.1  mrg 	      gfc_check_free, NULL, NULL,
   3858  1.1  mrg 	      ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
   3859  1.1  mrg 
   3860  1.1  mrg   add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3861  1.1  mrg 	      gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
   3862  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3863  1.1  mrg 	      of, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3864  1.1  mrg 	      whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3865  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3866  1.1  mrg 
   3867  1.1  mrg   add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3868  1.1  mrg 	      gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
   3869  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3870  1.1  mrg 	      of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
   3871  1.1  mrg 
   3872  1.1  mrg   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
   3873  1.1  mrg 	      GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
   3874  1.1  mrg 	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
   3875  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3876  1.1  mrg 
   3877  1.1  mrg   add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3878  1.1  mrg 	      gfc_check_kill_sub, NULL, NULL,
   3879  1.1  mrg 	      pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3880  1.1  mrg 	      sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3881  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3882  1.1  mrg 
   3883  1.1  mrg   add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3884  1.1  mrg 	      gfc_check_link_sub, NULL, gfc_resolve_link_sub,
   3885  1.1  mrg 	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3886  1.1  mrg 	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3887  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3888  1.1  mrg 
   3889  1.1  mrg   add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
   3890  1.1  mrg 	      0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
   3891  1.1  mrg 	      "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
   3892  1.1  mrg 
   3893  1.1  mrg   add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
   3894  1.1  mrg 	      GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
   3895  1.1  mrg 	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3896  1.1  mrg 	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3897  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3898  1.1  mrg 
   3899  1.1  mrg   add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3900  1.1  mrg 	      gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
   3901  1.1  mrg 	      sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
   3902  1.1  mrg 
   3903  1.1  mrg   add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3904  1.1  mrg 	      gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
   3905  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3906  1.1  mrg 	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3907  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3908  1.1  mrg 
   3909  1.1  mrg   add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3910  1.1  mrg 	      gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
   3911  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3912  1.1  mrg 	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3913  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3914  1.1  mrg 
   3915  1.1  mrg   add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3916  1.1  mrg 	      gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
   3917  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3918  1.1  mrg 	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
   3919  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3920  1.1  mrg 
   3921  1.1  mrg   add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
   3922  1.1  mrg 	      GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
   3923  1.1  mrg 	      num, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3924  1.1  mrg 	      han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
   3925  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3926  1.1  mrg 
   3927  1.1  mrg   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
   3928  1.1  mrg 	      GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
   3929  1.1  mrg 	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3930  1.1  mrg 	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3931  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3932  1.1  mrg 
   3933  1.1  mrg   add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
   3934  1.1  mrg 	      0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
   3935  1.1  mrg 	      com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3936  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3937  1.1  mrg 
   3938  1.1  mrg   add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
   3939  1.1  mrg 	      BT_UNKNOWN, 0, GFC_STD_F95,
   3940  1.1  mrg 	      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
   3941  1.1  mrg 	      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3942  1.1  mrg 	      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
   3943  1.1  mrg 	      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3944  1.1  mrg 
   3945  1.1  mrg   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
   3946  1.1  mrg 	      GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
   3947  1.1  mrg 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3948  1.1  mrg 	      name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
   3949  1.1  mrg 
   3950  1.1  mrg   add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
   3951  1.1  mrg 	      gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
   3952  1.1  mrg 	      msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
   3953  1.1  mrg 	      old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3954  1.1  mrg 
   3955  1.1  mrg   add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
   3956  1.1  mrg 	      GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
   3957  1.1  mrg 	      "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
   3958  1.1  mrg 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
   3959  1.1  mrg }
   3960  1.1  mrg 
   3961  1.1  mrg 
   3962  1.1  mrg /* Add a function to the list of conversion symbols.  */
   3963  1.1  mrg 
   3964  1.1  mrg static void
   3965  1.1  mrg add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
   3966  1.1  mrg {
   3967  1.1  mrg   gfc_typespec from, to;
   3968  1.1  mrg   gfc_intrinsic_sym *sym;
   3969  1.1  mrg 
   3970  1.1  mrg   if (sizing == SZ_CONVS)
   3971  1.1  mrg     {
   3972  1.1  mrg       nconv++;
   3973  1.1  mrg       return;
   3974  1.1  mrg     }
   3975  1.1  mrg 
   3976  1.1  mrg   gfc_clear_ts (&from);
   3977  1.1  mrg   from.type = from_type;
   3978  1.1  mrg   from.kind = from_kind;
   3979  1.1  mrg 
   3980  1.1  mrg   gfc_clear_ts (&to);
   3981  1.1  mrg   to.type = to_type;
   3982  1.1  mrg   to.kind = to_kind;
   3983  1.1  mrg 
   3984  1.1  mrg   sym = conversion + nconv;
   3985  1.1  mrg 
   3986  1.1  mrg   sym->name = conv_name (&from, &to);
   3987  1.1  mrg   sym->lib_name = sym->name;
   3988  1.1  mrg   sym->simplify.cc = gfc_convert_constant;
   3989  1.1  mrg   sym->standard = standard;
   3990  1.1  mrg   sym->elemental = 1;
   3991  1.1  mrg   sym->pure = 1;
   3992  1.1  mrg   sym->conversion = 1;
   3993  1.1  mrg   sym->ts = to;
   3994  1.1  mrg   sym->id = GFC_ISYM_CONVERSION;
   3995  1.1  mrg 
   3996  1.1  mrg   nconv++;
   3997  1.1  mrg }
   3998  1.1  mrg 
   3999  1.1  mrg 
   4000  1.1  mrg /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
   4001  1.1  mrg    functions by looping over the kind tables.  */
   4002  1.1  mrg 
   4003  1.1  mrg static void
   4004  1.1  mrg add_conversions (void)
   4005  1.1  mrg {
   4006  1.1  mrg   int i, j;
   4007  1.1  mrg 
   4008  1.1  mrg   /* Integer-Integer conversions.  */
   4009  1.1  mrg   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
   4010  1.1  mrg     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
   4011  1.1  mrg       {
   4012  1.1  mrg 	if (i == j)
   4013  1.1  mrg 	  continue;
   4014  1.1  mrg 
   4015  1.1  mrg 	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
   4016  1.1  mrg 		  BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
   4017  1.1  mrg       }
   4018  1.1  mrg 
   4019  1.1  mrg   /* Integer-Real/Complex conversions.  */
   4020  1.1  mrg   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
   4021  1.1  mrg     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
   4022  1.1  mrg       {
   4023  1.1  mrg 	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
   4024  1.1  mrg 		  BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
   4025  1.1  mrg 
   4026  1.1  mrg 	add_conv (BT_REAL, gfc_real_kinds[j].kind,
   4027  1.1  mrg 		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
   4028  1.1  mrg 
   4029  1.1  mrg 	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
   4030  1.1  mrg 		  BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
   4031  1.1  mrg 
   4032  1.1  mrg 	add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
   4033  1.1  mrg 		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
   4034  1.1  mrg       }
   4035  1.1  mrg 
   4036  1.1  mrg   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
   4037  1.1  mrg     {
   4038  1.1  mrg       /* Hollerith-Integer conversions.  */
   4039  1.1  mrg       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
   4040  1.1  mrg 	add_conv (BT_HOLLERITH, gfc_default_character_kind,
   4041  1.1  mrg 		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
   4042  1.1  mrg       /* Hollerith-Real conversions.  */
   4043  1.1  mrg       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
   4044  1.1  mrg 	add_conv (BT_HOLLERITH, gfc_default_character_kind,
   4045  1.1  mrg 		  BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
   4046  1.1  mrg       /* Hollerith-Complex conversions.  */
   4047  1.1  mrg       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
   4048  1.1  mrg 	add_conv (BT_HOLLERITH, gfc_default_character_kind,
   4049  1.1  mrg 		  BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
   4050  1.1  mrg 
   4051  1.1  mrg       /* Hollerith-Character conversions.  */
   4052  1.1  mrg       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
   4053  1.1  mrg 		  gfc_default_character_kind, GFC_STD_LEGACY);
   4054  1.1  mrg 
   4055  1.1  mrg       /* Hollerith-Logical conversions.  */
   4056  1.1  mrg       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
   4057  1.1  mrg 	add_conv (BT_HOLLERITH, gfc_default_character_kind,
   4058  1.1  mrg 		  BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
   4059  1.1  mrg     }
   4060  1.1  mrg 
   4061  1.1  mrg   /* Real/Complex - Real/Complex conversions.  */
   4062  1.1  mrg   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
   4063  1.1  mrg     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
   4064  1.1  mrg       {
   4065  1.1  mrg 	if (i != j)
   4066  1.1  mrg 	  {
   4067  1.1  mrg 	    add_conv (BT_REAL, gfc_real_kinds[i].kind,
   4068  1.1  mrg 		      BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
   4069  1.1  mrg 
   4070  1.1  mrg 	    add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
   4071  1.1  mrg 		      BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
   4072  1.1  mrg 	  }
   4073  1.1  mrg 
   4074  1.1  mrg 	add_conv (BT_REAL, gfc_real_kinds[i].kind,
   4075  1.1  mrg 		  BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
   4076  1.1  mrg 
   4077  1.1  mrg 	add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
   4078  1.1  mrg 		  BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
   4079  1.1  mrg       }
   4080  1.1  mrg 
   4081  1.1  mrg   /* Logical/Logical kind conversion.  */
   4082  1.1  mrg   for (i = 0; gfc_logical_kinds[i].kind; i++)
   4083  1.1  mrg     for (j = 0; gfc_logical_kinds[j].kind; j++)
   4084  1.1  mrg       {
   4085  1.1  mrg 	if (i == j)
   4086  1.1  mrg 	  continue;
   4087  1.1  mrg 
   4088  1.1  mrg 	add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
   4089  1.1  mrg 		  BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
   4090  1.1  mrg       }
   4091  1.1  mrg 
   4092  1.1  mrg   /* Integer-Logical and Logical-Integer conversions.  */
   4093  1.1  mrg   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
   4094  1.1  mrg     for (i=0; gfc_integer_kinds[i].kind; i++)
   4095  1.1  mrg       for (j=0; gfc_logical_kinds[j].kind; j++)
   4096  1.1  mrg 	{
   4097  1.1  mrg 	  add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
   4098  1.1  mrg 		    BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
   4099  1.1  mrg 	  add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
   4100  1.1  mrg 		    BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
   4101  1.1  mrg 	}
   4102  1.1  mrg 
   4103  1.1  mrg   /* DEC legacy feature allows character conversions similar to Hollerith
   4104  1.1  mrg      conversions - the character data will transferred on a byte by byte
   4105  1.1  mrg      basis.  */
   4106  1.1  mrg   if (flag_dec_char_conversions)
   4107  1.1  mrg     {
   4108  1.1  mrg       /* Character-Integer conversions.  */
   4109  1.1  mrg       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
   4110  1.1  mrg 	add_conv (BT_CHARACTER, gfc_default_character_kind,
   4111  1.1  mrg 		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
   4112  1.1  mrg       /* Character-Real conversions.  */
   4113  1.1  mrg       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
   4114  1.1  mrg 	add_conv (BT_CHARACTER, gfc_default_character_kind,
   4115  1.1  mrg 		  BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
   4116  1.1  mrg       /* Character-Complex conversions.  */
   4117  1.1  mrg       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
   4118  1.1  mrg 	add_conv (BT_CHARACTER, gfc_default_character_kind,
   4119  1.1  mrg 		  BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
   4120  1.1  mrg       /* Character-Logical conversions.  */
   4121  1.1  mrg       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
   4122  1.1  mrg 	add_conv (BT_CHARACTER, gfc_default_character_kind,
   4123  1.1  mrg 		  BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
   4124  1.1  mrg     }
   4125  1.1  mrg }
   4126  1.1  mrg 
   4127  1.1  mrg 
   4128  1.1  mrg static void
   4129  1.1  mrg add_char_conversions (void)
   4130  1.1  mrg {
   4131  1.1  mrg   int n, i, j;
   4132  1.1  mrg 
   4133  1.1  mrg   /* Count possible conversions.  */
   4134  1.1  mrg   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
   4135  1.1  mrg     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
   4136  1.1  mrg       if (i != j)
   4137  1.1  mrg 	ncharconv++;
   4138  1.1  mrg 
   4139  1.1  mrg   /* Allocate memory.  */
   4140  1.1  mrg   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
   4141  1.1  mrg 
   4142  1.1  mrg   /* Add the conversions themselves.  */
   4143  1.1  mrg   n = 0;
   4144  1.1  mrg   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
   4145  1.1  mrg     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
   4146  1.1  mrg       {
   4147  1.1  mrg 	gfc_typespec from, to;
   4148  1.1  mrg 
   4149  1.1  mrg 	if (i == j)
   4150  1.1  mrg 	  continue;
   4151  1.1  mrg 
   4152  1.1  mrg 	gfc_clear_ts (&from);
   4153  1.1  mrg 	from.type = BT_CHARACTER;
   4154  1.1  mrg 	from.kind = gfc_character_kinds[i].kind;
   4155  1.1  mrg 
   4156  1.1  mrg 	gfc_clear_ts (&to);
   4157  1.1  mrg 	to.type = BT_CHARACTER;
   4158  1.1  mrg 	to.kind = gfc_character_kinds[j].kind;
   4159  1.1  mrg 
   4160  1.1  mrg 	char_conversions[n].name = conv_name (&from, &to);
   4161  1.1  mrg 	char_conversions[n].lib_name = char_conversions[n].name;
   4162  1.1  mrg 	char_conversions[n].simplify.cc = gfc_convert_char_constant;
   4163  1.1  mrg 	char_conversions[n].standard = GFC_STD_F2003;
   4164  1.1  mrg 	char_conversions[n].elemental = 1;
   4165  1.1  mrg 	char_conversions[n].pure = 1;
   4166  1.1  mrg 	char_conversions[n].conversion = 0;
   4167  1.1  mrg 	char_conversions[n].ts = to;
   4168  1.1  mrg 	char_conversions[n].id = GFC_ISYM_CONVERSION;
   4169  1.1  mrg 
   4170  1.1  mrg 	n++;
   4171  1.1  mrg       }
   4172  1.1  mrg }
   4173  1.1  mrg 
   4174  1.1  mrg 
   4175  1.1  mrg /* Initialize the table of intrinsics.  */
   4176  1.1  mrg void
   4177  1.1  mrg gfc_intrinsic_init_1 (void)
   4178  1.1  mrg {
   4179  1.1  mrg   nargs = nfunc = nsub = nconv = 0;
   4180  1.1  mrg 
   4181  1.1  mrg   /* Create a namespace to hold the resolved intrinsic symbols.  */
   4182  1.1  mrg   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
   4183  1.1  mrg 
   4184  1.1  mrg   sizing = SZ_FUNCS;
   4185  1.1  mrg   add_functions ();
   4186  1.1  mrg   sizing = SZ_SUBS;
   4187  1.1  mrg   add_subroutines ();
   4188  1.1  mrg   sizing = SZ_CONVS;
   4189  1.1  mrg   add_conversions ();
   4190  1.1  mrg 
   4191  1.1  mrg   functions = XCNEWVAR (struct gfc_intrinsic_sym,
   4192  1.1  mrg 			sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
   4193  1.1  mrg 			+ sizeof (gfc_intrinsic_arg) * nargs);
   4194  1.1  mrg 
   4195  1.1  mrg   next_sym = functions;
   4196  1.1  mrg   subroutines = functions + nfunc;
   4197  1.1  mrg 
   4198  1.1  mrg   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
   4199  1.1  mrg 
   4200  1.1  mrg   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
   4201  1.1  mrg 
   4202  1.1  mrg   sizing = SZ_NOTHING;
   4203  1.1  mrg   nconv = 0;
   4204  1.1  mrg 
   4205  1.1  mrg   add_functions ();
   4206  1.1  mrg   add_subroutines ();
   4207  1.1  mrg   add_conversions ();
   4208  1.1  mrg 
   4209  1.1  mrg   /* Character conversion intrinsics need to be treated separately.  */
   4210  1.1  mrg   add_char_conversions ();
   4211  1.1  mrg }
   4212  1.1  mrg 
   4213  1.1  mrg 
   4214  1.1  mrg void
   4215  1.1  mrg gfc_intrinsic_done_1 (void)
   4216  1.1  mrg {
   4217  1.1  mrg   free (functions);
   4218  1.1  mrg   free (conversion);
   4219  1.1  mrg   free (char_conversions);
   4220  1.1  mrg   gfc_free_namespace (gfc_intrinsic_namespace);
   4221  1.1  mrg }
   4222  1.1  mrg 
   4223  1.1  mrg 
   4224  1.1  mrg /******** Subroutines to check intrinsic interfaces ***********/
   4225  1.1  mrg 
   4226  1.1  mrg /* Given a formal argument list, remove any NULL arguments that may
   4227  1.1  mrg    have been left behind by a sort against some formal argument list.  */
   4228  1.1  mrg 
   4229  1.1  mrg static void
   4230  1.1  mrg remove_nullargs (gfc_actual_arglist **ap)
   4231  1.1  mrg {
   4232  1.1  mrg   gfc_actual_arglist *head, *tail, *next;
   4233  1.1  mrg 
   4234  1.1  mrg   tail = NULL;
   4235  1.1  mrg 
   4236  1.1  mrg   for (head = *ap; head; head = next)
   4237  1.1  mrg     {
   4238  1.1  mrg       next = head->next;
   4239  1.1  mrg 
   4240  1.1  mrg       if (head->expr == NULL && !head->label)
   4241  1.1  mrg 	{
   4242  1.1  mrg 	  head->next = NULL;
   4243  1.1  mrg 	  gfc_free_actual_arglist (head);
   4244  1.1  mrg 	}
   4245  1.1  mrg       else
   4246  1.1  mrg 	{
   4247  1.1  mrg 	  if (tail == NULL)
   4248  1.1  mrg 	    *ap = head;
   4249  1.1  mrg 	  else
   4250  1.1  mrg 	    tail->next = head;
   4251  1.1  mrg 
   4252  1.1  mrg 	  tail = head;
   4253  1.1  mrg 	  tail->next = NULL;
   4254  1.1  mrg 	}
   4255  1.1  mrg     }
   4256  1.1  mrg 
   4257  1.1  mrg   if (tail == NULL)
   4258  1.1  mrg     *ap = NULL;
   4259  1.1  mrg }
   4260  1.1  mrg 
   4261  1.1  mrg 
   4262  1.1  mrg static void
   4263  1.1  mrg set_intrinsic_dummy_arg (gfc_dummy_arg *&dummy_arg,
   4264  1.1  mrg 			 gfc_intrinsic_arg *intrinsic)
   4265  1.1  mrg {
   4266  1.1  mrg   if (dummy_arg == NULL)
   4267  1.1  mrg     dummy_arg = gfc_get_dummy_arg ();
   4268  1.1  mrg 
   4269  1.1  mrg   dummy_arg->intrinsicness = GFC_INTRINSIC_DUMMY_ARG;
   4270  1.1  mrg   dummy_arg->u.intrinsic = intrinsic;
   4271  1.1  mrg }
   4272  1.1  mrg 
   4273  1.1  mrg 
   4274  1.1  mrg /* Given an actual arglist and a formal arglist, sort the actual
   4275  1.1  mrg    arglist so that its arguments are in a one-to-one correspondence
   4276  1.1  mrg    with the format arglist.  Arguments that are not present are given
   4277  1.1  mrg    a blank gfc_actual_arglist structure.  If something is obviously
   4278  1.1  mrg    wrong (say, a missing required argument) we abort sorting and
   4279  1.1  mrg    return false.  */
   4280  1.1  mrg 
   4281  1.1  mrg static bool
   4282  1.1  mrg sort_actual (const char *name, gfc_actual_arglist **ap,
   4283  1.1  mrg 	     gfc_intrinsic_arg *formal, locus *where)
   4284  1.1  mrg {
   4285  1.1  mrg   gfc_actual_arglist *actual, *a;
   4286  1.1  mrg   gfc_intrinsic_arg *f;
   4287  1.1  mrg 
   4288  1.1  mrg   remove_nullargs (ap);
   4289  1.1  mrg   actual = *ap;
   4290  1.1  mrg 
   4291  1.1  mrg   auto_vec<gfc_intrinsic_arg *> dummy_args;
   4292  1.1  mrg   auto_vec<gfc_actual_arglist *> ordered_actual_args;
   4293  1.1  mrg 
   4294  1.1  mrg   for (f = formal; f; f = f->next)
   4295  1.1  mrg     dummy_args.safe_push (f);
   4296  1.1  mrg 
   4297  1.1  mrg   ordered_actual_args.safe_grow_cleared (dummy_args.length (),
   4298  1.1  mrg 					 /* exact = */true);
   4299  1.1  mrg 
   4300  1.1  mrg   f = formal;
   4301  1.1  mrg   a = actual;
   4302  1.1  mrg 
   4303  1.1  mrg   if (f == NULL && a == NULL)	/* No arguments */
   4304  1.1  mrg     return true;
   4305  1.1  mrg 
   4306  1.1  mrg   /* ALLOCATED has two mutually exclusive keywords, but only one
   4307  1.1  mrg      can be present at time and neither is optional. */
   4308  1.1  mrg   if (strcmp (name, "allocated") == 0)
   4309  1.1  mrg     {
   4310  1.1  mrg       if (!a)
   4311  1.1  mrg 	{
   4312  1.1  mrg 	  gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
   4313  1.1  mrg 		     "allocatable entity", where);
   4314  1.1  mrg 	  return false;
   4315  1.1  mrg 	}
   4316  1.1  mrg 
   4317  1.1  mrg       if (a->name)
   4318  1.1  mrg 	{
   4319  1.1  mrg 	  if (strcmp (a->name, "scalar") == 0)
   4320  1.1  mrg 	    {
   4321  1.1  mrg 	      if (a->next)
   4322  1.1  mrg 		goto whoops;
   4323  1.1  mrg 	      if (a->expr->rank != 0)
   4324  1.1  mrg 		{
   4325  1.1  mrg 		  gfc_error ("Scalar entity required at %L", &a->expr->where);
   4326  1.1  mrg 		  return false;
   4327  1.1  mrg 		}
   4328  1.1  mrg 	      return true;
   4329  1.1  mrg 	    }
   4330  1.1  mrg 	  else if (strcmp (a->name, "array") == 0)
   4331  1.1  mrg 	    {
   4332  1.1  mrg 	      if (a->next)
   4333  1.1  mrg 		goto whoops;
   4334  1.1  mrg 	      if (a->expr->rank == 0)
   4335  1.1  mrg 		{
   4336  1.1  mrg 		  gfc_error ("Array entity required at %L", &a->expr->where);
   4337  1.1  mrg 		  return false;
   4338  1.1  mrg 		}
   4339  1.1  mrg 	      return true;
   4340  1.1  mrg 	    }
   4341  1.1  mrg 	  else
   4342  1.1  mrg 	    {
   4343  1.1  mrg 	      gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
   4344  1.1  mrg 			 a->name, name, &a->expr->where);
   4345  1.1  mrg 	      return false;
   4346  1.1  mrg 	    }
   4347  1.1  mrg 	}
   4348  1.1  mrg     }
   4349  1.1  mrg 
   4350  1.1  mrg   for (int i = 0;; i++)
   4351  1.1  mrg     {		/* Put the nonkeyword arguments in a 1:1 correspondence */
   4352  1.1  mrg       if (f == NULL)
   4353  1.1  mrg 	break;
   4354  1.1  mrg       if (a == NULL)
   4355  1.1  mrg 	goto optional;
   4356  1.1  mrg 
   4357  1.1  mrg       if (a->name != NULL)
   4358  1.1  mrg 	goto keywords;
   4359  1.1  mrg 
   4360  1.1  mrg       ordered_actual_args[i] = a;
   4361  1.1  mrg 
   4362  1.1  mrg       f = f->next;
   4363  1.1  mrg       a = a->next;
   4364  1.1  mrg     }
   4365  1.1  mrg 
   4366  1.1  mrg   if (a == NULL)
   4367  1.1  mrg     goto do_sort;
   4368  1.1  mrg 
   4369  1.1  mrg whoops:
   4370  1.1  mrg   gfc_error ("Too many arguments in call to %qs at %L", name, where);
   4371  1.1  mrg   return false;
   4372  1.1  mrg 
   4373  1.1  mrg keywords:
   4374  1.1  mrg   /* Associate the remaining actual arguments, all of which have
   4375  1.1  mrg      to be keyword arguments.  */
   4376  1.1  mrg   for (; a; a = a->next)
   4377  1.1  mrg     {
   4378  1.1  mrg       int idx;
   4379  1.1  mrg       FOR_EACH_VEC_ELT (dummy_args, idx, f)
   4380  1.1  mrg 	if (strcmp (a->name, f->name) == 0)
   4381  1.1  mrg 	  break;
   4382  1.1  mrg 
   4383  1.1  mrg       if (f == NULL)
   4384  1.1  mrg 	{
   4385  1.1  mrg 	  if (a->name[0] == '%')
   4386  1.1  mrg 	    gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
   4387  1.1  mrg 		       "are not allowed in this context at %L", where);
   4388  1.1  mrg 	  else
   4389  1.1  mrg 	    gfc_error ("Cannot find keyword named %qs in call to %qs at %L",
   4390  1.1  mrg 		       a->name, name, where);
   4391  1.1  mrg 	  return false;
   4392  1.1  mrg 	}
   4393  1.1  mrg 
   4394  1.1  mrg       if (ordered_actual_args[idx] != NULL)
   4395  1.1  mrg 	{
   4396  1.1  mrg 	  gfc_error ("Argument %qs appears twice in call to %qs at %L",
   4397  1.1  mrg 		     f->name, name, where);
   4398  1.1  mrg 	  return false;
   4399  1.1  mrg 	}
   4400  1.1  mrg       ordered_actual_args[idx] = a;
   4401  1.1  mrg     }
   4402  1.1  mrg 
   4403  1.1  mrg optional:
   4404  1.1  mrg   /* At this point, all unmatched formal args must be optional.  */
   4405  1.1  mrg   int idx;
   4406  1.1  mrg   FOR_EACH_VEC_ELT (dummy_args, idx, f)
   4407  1.1  mrg     {
   4408  1.1  mrg       if (ordered_actual_args[idx] == NULL && f->optional == 0)
   4409  1.1  mrg 	{
   4410  1.1  mrg 	  gfc_error ("Missing actual argument %qs in call to %qs at %L",
   4411  1.1  mrg 		     f->name, name, where);
   4412  1.1  mrg 	  return false;
   4413  1.1  mrg 	}
   4414  1.1  mrg     }
   4415  1.1  mrg 
   4416  1.1  mrg do_sort:
   4417  1.1  mrg   /* Using the formal argument list, string the actual argument list
   4418  1.1  mrg      together in a way that corresponds with the formal list.  */
   4419  1.1  mrg   actual = NULL;
   4420  1.1  mrg 
   4421  1.1  mrg   FOR_EACH_VEC_ELT (dummy_args, idx, f)
   4422  1.1  mrg     {
   4423  1.1  mrg       a = ordered_actual_args[idx];
   4424  1.1  mrg       if (a && a->label != NULL)
   4425  1.1  mrg 	{
   4426  1.1  mrg 	  gfc_error ("ALTERNATE RETURN not permitted at %L", where);
   4427  1.1  mrg 	  return false;
   4428  1.1  mrg 	}
   4429  1.1  mrg 
   4430  1.1  mrg       if (a == NULL)
   4431  1.1  mrg 	a = gfc_get_actual_arglist ();
   4432  1.1  mrg 
   4433  1.1  mrg       set_intrinsic_dummy_arg (a->associated_dummy, f);
   4434  1.1  mrg 
   4435  1.1  mrg       if (actual == NULL)
   4436  1.1  mrg 	*ap = a;
   4437  1.1  mrg       else
   4438  1.1  mrg 	actual->next = a;
   4439  1.1  mrg 
   4440  1.1  mrg       actual = a;
   4441  1.1  mrg     }
   4442  1.1  mrg   actual->next = NULL;		/* End the sorted argument list.  */
   4443  1.1  mrg 
   4444  1.1  mrg   return true;
   4445  1.1  mrg }
   4446  1.1  mrg 
   4447  1.1  mrg 
   4448  1.1  mrg /* Compare an actual argument list with an intrinsic's formal argument
   4449  1.1  mrg    list.  The lists are checked for agreement of type.  We don't check
   4450  1.1  mrg    for arrayness here.  */
   4451  1.1  mrg 
   4452  1.1  mrg static bool
   4453  1.1  mrg check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
   4454  1.1  mrg 	       int error_flag)
   4455  1.1  mrg {
   4456  1.1  mrg   gfc_actual_arglist *actual;
   4457  1.1  mrg   gfc_intrinsic_arg *formal;
   4458  1.1  mrg   int i;
   4459  1.1  mrg 
   4460  1.1  mrg   formal = sym->formal;
   4461  1.1  mrg   actual = *ap;
   4462  1.1  mrg 
   4463  1.1  mrg   i = 0;
   4464  1.1  mrg   for (; formal; formal = formal->next, actual = actual->next, i++)
   4465  1.1  mrg     {
   4466  1.1  mrg       gfc_typespec ts;
   4467  1.1  mrg 
   4468  1.1  mrg       if (actual->expr == NULL)
   4469  1.1  mrg 	continue;
   4470  1.1  mrg 
   4471  1.1  mrg       ts = formal->ts;
   4472  1.1  mrg 
   4473  1.1  mrg       /* A kind of 0 means we don't check for kind.  */
   4474  1.1  mrg       if (ts.kind == 0)
   4475  1.1  mrg 	ts.kind = actual->expr->ts.kind;
   4476  1.1  mrg 
   4477  1.1  mrg       if (!gfc_compare_types (&ts, &actual->expr->ts))
   4478  1.1  mrg 	{
   4479  1.1  mrg 	  if (error_flag)
   4480  1.1  mrg 	    gfc_error ("In call to %qs at %L, type mismatch in argument "
   4481  1.1  mrg 		       "%qs; pass %qs to %qs", gfc_current_intrinsic,
   4482  1.1  mrg 		       &actual->expr->where,
   4483  1.1  mrg 		       gfc_current_intrinsic_arg[i]->name,
   4484  1.1  mrg 		       gfc_typename (actual->expr),
   4485  1.1  mrg 		       gfc_dummy_typename (&formal->ts));
   4486  1.1  mrg 	  return false;
   4487  1.1  mrg 	}
   4488  1.1  mrg 
   4489  1.1  mrg       /* F2018, p. 328: An argument to an intrinsic procedure other than
   4490  1.1  mrg 	 ASSOCIATED, NULL, or PRESENT shall be a data object.  An EXPR_NULL
   4491  1.1  mrg 	 is not a data object.  */
   4492  1.1  mrg       if (actual->expr->expr_type == EXPR_NULL
   4493  1.1  mrg 	  && (!(sym->id == GFC_ISYM_ASSOCIATED
   4494  1.1  mrg 		|| sym->id == GFC_ISYM_NULL
   4495  1.1  mrg 		|| sym->id == GFC_ISYM_PRESENT)))
   4496  1.1  mrg 	{
   4497  1.1  mrg 	  gfc_invalid_null_arg (actual->expr);
   4498  1.1  mrg 	  return false;
   4499  1.1  mrg 	}
   4500  1.1  mrg 
   4501  1.1  mrg       /* If the formal argument is INTENT([IN]OUT), check for definability.  */
   4502  1.1  mrg       if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
   4503  1.1  mrg 	{
   4504  1.1  mrg 	  const char* context = (error_flag
   4505  1.1  mrg 				 ? _("actual argument to INTENT = OUT/INOUT")
   4506  1.1  mrg 				 : NULL);
   4507  1.1  mrg 
   4508  1.1  mrg 	  /* No pointer arguments for intrinsics.  */
   4509  1.1  mrg 	  if (!gfc_check_vardef_context (actual->expr, false, false, false, context))
   4510  1.1  mrg 	    return false;
   4511  1.1  mrg 	}
   4512  1.1  mrg     }
   4513  1.1  mrg 
   4514  1.1  mrg   return true;
   4515  1.1  mrg }
   4516  1.1  mrg 
   4517  1.1  mrg 
   4518  1.1  mrg /* Given a pointer to an intrinsic symbol and an expression node that
   4519  1.1  mrg    represent the function call to that subroutine, figure out the type
   4520  1.1  mrg    of the result.  This may involve calling a resolution subroutine.  */
   4521  1.1  mrg 
   4522  1.1  mrg static void
   4523  1.1  mrg resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
   4524  1.1  mrg {
   4525  1.1  mrg   gfc_expr *a1, *a2, *a3, *a4, *a5, *a6;
   4526  1.1  mrg   gfc_actual_arglist *arg;
   4527  1.1  mrg 
   4528  1.1  mrg   if (specific->resolve.f1 == NULL)
   4529  1.1  mrg     {
   4530  1.1  mrg       if (e->value.function.name == NULL)
   4531  1.1  mrg 	e->value.function.name = specific->lib_name;
   4532  1.1  mrg 
   4533  1.1  mrg       if (e->ts.type == BT_UNKNOWN)
   4534  1.1  mrg 	e->ts = specific->ts;
   4535  1.1  mrg       return;
   4536  1.1  mrg     }
   4537  1.1  mrg 
   4538  1.1  mrg   arg = e->value.function.actual;
   4539  1.1  mrg 
   4540  1.1  mrg   /* Special case hacks for MIN and MAX.  */
   4541  1.1  mrg   if (specific->resolve.f1m == gfc_resolve_max
   4542  1.1  mrg       || specific->resolve.f1m == gfc_resolve_min)
   4543  1.1  mrg     {
   4544  1.1  mrg       (*specific->resolve.f1m) (e, arg);
   4545  1.1  mrg       return;
   4546  1.1  mrg     }
   4547  1.1  mrg 
   4548  1.1  mrg   if (arg == NULL)
   4549  1.1  mrg     {
   4550  1.1  mrg       (*specific->resolve.f0) (e);
   4551  1.1  mrg       return;
   4552  1.1  mrg     }
   4553  1.1  mrg 
   4554  1.1  mrg   a1 = arg->expr;
   4555  1.1  mrg   arg = arg->next;
   4556  1.1  mrg 
   4557  1.1  mrg   if (arg == NULL)
   4558  1.1  mrg     {
   4559  1.1  mrg       (*specific->resolve.f1) (e, a1);
   4560  1.1  mrg       return;
   4561  1.1  mrg     }
   4562  1.1  mrg 
   4563  1.1  mrg   a2 = arg->expr;
   4564  1.1  mrg   arg = arg->next;
   4565  1.1  mrg 
   4566  1.1  mrg   if (arg == NULL)
   4567  1.1  mrg     {
   4568  1.1  mrg       (*specific->resolve.f2) (e, a1, a2);
   4569  1.1  mrg       return;
   4570  1.1  mrg     }
   4571  1.1  mrg 
   4572  1.1  mrg   a3 = arg->expr;
   4573  1.1  mrg   arg = arg->next;
   4574  1.1  mrg 
   4575  1.1  mrg   if (arg == NULL)
   4576  1.1  mrg     {
   4577  1.1  mrg       (*specific->resolve.f3) (e, a1, a2, a3);
   4578  1.1  mrg       return;
   4579  1.1  mrg     }
   4580  1.1  mrg 
   4581  1.1  mrg   a4 = arg->expr;
   4582  1.1  mrg   arg = arg->next;
   4583  1.1  mrg 
   4584  1.1  mrg   if (arg == NULL)
   4585  1.1  mrg     {
   4586  1.1  mrg       (*specific->resolve.f4) (e, a1, a2, a3, a4);
   4587  1.1  mrg       return;
   4588  1.1  mrg     }
   4589  1.1  mrg 
   4590  1.1  mrg   a5 = arg->expr;
   4591  1.1  mrg   arg = arg->next;
   4592  1.1  mrg 
   4593  1.1  mrg   if (arg == NULL)
   4594  1.1  mrg     {
   4595  1.1  mrg       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
   4596  1.1  mrg       return;
   4597  1.1  mrg     }
   4598  1.1  mrg 
   4599  1.1  mrg   a6 = arg->expr;
   4600  1.1  mrg   arg = arg->next;
   4601  1.1  mrg 
   4602  1.1  mrg   if (arg == NULL)
   4603  1.1  mrg     {
   4604  1.1  mrg       (*specific->resolve.f6) (e, a1, a2, a3, a4, a5, a6);
   4605  1.1  mrg       return;
   4606  1.1  mrg     }
   4607  1.1  mrg 
   4608  1.1  mrg   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
   4609  1.1  mrg }
   4610  1.1  mrg 
   4611  1.1  mrg 
   4612  1.1  mrg /* Given an intrinsic symbol node and an expression node, call the
   4613  1.1  mrg    simplification function (if there is one), perhaps replacing the
   4614  1.1  mrg    expression with something simpler.  We return false on an error
   4615  1.1  mrg    of the simplification, true if the simplification worked, even
   4616  1.1  mrg    if nothing has changed in the expression itself.  */
   4617  1.1  mrg 
   4618  1.1  mrg static bool
   4619  1.1  mrg do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
   4620  1.1  mrg {
   4621  1.1  mrg   gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
   4622  1.1  mrg   gfc_actual_arglist *arg;
   4623  1.1  mrg 
   4624  1.1  mrg   /* Max and min require special handling due to the variable number
   4625  1.1  mrg      of args.  */
   4626  1.1  mrg   if (specific->simplify.f1 == gfc_simplify_min)
   4627  1.1  mrg     {
   4628  1.1  mrg       result = gfc_simplify_min (e);
   4629  1.1  mrg       goto finish;
   4630  1.1  mrg     }
   4631  1.1  mrg 
   4632  1.1  mrg   if (specific->simplify.f1 == gfc_simplify_max)
   4633  1.1  mrg     {
   4634  1.1  mrg       result = gfc_simplify_max (e);
   4635  1.1  mrg       goto finish;
   4636  1.1  mrg     }
   4637  1.1  mrg 
   4638  1.1  mrg   if (specific->simplify.f1 == NULL)
   4639  1.1  mrg     {
   4640  1.1  mrg       result = NULL;
   4641  1.1  mrg       goto finish;
   4642  1.1  mrg     }
   4643  1.1  mrg 
   4644  1.1  mrg   arg = e->value.function.actual;
   4645  1.1  mrg 
   4646  1.1  mrg   if (arg == NULL)
   4647  1.1  mrg     {
   4648  1.1  mrg       result = (*specific->simplify.f0) ();
   4649  1.1  mrg       goto finish;
   4650  1.1  mrg     }
   4651  1.1  mrg 
   4652  1.1  mrg   a1 = arg->expr;
   4653  1.1  mrg   arg = arg->next;
   4654  1.1  mrg 
   4655  1.1  mrg   if (specific->simplify.cc == gfc_convert_constant
   4656  1.1  mrg       || specific->simplify.cc == gfc_convert_char_constant)
   4657  1.1  mrg     {
   4658  1.1  mrg       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
   4659  1.1  mrg       goto finish;
   4660  1.1  mrg     }
   4661  1.1  mrg 
   4662  1.1  mrg   if (arg == NULL)
   4663  1.1  mrg     result = (*specific->simplify.f1) (a1);
   4664  1.1  mrg   else
   4665  1.1  mrg     {
   4666  1.1  mrg       a2 = arg->expr;
   4667  1.1  mrg       arg = arg->next;
   4668  1.1  mrg 
   4669  1.1  mrg       if (arg == NULL)
   4670  1.1  mrg 	result = (*specific->simplify.f2) (a1, a2);
   4671  1.1  mrg       else
   4672  1.1  mrg 	{
   4673  1.1  mrg 	  a3 = arg->expr;
   4674  1.1  mrg 	  arg = arg->next;
   4675  1.1  mrg 
   4676  1.1  mrg 	  if (arg == NULL)
   4677  1.1  mrg 	    result = (*specific->simplify.f3) (a1, a2, a3);
   4678  1.1  mrg 	  else
   4679  1.1  mrg 	    {
   4680  1.1  mrg 	      a4 = arg->expr;
   4681  1.1  mrg 	      arg = arg->next;
   4682  1.1  mrg 
   4683  1.1  mrg 	      if (arg == NULL)
   4684  1.1  mrg 		result = (*specific->simplify.f4) (a1, a2, a3, a4);
   4685  1.1  mrg 	      else
   4686  1.1  mrg 		{
   4687  1.1  mrg 		  a5 = arg->expr;
   4688  1.1  mrg 		  arg = arg->next;
   4689  1.1  mrg 
   4690  1.1  mrg 		  if (arg == NULL)
   4691  1.1  mrg 		    result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
   4692  1.1  mrg 		  else
   4693  1.1  mrg 		    {
   4694  1.1  mrg 		      a6 = arg->expr;
   4695  1.1  mrg 		      arg = arg->next;
   4696  1.1  mrg 
   4697  1.1  mrg 		      if (arg == NULL)
   4698  1.1  mrg 			result = (*specific->simplify.f6)
   4699  1.1  mrg 		       			(a1, a2, a3, a4, a5, a6);
   4700  1.1  mrg 		      else
   4701  1.1  mrg 			gfc_internal_error
   4702  1.1  mrg 			  ("do_simplify(): Too many args for intrinsic");
   4703  1.1  mrg 		    }
   4704  1.1  mrg 		}
   4705  1.1  mrg 	    }
   4706  1.1  mrg 	}
   4707  1.1  mrg     }
   4708  1.1  mrg 
   4709  1.1  mrg finish:
   4710  1.1  mrg   if (result == &gfc_bad_expr)
   4711  1.1  mrg     return false;
   4712  1.1  mrg 
   4713  1.1  mrg   if (result == NULL)
   4714  1.1  mrg     resolve_intrinsic (specific, e);	/* Must call at run-time */
   4715  1.1  mrg   else
   4716  1.1  mrg     {
   4717  1.1  mrg       result->where = e->where;
   4718  1.1  mrg       gfc_replace_expr (e, result);
   4719  1.1  mrg     }
   4720  1.1  mrg 
   4721  1.1  mrg   return true;
   4722  1.1  mrg }
   4723  1.1  mrg 
   4724  1.1  mrg 
   4725  1.1  mrg /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
   4726  1.1  mrg    error messages.  This subroutine returns false if a subroutine
   4727  1.1  mrg    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
   4728  1.1  mrg    list cannot match any intrinsic.  */
   4729  1.1  mrg 
   4730  1.1  mrg static void
   4731  1.1  mrg init_arglist (gfc_intrinsic_sym *isym)
   4732  1.1  mrg {
   4733  1.1  mrg   gfc_intrinsic_arg *formal;
   4734  1.1  mrg   int i;
   4735  1.1  mrg 
   4736  1.1  mrg   gfc_current_intrinsic = isym->name;
   4737  1.1  mrg 
   4738  1.1  mrg   i = 0;
   4739  1.1  mrg   for (formal = isym->formal; formal; formal = formal->next)
   4740  1.1  mrg     {
   4741  1.1  mrg       if (i >= MAX_INTRINSIC_ARGS)
   4742  1.1  mrg 	gfc_internal_error ("init_arglist(): too many arguments");
   4743  1.1  mrg       gfc_current_intrinsic_arg[i++] = formal;
   4744  1.1  mrg     }
   4745  1.1  mrg }
   4746  1.1  mrg 
   4747  1.1  mrg 
   4748  1.1  mrg /* Given a pointer to an intrinsic symbol and an expression consisting
   4749  1.1  mrg    of a function call, see if the function call is consistent with the
   4750  1.1  mrg    intrinsic's formal argument list.  Return true if the expression
   4751  1.1  mrg    and intrinsic match, false otherwise.  */
   4752  1.1  mrg 
   4753  1.1  mrg static bool
   4754  1.1  mrg check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
   4755  1.1  mrg {
   4756  1.1  mrg   gfc_actual_arglist *arg, **ap;
   4757  1.1  mrg   bool t;
   4758  1.1  mrg 
   4759  1.1  mrg   ap = &expr->value.function.actual;
   4760  1.1  mrg 
   4761  1.1  mrg   init_arglist (specific);
   4762  1.1  mrg 
   4763  1.1  mrg   /* Don't attempt to sort the argument list for min or max.  */
   4764  1.1  mrg   if (specific->check.f1m == gfc_check_min_max
   4765  1.1  mrg       || specific->check.f1m == gfc_check_min_max_integer
   4766  1.1  mrg       || specific->check.f1m == gfc_check_min_max_real
   4767  1.1  mrg       || specific->check.f1m == gfc_check_min_max_double)
   4768  1.1  mrg     {
   4769  1.1  mrg       if (!do_ts29113_check (specific, *ap))
   4770  1.1  mrg 	return false;
   4771  1.1  mrg       return (*specific->check.f1m) (*ap);
   4772  1.1  mrg     }
   4773  1.1  mrg 
   4774  1.1  mrg   if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
   4775  1.1  mrg     return false;
   4776  1.1  mrg 
   4777  1.1  mrg   if (!do_ts29113_check (specific, *ap))
   4778  1.1  mrg     return false;
   4779  1.1  mrg 
   4780  1.1  mrg   if (specific->check.f5ml == gfc_check_minloc_maxloc)
   4781  1.1  mrg     /* This is special because we might have to reorder the argument list.  */
   4782  1.1  mrg     t = gfc_check_minloc_maxloc (*ap);
   4783  1.1  mrg   else if (specific->check.f6fl == gfc_check_findloc)
   4784  1.1  mrg     t = gfc_check_findloc (*ap);
   4785  1.1  mrg   else if (specific->check.f3red == gfc_check_minval_maxval)
   4786  1.1  mrg     /* This is also special because we also might have to reorder the
   4787  1.1  mrg        argument list.  */
   4788  1.1  mrg     t = gfc_check_minval_maxval (*ap);
   4789  1.1  mrg   else if (specific->check.f3red == gfc_check_product_sum)
   4790  1.1  mrg     /* Same here. The difference to the previous case is that we allow a
   4791  1.1  mrg        general numeric type.  */
   4792  1.1  mrg     t = gfc_check_product_sum (*ap);
   4793  1.1  mrg   else if (specific->check.f3red == gfc_check_transf_bit_intrins)
   4794  1.1  mrg     /* Same as for PRODUCT and SUM, but different checks.  */
   4795  1.1  mrg     t = gfc_check_transf_bit_intrins (*ap);
   4796  1.1  mrg   else
   4797  1.1  mrg      {
   4798  1.1  mrg        if (specific->check.f1 == NULL)
   4799  1.1  mrg 	 {
   4800  1.1  mrg 	   t = check_arglist (ap, specific, error_flag);
   4801  1.1  mrg 	   if (t)
   4802  1.1  mrg 	     expr->ts = specific->ts;
   4803  1.1  mrg 	 }
   4804  1.1  mrg        else
   4805  1.1  mrg 	 t = do_check (specific, *ap);
   4806  1.1  mrg      }
   4807  1.1  mrg 
   4808  1.1  mrg   /* Check conformance of elemental intrinsics.  */
   4809  1.1  mrg   if (t && specific->elemental)
   4810  1.1  mrg     {
   4811  1.1  mrg       int n = 0;
   4812  1.1  mrg       gfc_expr *first_expr;
   4813  1.1  mrg       arg = expr->value.function.actual;
   4814  1.1  mrg 
   4815  1.1  mrg       /* There is no elemental intrinsic without arguments.  */
   4816  1.1  mrg       gcc_assert(arg != NULL);
   4817  1.1  mrg       first_expr = arg->expr;
   4818  1.1  mrg 
   4819  1.1  mrg       for ( ; arg && arg->expr; arg = arg->next, n++)
   4820  1.1  mrg 	if (!gfc_check_conformance (first_expr, arg->expr,
   4821  1.1  mrg 				    _("arguments '%s' and '%s' for "
   4822  1.1  mrg 				    "intrinsic '%s'"),
   4823  1.1  mrg 				    gfc_current_intrinsic_arg[0]->name,
   4824  1.1  mrg 				    gfc_current_intrinsic_arg[n]->name,
   4825  1.1  mrg 				    gfc_current_intrinsic))
   4826  1.1  mrg 	  return false;
   4827  1.1  mrg     }
   4828  1.1  mrg 
   4829  1.1  mrg   if (!t)
   4830  1.1  mrg     remove_nullargs (ap);
   4831  1.1  mrg 
   4832  1.1  mrg   return t;
   4833  1.1  mrg }
   4834  1.1  mrg 
   4835  1.1  mrg 
   4836  1.1  mrg /* Check whether an intrinsic belongs to whatever standard the user
   4837  1.1  mrg    has chosen, taking also into account -fall-intrinsics.  Here, no
   4838  1.1  mrg    warning/error is emitted; but if symstd is not NULL, it is pointed to a
   4839  1.1  mrg    textual representation of the symbols standard status (like
   4840  1.1  mrg    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
   4841  1.1  mrg    can be used to construct a detailed warning/error message in case of
   4842  1.1  mrg    a false.  */
   4843  1.1  mrg 
   4844  1.1  mrg bool
   4845  1.1  mrg gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
   4846  1.1  mrg 			      const char** symstd, bool silent, locus where)
   4847  1.1  mrg {
   4848  1.1  mrg   const char* symstd_msg;
   4849  1.1  mrg 
   4850  1.1  mrg   /* For -fall-intrinsics, just succeed.  */
   4851  1.1  mrg   if (flag_all_intrinsics)
   4852  1.1  mrg     return true;
   4853  1.1  mrg 
   4854  1.1  mrg   /* Find the symbol's standard message for later usage.  */
   4855  1.1  mrg   switch (isym->standard)
   4856  1.1  mrg     {
   4857  1.1  mrg     case GFC_STD_F77:
   4858  1.1  mrg       symstd_msg = _("available since Fortran 77");
   4859  1.1  mrg       break;
   4860  1.1  mrg 
   4861  1.1  mrg     case GFC_STD_F95_OBS:
   4862  1.1  mrg       symstd_msg = _("obsolescent in Fortran 95");
   4863  1.1  mrg       break;
   4864  1.1  mrg 
   4865  1.1  mrg     case GFC_STD_F95_DEL:
   4866  1.1  mrg       symstd_msg = _("deleted in Fortran 95");
   4867  1.1  mrg       break;
   4868  1.1  mrg 
   4869  1.1  mrg     case GFC_STD_F95:
   4870  1.1  mrg       symstd_msg = _("new in Fortran 95");
   4871  1.1  mrg       break;
   4872  1.1  mrg 
   4873  1.1  mrg     case GFC_STD_F2003:
   4874  1.1  mrg       symstd_msg = _("new in Fortran 2003");
   4875  1.1  mrg       break;
   4876  1.1  mrg 
   4877  1.1  mrg     case GFC_STD_F2008:
   4878  1.1  mrg       symstd_msg = _("new in Fortran 2008");
   4879  1.1  mrg       break;
   4880  1.1  mrg 
   4881  1.1  mrg     case GFC_STD_F2018:
   4882  1.1  mrg       symstd_msg = _("new in Fortran 2018");
   4883  1.1  mrg       break;
   4884  1.1  mrg 
   4885  1.1  mrg     case GFC_STD_GNU:
   4886  1.1  mrg       symstd_msg = _("a GNU Fortran extension");
   4887  1.1  mrg       break;
   4888  1.1  mrg 
   4889  1.1  mrg     case GFC_STD_LEGACY:
   4890  1.1  mrg       symstd_msg = _("for backward compatibility");
   4891  1.1  mrg       break;
   4892  1.1  mrg 
   4893  1.1  mrg     default:
   4894  1.1  mrg       gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
   4895  1.1  mrg 			  isym->name, isym->standard);
   4896  1.1  mrg     }
   4897  1.1  mrg 
   4898  1.1  mrg   /* If warning about the standard, warn and succeed.  */
   4899  1.1  mrg   if (gfc_option.warn_std & isym->standard)
   4900  1.1  mrg     {
   4901  1.1  mrg       /* Do only print a warning if not a GNU extension.  */
   4902  1.1  mrg       if (!silent && isym->standard != GFC_STD_GNU)
   4903  1.1  mrg 	gfc_warning (0, "Intrinsic %qs (%s) used at %L",
   4904  1.1  mrg 		     isym->name, symstd_msg, &where);
   4905  1.1  mrg 
   4906  1.1  mrg       return true;
   4907  1.1  mrg     }
   4908  1.1  mrg 
   4909  1.1  mrg   /* If allowing the symbol's standard, succeed, too.  */
   4910  1.1  mrg   if (gfc_option.allow_std & isym->standard)
   4911  1.1  mrg     return true;
   4912  1.1  mrg 
   4913  1.1  mrg   /* Otherwise, fail.  */
   4914  1.1  mrg   if (symstd)
   4915  1.1  mrg     *symstd = symstd_msg;
   4916  1.1  mrg   return false;
   4917  1.1  mrg }
   4918  1.1  mrg 
   4919  1.1  mrg 
   4920  1.1  mrg /* See if a function call corresponds to an intrinsic function call.
   4921  1.1  mrg    We return:
   4922  1.1  mrg 
   4923  1.1  mrg     MATCH_YES    if the call corresponds to an intrinsic, simplification
   4924  1.1  mrg 		 is done if possible.
   4925  1.1  mrg 
   4926  1.1  mrg     MATCH_NO     if the call does not correspond to an intrinsic
   4927  1.1  mrg 
   4928  1.1  mrg     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
   4929  1.1  mrg 		 error during the simplification process.
   4930  1.1  mrg 
   4931  1.1  mrg    The error_flag parameter enables an error reporting.  */
   4932  1.1  mrg 
   4933  1.1  mrg match
   4934  1.1  mrg gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
   4935  1.1  mrg {
   4936  1.1  mrg   gfc_symbol *sym;
   4937  1.1  mrg   gfc_intrinsic_sym *isym, *specific;
   4938  1.1  mrg   gfc_actual_arglist *actual;
   4939  1.1  mrg   int flag;
   4940  1.1  mrg 
   4941  1.1  mrg   if (expr->value.function.isym != NULL)
   4942  1.1  mrg     return (!do_simplify(expr->value.function.isym, expr))
   4943  1.1  mrg 	   ? MATCH_ERROR : MATCH_YES;
   4944  1.1  mrg 
   4945  1.1  mrg   if (!error_flag)
   4946  1.1  mrg     gfc_push_suppress_errors ();
   4947  1.1  mrg   flag = 0;
   4948  1.1  mrg 
   4949  1.1  mrg   for (actual = expr->value.function.actual; actual; actual = actual->next)
   4950  1.1  mrg     if (actual->expr != NULL)
   4951  1.1  mrg       flag |= (actual->expr->ts.type != BT_INTEGER
   4952  1.1  mrg 	       && actual->expr->ts.type != BT_CHARACTER);
   4953  1.1  mrg 
   4954  1.1  mrg   sym = expr->symtree->n.sym;
   4955  1.1  mrg 
   4956  1.1  mrg   if (sym->intmod_sym_id)
   4957  1.1  mrg     {
   4958  1.1  mrg       gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
   4959  1.1  mrg       isym = specific = gfc_intrinsic_function_by_id (id);
   4960  1.1  mrg     }
   4961  1.1  mrg   else
   4962  1.1  mrg     isym = specific = gfc_find_function (sym->name);
   4963  1.1  mrg 
   4964  1.1  mrg   if (isym == NULL)
   4965  1.1  mrg     {
   4966  1.1  mrg       if (!error_flag)
   4967  1.1  mrg 	gfc_pop_suppress_errors ();
   4968  1.1  mrg       return MATCH_NO;
   4969  1.1  mrg     }
   4970  1.1  mrg 
   4971  1.1  mrg   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
   4972  1.1  mrg        || isym->id == GFC_ISYM_CMPLX || isym->id == GFC_ISYM_FLOAT
   4973  1.1  mrg        || isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
   4974  1.1  mrg       && gfc_init_expr_flag
   4975  1.1  mrg       && !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
   4976  1.1  mrg 			  "expression at %L", sym->name, &expr->where))
   4977  1.1  mrg     {
   4978  1.1  mrg       if (!error_flag)
   4979  1.1  mrg 	gfc_pop_suppress_errors ();
   4980  1.1  mrg       return MATCH_ERROR;
   4981  1.1  mrg     }
   4982  1.1  mrg 
   4983  1.1  mrg   /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
   4984  1.1  mrg      SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
   4985  1.1  mrg      initialization expressions.  */
   4986  1.1  mrg 
   4987  1.1  mrg   if (gfc_init_expr_flag && isym->transformational)
   4988  1.1  mrg     {
   4989  1.1  mrg       gfc_isym_id id = isym->id;
   4990  1.1  mrg       if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE
   4991  1.1  mrg 	  && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND
   4992  1.1  mrg 	  && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
   4993  1.1  mrg 	  && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
   4994  1.1  mrg 			      "at %L is invalid in an initialization "
   4995  1.1  mrg 			      "expression", sym->name, &expr->where))
   4996  1.1  mrg 	{
   4997  1.1  mrg 	  if (!error_flag)
   4998  1.1  mrg 	    gfc_pop_suppress_errors ();
   4999  1.1  mrg 
   5000  1.1  mrg 	  return MATCH_ERROR;
   5001  1.1  mrg 	}
   5002  1.1  mrg     }
   5003  1.1  mrg 
   5004  1.1  mrg   gfc_current_intrinsic_where = &expr->where;
   5005  1.1  mrg 
   5006  1.1  mrg   /* Bypass the generic list for min, max and ISO_C_Binding's c_loc.  */
   5007  1.1  mrg   if (isym->check.f1m == gfc_check_min_max)
   5008  1.1  mrg     {
   5009  1.1  mrg       init_arglist (isym);
   5010  1.1  mrg 
   5011  1.1  mrg       if (isym->check.f1m(expr->value.function.actual))
   5012  1.1  mrg 	goto got_specific;
   5013  1.1  mrg 
   5014  1.1  mrg       if (!error_flag)
   5015  1.1  mrg 	gfc_pop_suppress_errors ();
   5016  1.1  mrg       return MATCH_NO;
   5017  1.1  mrg     }
   5018  1.1  mrg 
   5019  1.1  mrg   /* If the function is generic, check all of its specific
   5020  1.1  mrg      incarnations.  If the generic name is also a specific, we check
   5021  1.1  mrg      that name last, so that any error message will correspond to the
   5022  1.1  mrg      specific.  */
   5023  1.1  mrg   gfc_push_suppress_errors ();
   5024  1.1  mrg 
   5025  1.1  mrg   if (isym->generic)
   5026  1.1  mrg     {
   5027  1.1  mrg       for (specific = isym->specific_head; specific;
   5028  1.1  mrg 	   specific = specific->next)
   5029  1.1  mrg 	{
   5030  1.1  mrg 	  if (specific == isym)
   5031  1.1  mrg 	    continue;
   5032  1.1  mrg 	  if (check_specific (specific, expr, 0))
   5033  1.1  mrg 	    {
   5034  1.1  mrg 	      gfc_pop_suppress_errors ();
   5035  1.1  mrg 	      goto got_specific;
   5036  1.1  mrg 	    }
   5037  1.1  mrg 	}
   5038  1.1  mrg     }
   5039  1.1  mrg 
   5040  1.1  mrg   gfc_pop_suppress_errors ();
   5041  1.1  mrg 
   5042  1.1  mrg   if (!check_specific (isym, expr, error_flag))
   5043  1.1  mrg     {
   5044  1.1  mrg       if (!error_flag)
   5045  1.1  mrg 	gfc_pop_suppress_errors ();
   5046  1.1  mrg       return MATCH_NO;
   5047  1.1  mrg     }
   5048  1.1  mrg 
   5049  1.1  mrg   specific = isym;
   5050  1.1  mrg 
   5051  1.1  mrg got_specific:
   5052  1.1  mrg   expr->value.function.isym = specific;
   5053  1.1  mrg   if (!error_flag)
   5054  1.1  mrg     gfc_pop_suppress_errors ();
   5055  1.1  mrg 
   5056  1.1  mrg   if (!do_simplify (specific, expr))
   5057  1.1  mrg     return MATCH_ERROR;
   5058  1.1  mrg 
   5059  1.1  mrg   /* F95, 7.1.6.1, Initialization expressions
   5060  1.1  mrg      (4) An elemental intrinsic function reference of type integer or
   5061  1.1  mrg          character where each argument is an initialization expression
   5062  1.1  mrg          of type integer or character
   5063  1.1  mrg 
   5064  1.1  mrg      F2003, 7.1.7 Initialization expression
   5065  1.1  mrg      (4)   A reference to an elemental standard intrinsic function,
   5066  1.1  mrg            where each argument is an initialization expression  */
   5067  1.1  mrg 
   5068  1.1  mrg   if (gfc_init_expr_flag && isym->elemental && flag
   5069  1.1  mrg       && !gfc_notify_std (GFC_STD_F2003, "Elemental function as "
   5070  1.1  mrg 			  "initialization expression with non-integer/non-"
   5071  1.1  mrg 			  "character arguments at %L", &expr->where))
   5072  1.1  mrg     return MATCH_ERROR;
   5073  1.1  mrg 
   5074  1.1  mrg   if (sym->attr.flavor == FL_UNKNOWN)
   5075  1.1  mrg     {
   5076  1.1  mrg       sym->attr.function = 1;
   5077  1.1  mrg       sym->attr.intrinsic = 1;
   5078  1.1  mrg       sym->attr.flavor = FL_PROCEDURE;
   5079  1.1  mrg     }
   5080  1.1  mrg   if (sym->attr.flavor == FL_PROCEDURE)
   5081  1.1  mrg     {
   5082  1.1  mrg       sym->attr.function = 1;
   5083  1.1  mrg       sym->attr.proc = PROC_INTRINSIC;
   5084  1.1  mrg     }
   5085  1.1  mrg 
   5086  1.1  mrg   if (!sym->module)
   5087  1.1  mrg     gfc_intrinsic_symbol (sym);
   5088  1.1  mrg 
   5089  1.1  mrg   /* Have another stab at simplification since elemental intrinsics with array
   5090  1.1  mrg      actual arguments would be missed by the calls above to do_simplify.  */
   5091  1.1  mrg   if (isym->elemental)
   5092  1.1  mrg     gfc_simplify_expr (expr, 1);
   5093  1.1  mrg 
   5094  1.1  mrg   return MATCH_YES;
   5095  1.1  mrg }
   5096  1.1  mrg 
   5097  1.1  mrg 
   5098  1.1  mrg /* See if a CALL statement corresponds to an intrinsic subroutine.
   5099  1.1  mrg    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
   5100  1.1  mrg    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
   5101  1.1  mrg    correspond).  */
   5102  1.1  mrg 
   5103  1.1  mrg match
   5104  1.1  mrg gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
   5105  1.1  mrg {
   5106  1.1  mrg   gfc_intrinsic_sym *isym;
   5107  1.1  mrg   const char *name;
   5108  1.1  mrg 
   5109  1.1  mrg   name = c->symtree->n.sym->name;
   5110  1.1  mrg 
   5111  1.1  mrg   if (c->symtree->n.sym->intmod_sym_id)
   5112  1.1  mrg     {
   5113  1.1  mrg       gfc_isym_id id;
   5114  1.1  mrg       id = gfc_isym_id_by_intmod_sym (c->symtree->n.sym);
   5115  1.1  mrg       isym = gfc_intrinsic_subroutine_by_id (id);
   5116  1.1  mrg     }
   5117  1.1  mrg   else
   5118  1.1  mrg     isym = gfc_find_subroutine (name);
   5119  1.1  mrg   if (isym == NULL)
   5120  1.1  mrg     return MATCH_NO;
   5121  1.1  mrg 
   5122  1.1  mrg   if (!error_flag)
   5123  1.1  mrg     gfc_push_suppress_errors ();
   5124  1.1  mrg 
   5125  1.1  mrg   init_arglist (isym);
   5126  1.1  mrg 
   5127  1.1  mrg   if (!isym->vararg && !sort_actual (name, &c->ext.actual, isym->formal, &c->loc))
   5128  1.1  mrg     goto fail;
   5129  1.1  mrg 
   5130  1.1  mrg   if (!do_ts29113_check (isym, c->ext.actual))
   5131  1.1  mrg     goto fail;
   5132  1.1  mrg 
   5133  1.1  mrg   if (isym->check.f1 != NULL)
   5134  1.1  mrg     {
   5135  1.1  mrg       if (!do_check (isym, c->ext.actual))
   5136  1.1  mrg 	goto fail;
   5137  1.1  mrg     }
   5138  1.1  mrg   else
   5139  1.1  mrg     {
   5140  1.1  mrg       if (!check_arglist (&c->ext.actual, isym, 1))
   5141  1.1  mrg 	goto fail;
   5142  1.1  mrg     }
   5143  1.1  mrg 
   5144  1.1  mrg   /* The subroutine corresponds to an intrinsic.  Allow errors to be
   5145  1.1  mrg      seen at this point.  */
   5146  1.1  mrg   if (!error_flag)
   5147  1.1  mrg     gfc_pop_suppress_errors ();
   5148  1.1  mrg 
   5149  1.1  mrg   c->resolved_isym = isym;
   5150  1.1  mrg   if (isym->resolve.s1 != NULL)
   5151  1.1  mrg     isym->resolve.s1 (c);
   5152  1.1  mrg   else
   5153  1.1  mrg     {
   5154  1.1  mrg       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
   5155  1.1  mrg       c->resolved_sym->attr.elemental = isym->elemental;
   5156  1.1  mrg     }
   5157  1.1  mrg 
   5158  1.1  mrg   if (gfc_do_concurrent_flag && !isym->pure)
   5159  1.1  mrg     {
   5160  1.1  mrg       gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
   5161  1.1  mrg 		 "block at %L is not PURE", name, &c->loc);
   5162  1.1  mrg       return MATCH_ERROR;
   5163  1.1  mrg     }
   5164  1.1  mrg 
   5165  1.1  mrg   if (!isym->pure && gfc_pure (NULL))
   5166  1.1  mrg     {
   5167  1.1  mrg       gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name,
   5168  1.1  mrg 		 &c->loc);
   5169  1.1  mrg       return MATCH_ERROR;
   5170  1.1  mrg     }
   5171  1.1  mrg 
   5172  1.1  mrg   if (!isym->pure)
   5173  1.1  mrg     gfc_unset_implicit_pure (NULL);
   5174  1.1  mrg 
   5175  1.1  mrg   c->resolved_sym->attr.noreturn = isym->noreturn;
   5176  1.1  mrg 
   5177  1.1  mrg   return MATCH_YES;
   5178  1.1  mrg 
   5179  1.1  mrg fail:
   5180  1.1  mrg   if (!error_flag)
   5181  1.1  mrg     gfc_pop_suppress_errors ();
   5182  1.1  mrg   return MATCH_NO;
   5183  1.1  mrg }
   5184  1.1  mrg 
   5185  1.1  mrg 
   5186  1.1  mrg /* Call gfc_convert_type() with warning enabled.  */
   5187  1.1  mrg 
   5188  1.1  mrg bool
   5189  1.1  mrg gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
   5190  1.1  mrg {
   5191  1.1  mrg   return gfc_convert_type_warn (expr, ts, eflag, 1);
   5192  1.1  mrg }
   5193  1.1  mrg 
   5194  1.1  mrg 
   5195  1.1  mrg /* Try to convert an expression (in place) from one type to another.
   5196  1.1  mrg    'eflag' controls the behavior on error.
   5197  1.1  mrg 
   5198  1.1  mrg    The possible values are:
   5199  1.1  mrg 
   5200  1.1  mrg      1 Generate a gfc_error()
   5201  1.1  mrg      2 Generate a gfc_internal_error().
   5202  1.1  mrg 
   5203  1.1  mrg    'wflag' controls the warning related to conversion.
   5204  1.1  mrg 
   5205  1.1  mrg    'array' indicates whether the conversion is in an array constructor.
   5206  1.1  mrg    Non-standard conversion from character to numeric not allowed if true.
   5207  1.1  mrg */
   5208  1.1  mrg 
   5209  1.1  mrg bool
   5210  1.1  mrg gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag,
   5211  1.1  mrg 		       bool array)
   5212  1.1  mrg {
   5213  1.1  mrg   gfc_intrinsic_sym *sym;
   5214  1.1  mrg   gfc_typespec from_ts;
   5215  1.1  mrg   locus old_where;
   5216  1.1  mrg   gfc_expr *new_expr;
   5217  1.1  mrg   int rank;
   5218  1.1  mrg   mpz_t *shape;
   5219  1.1  mrg   bool is_char_constant = (expr->expr_type == EXPR_CONSTANT)
   5220  1.1  mrg 			  && (expr->ts.type == BT_CHARACTER);
   5221  1.1  mrg 
   5222  1.1  mrg   from_ts = expr->ts;		/* expr->ts gets clobbered */
   5223  1.1  mrg 
   5224  1.1  mrg   if (ts->type == BT_UNKNOWN)
   5225  1.1  mrg     goto bad;
   5226  1.1  mrg 
   5227  1.1  mrg   expr->do_not_warn = ! wflag;
   5228  1.1  mrg 
   5229  1.1  mrg   /* NULL and zero size arrays get their type here, unless they already have a
   5230  1.1  mrg      typespec.  */
   5231  1.1  mrg   if ((expr->expr_type == EXPR_NULL
   5232  1.1  mrg        || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
   5233  1.1  mrg       && expr->ts.type == BT_UNKNOWN)
   5234  1.1  mrg     {
   5235  1.1  mrg       /* Sometimes the RHS acquire the type.  */
   5236  1.1  mrg       expr->ts = *ts;
   5237  1.1  mrg       return true;
   5238  1.1  mrg     }
   5239  1.1  mrg 
   5240  1.1  mrg   if (expr->ts.type == BT_UNKNOWN)
   5241  1.1  mrg     goto bad;
   5242  1.1  mrg 
   5243  1.1  mrg   /* In building an array constructor, gfortran can end up here when no
   5244  1.1  mrg      conversion is required for an intrinsic type.  We need to let derived
   5245  1.1  mrg      types drop through.  */
   5246  1.1  mrg   if (from_ts.type != BT_DERIVED && from_ts.type != BT_CLASS
   5247  1.1  mrg       && (from_ts.type == ts->type && from_ts.kind == ts->kind))
   5248  1.1  mrg     return true;
   5249  1.1  mrg 
   5250  1.1  mrg   if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
   5251  1.1  mrg       && (ts->type == BT_DERIVED || ts->type == BT_CLASS)
   5252  1.1  mrg       && gfc_compare_types (ts, &expr->ts))
   5253  1.1  mrg     return true;
   5254  1.1  mrg 
   5255  1.1  mrg   /* If array is true then conversion is in an array constructor where
   5256  1.1  mrg      non-standard conversion is not allowed.  */
   5257  1.1  mrg   if (array && from_ts.type == BT_CHARACTER
   5258  1.1  mrg       && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
   5259  1.1  mrg     goto bad;
   5260  1.1  mrg 
   5261  1.1  mrg   sym = find_conv (&expr->ts, ts);
   5262  1.1  mrg   if (sym == NULL)
   5263  1.1  mrg     goto bad;
   5264  1.1  mrg 
   5265  1.1  mrg   /* At this point, a conversion is necessary. A warning may be needed.  */
   5266  1.1  mrg   if ((gfc_option.warn_std & sym->standard) != 0)
   5267  1.1  mrg     {
   5268  1.1  mrg       const char *type_name = is_char_constant ? gfc_typename (expr)
   5269  1.1  mrg 					       : gfc_typename (&from_ts);
   5270  1.1  mrg       gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
   5271  1.1  mrg 		       type_name, gfc_dummy_typename (ts),
   5272  1.1  mrg 		       &expr->where);
   5273  1.1  mrg     }
   5274  1.1  mrg   else if (wflag)
   5275  1.1  mrg     {
   5276  1.1  mrg       if (flag_range_check && expr->expr_type == EXPR_CONSTANT
   5277  1.1  mrg 	  && from_ts.type == ts->type)
   5278  1.1  mrg 	{
   5279  1.1  mrg 	  /* Do nothing. Constants of the same type are range-checked
   5280  1.1  mrg 	     elsewhere. If a value too large for the target type is
   5281  1.1  mrg 	     assigned, an error is generated. Not checking here avoids
   5282  1.1  mrg 	     duplications of warnings/errors.
   5283  1.1  mrg 	     If range checking was disabled, but -Wconversion enabled,
   5284  1.1  mrg 	     a non range checked warning is generated below.  */
   5285  1.1  mrg 	}
   5286  1.1  mrg       else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
   5287  1.1  mrg 	       && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
   5288  1.1  mrg 	{
   5289  1.1  mrg 	  const char *type_name = is_char_constant ? gfc_typename (expr)
   5290  1.1  mrg 						   : gfc_typename (&from_ts);
   5291  1.1  mrg 	  gfc_warning_now (OPT_Wconversion, "Nonstandard conversion from %s "
   5292  1.1  mrg 			   "to %s at %L", type_name, gfc_typename (ts),
   5293  1.1  mrg 			   &expr->where);
   5294  1.1  mrg 	}
   5295  1.1  mrg       else if (from_ts.type == ts->type
   5296  1.1  mrg 	       || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
   5297  1.1  mrg 	       || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
   5298  1.1  mrg 	       || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
   5299  1.1  mrg 	{
   5300  1.1  mrg 	  /* Larger kinds can hold values of smaller kinds without problems.
   5301  1.1  mrg 	     Hence, only warn if target kind is smaller than the source
   5302  1.1  mrg 	     kind - or if -Wconversion-extra is specified.  LOGICAL values
   5303  1.1  mrg 	     will always fit regardless of kind so ignore conversion.  */
   5304  1.1  mrg 	  if (expr->expr_type != EXPR_CONSTANT
   5305  1.1  mrg 	      && ts->type != BT_LOGICAL)
   5306  1.1  mrg 	    {
   5307  1.1  mrg 	      if (warn_conversion && from_ts.kind > ts->kind)
   5308  1.1  mrg 		gfc_warning_now (OPT_Wconversion, "Possible change of value in "
   5309  1.1  mrg 				 "conversion from %s to %s at %L",
   5310  1.1  mrg 				 gfc_typename (&from_ts), gfc_typename (ts),
   5311  1.1  mrg 				 &expr->where);
   5312  1.1  mrg 	      else
   5313  1.1  mrg 		gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
   5314  1.1  mrg 				 "at %L", gfc_typename (&from_ts),
   5315  1.1  mrg 				 gfc_typename (ts), &expr->where);
   5316  1.1  mrg 	    }
   5317  1.1  mrg 	}
   5318  1.1  mrg       else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
   5319  1.1  mrg 	       || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
   5320  1.1  mrg 	       || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
   5321  1.1  mrg 	{
   5322  1.1  mrg 	  /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
   5323  1.1  mrg 	     usually comes with a loss of information, regardless of kinds.  */
   5324  1.1  mrg 	  if (expr->expr_type != EXPR_CONSTANT)
   5325  1.1  mrg 	    gfc_warning_now (OPT_Wconversion, "Possible change of value in "
   5326  1.1  mrg 			     "conversion from %s to %s at %L",
   5327  1.1  mrg 			     gfc_typename (&from_ts), gfc_typename (ts),
   5328  1.1  mrg 			     &expr->where);
   5329  1.1  mrg 	}
   5330  1.1  mrg       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
   5331  1.1  mrg 	{
   5332  1.1  mrg 	  /* If HOLLERITH is involved, all bets are off.  */
   5333  1.1  mrg 	  gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
   5334  1.1  mrg 			   gfc_typename (&from_ts), gfc_dummy_typename (ts),
   5335  1.1  mrg 			   &expr->where);
   5336  1.1  mrg 	}
   5337  1.1  mrg       else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
   5338  1.1  mrg 	{
   5339  1.1  mrg 	  /* Do nothing. This block exists only to simplify the other
   5340  1.1  mrg 	     else-if expressions.
   5341  1.1  mrg 	       LOGICAL <> LOGICAL    no warning, independent of kind values
   5342  1.1  mrg 	       LOGICAL <> INTEGER    extension, warned elsewhere
   5343  1.1  mrg 	       LOGICAL <> REAL       invalid, error generated elsewhere
   5344  1.1  mrg 	       LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
   5345  1.1  mrg 	}
   5346  1.1  mrg       else
   5347  1.1  mrg 	gcc_unreachable ();
   5348  1.1  mrg     }
   5349  1.1  mrg 
   5350  1.1  mrg   /* Insert a pre-resolved function call to the right function.  */
   5351  1.1  mrg   old_where = expr->where;
   5352  1.1  mrg   rank = expr->rank;
   5353  1.1  mrg   shape = expr->shape;
   5354  1.1  mrg 
   5355  1.1  mrg   new_expr = gfc_get_expr ();
   5356  1.1  mrg   *new_expr = *expr;
   5357  1.1  mrg 
   5358  1.1  mrg   new_expr = gfc_build_conversion (new_expr);
   5359  1.1  mrg   new_expr->value.function.name = sym->lib_name;
   5360  1.1  mrg   new_expr->value.function.isym = sym;
   5361  1.1  mrg   new_expr->where = old_where;
   5362  1.1  mrg   new_expr->ts = *ts;
   5363  1.1  mrg   new_expr->rank = rank;
   5364  1.1  mrg   new_expr->shape = gfc_copy_shape (shape, rank);
   5365  1.1  mrg 
   5366  1.1  mrg   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
   5367  1.1  mrg   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
   5368  1.1  mrg   new_expr->symtree->n.sym->ts.type = ts->type;
   5369  1.1  mrg   new_expr->symtree->n.sym->ts.kind = ts->kind;
   5370  1.1  mrg   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   5371  1.1  mrg   new_expr->symtree->n.sym->attr.function = 1;
   5372  1.1  mrg   new_expr->symtree->n.sym->attr.elemental = 1;
   5373  1.1  mrg   new_expr->symtree->n.sym->attr.pure = 1;
   5374  1.1  mrg   new_expr->symtree->n.sym->attr.referenced = 1;
   5375  1.1  mrg   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
   5376  1.1  mrg   gfc_commit_symbol (new_expr->symtree->n.sym);
   5377  1.1  mrg 
   5378  1.1  mrg   *expr = *new_expr;
   5379  1.1  mrg 
   5380  1.1  mrg   free (new_expr);
   5381  1.1  mrg   expr->ts = *ts;
   5382  1.1  mrg 
   5383  1.1  mrg   if (gfc_is_constant_expr (expr->value.function.actual->expr)
   5384  1.1  mrg       && !do_simplify (sym, expr))
   5385  1.1  mrg     {
   5386  1.1  mrg 
   5387  1.1  mrg       if (eflag == 2)
   5388  1.1  mrg 	goto bad;
   5389  1.1  mrg       return false;		/* Error already generated in do_simplify() */
   5390  1.1  mrg     }
   5391  1.1  mrg 
   5392  1.1  mrg   return true;
   5393  1.1  mrg 
   5394  1.1  mrg bad:
   5395  1.1  mrg   const char *type_name = is_char_constant ? gfc_typename (expr)
   5396  1.1  mrg 					   : gfc_typename (&from_ts);
   5397  1.1  mrg   if (eflag == 1)
   5398  1.1  mrg     {
   5399  1.1  mrg       gfc_error ("Cannot convert %s to %s at %L", type_name, gfc_typename (ts),
   5400  1.1  mrg 		 &expr->where);
   5401  1.1  mrg       return false;
   5402  1.1  mrg     }
   5403  1.1  mrg 
   5404  1.1  mrg   gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name,
   5405  1.1  mrg 		      gfc_typename (ts), &expr->where);
   5406  1.1  mrg   /* Not reached */
   5407  1.1  mrg }
   5408  1.1  mrg 
   5409  1.1  mrg 
   5410  1.1  mrg bool
   5411  1.1  mrg gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
   5412  1.1  mrg {
   5413  1.1  mrg   gfc_intrinsic_sym *sym;
   5414  1.1  mrg   locus old_where;
   5415  1.1  mrg   gfc_expr *new_expr;
   5416  1.1  mrg   int rank;
   5417  1.1  mrg   mpz_t *shape;
   5418  1.1  mrg 
   5419  1.1  mrg   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
   5420  1.1  mrg 
   5421  1.1  mrg   sym = find_char_conv (&expr->ts, ts);
   5422  1.1  mrg   gcc_assert (sym);
   5423  1.1  mrg 
   5424  1.1  mrg   /* Insert a pre-resolved function call to the right function.  */
   5425  1.1  mrg   old_where = expr->where;
   5426  1.1  mrg   rank = expr->rank;
   5427  1.1  mrg   shape = expr->shape;
   5428  1.1  mrg 
   5429  1.1  mrg   new_expr = gfc_get_expr ();
   5430  1.1  mrg   *new_expr = *expr;
   5431  1.1  mrg 
   5432  1.1  mrg   new_expr = gfc_build_conversion (new_expr);
   5433  1.1  mrg   new_expr->value.function.name = sym->lib_name;
   5434  1.1  mrg   new_expr->value.function.isym = sym;
   5435  1.1  mrg   new_expr->where = old_where;
   5436  1.1  mrg   new_expr->ts = *ts;
   5437  1.1  mrg   new_expr->rank = rank;
   5438  1.1  mrg   new_expr->shape = gfc_copy_shape (shape, rank);
   5439  1.1  mrg 
   5440  1.1  mrg   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
   5441  1.1  mrg   new_expr->symtree->n.sym->ts.type = ts->type;
   5442  1.1  mrg   new_expr->symtree->n.sym->ts.kind = ts->kind;
   5443  1.1  mrg   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
   5444  1.1  mrg   new_expr->symtree->n.sym->attr.function = 1;
   5445  1.1  mrg   new_expr->symtree->n.sym->attr.elemental = 1;
   5446  1.1  mrg   new_expr->symtree->n.sym->attr.referenced = 1;
   5447  1.1  mrg   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
   5448  1.1  mrg   gfc_commit_symbol (new_expr->symtree->n.sym);
   5449  1.1  mrg 
   5450  1.1  mrg   *expr = *new_expr;
   5451  1.1  mrg 
   5452  1.1  mrg   free (new_expr);
   5453  1.1  mrg   expr->ts = *ts;
   5454  1.1  mrg 
   5455  1.1  mrg   if (gfc_is_constant_expr (expr->value.function.actual->expr)
   5456  1.1  mrg       && !do_simplify (sym, expr))
   5457  1.1  mrg     {
   5458  1.1  mrg       /* Error already generated in do_simplify() */
   5459  1.1  mrg       return false;
   5460  1.1  mrg     }
   5461  1.1  mrg 
   5462  1.1  mrg   return true;
   5463  1.1  mrg }
   5464  1.1  mrg 
   5465  1.1  mrg 
   5466  1.1  mrg /* Check if the passed name is name of an intrinsic (taking into account the
   5467  1.1  mrg    current -std=* and -fall-intrinsic settings).  If it is, see if we should
   5468  1.1  mrg    warn about this as a user-procedure having the same name as an intrinsic
   5469  1.1  mrg    (-Wintrinsic-shadow enabled) and do so if we should.  */
   5470  1.1  mrg 
   5471  1.1  mrg void
   5472  1.1  mrg gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
   5473  1.1  mrg {
   5474  1.1  mrg   gfc_intrinsic_sym* isym;
   5475  1.1  mrg 
   5476  1.1  mrg   /* If the warning is disabled, do nothing at all.  */
   5477  1.1  mrg   if (!warn_intrinsic_shadow)
   5478  1.1  mrg     return;
   5479  1.1  mrg 
   5480  1.1  mrg   /* Try to find an intrinsic of the same name.  */
   5481  1.1  mrg   if (func)
   5482  1.1  mrg     isym = gfc_find_function (sym->name);
   5483  1.1  mrg   else
   5484  1.1  mrg     isym = gfc_find_subroutine (sym->name);
   5485  1.1  mrg 
   5486  1.1  mrg   /* If no intrinsic was found with this name or it's not included in the
   5487  1.1  mrg      selected standard, everything's fine.  */
   5488  1.1  mrg   if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true,
   5489  1.1  mrg 					      sym->declared_at))
   5490  1.1  mrg     return;
   5491  1.1  mrg 
   5492  1.1  mrg   /* Emit the warning.  */
   5493  1.1  mrg   if (in_module || sym->ns->proc_name)
   5494  1.1  mrg     gfc_warning (OPT_Wintrinsic_shadow,
   5495  1.1  mrg 		 "%qs declared at %L may shadow the intrinsic of the same"
   5496  1.1  mrg 		 " name.  In order to call the intrinsic, explicit INTRINSIC"
   5497  1.1  mrg 		 " declarations may be required.",
   5498  1.1  mrg 		 sym->name, &sym->declared_at);
   5499  1.1  mrg   else
   5500  1.1  mrg     gfc_warning (OPT_Wintrinsic_shadow,
   5501  1.1  mrg 		 "%qs declared at %L is also the name of an intrinsic.  It can"
   5502  1.1  mrg 		 " only be called via an explicit interface or if declared"
   5503  1.1  mrg 		 " EXTERNAL.", sym->name, &sym->declared_at);
   5504  1.1  mrg }
   5505