gcc/fortran/intrinsic.c

   1 /* Build up a list of intrinsic subroutines and functions for the
   2    name-resolution stage.
   3    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
   4    2009, 2010
   5    Free Software Foundation, Inc.
   6    Contributed by Andy Vaught & Katherine Holcomb
   7
   8 This file is part of GCC.
   9
  10 GCC is free software; you can redistribute it and/or modify it under
  11 the terms of the GNU General Public License as published by the Free
  12 Software Foundation; either version 3, or (at your option) any later
  13 version.
  14
  15 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  16 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  17 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  18 for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with GCC; see the file COPYING3.  If not see
  22 <http://www.gnu.org/licenses/>.  */
  23
  24 #include "config.h"
  25 #include "system.h"
  26 #include "flags.h"
  27 #include "gfortran.h"
  28 #include "intrinsic.h"
  29
  30 /* Namespace to hold the resolved symbols for intrinsic subroutines.  */
  31 static gfc_namespace *gfc_intrinsic_namespace;
  32
  33 bool gfc_init_expr_flag = false;
  34
  35 /* Pointers to an intrinsic function and its argument names that are being
  36    checked.  */
  37
  38 const char *gfc_current_intrinsic;
  39 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
  40 locus *gfc_current_intrinsic_where;
  41
  42 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
  43 static gfc_intrinsic_sym *char_conversions;
  44 static gfc_intrinsic_arg *next_arg;
  45
  46 static int nfunc, nsub, nargs, nconv, ncharconv;
  47
  48 static enum
  49 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
  50 sizing;
  51
  52 enum klass
  53 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
  54
  55 #define ACTUAL_NO       0
  56 #define ACTUAL_YES      1
  57
  58 #define REQUIRED        0
  59 #define OPTIONAL        1
  60
  61
  62 /* Return a letter based on the passed type.  Used to construct the
  63    name of a type-dependent subroutine.  */
  64
  65 char
  66 gfc_type_letter (bt type)
  67 {
  68   char c;
  69
  70   switch (type)
  71     {
  72     case BT_LOGICAL:
  73       c = 'l';
  74       break;
  75     case BT_CHARACTER:
  76       c = 's';
  77       break;
  78     case BT_INTEGER:
  79       c = 'i';
  80       break;
  81     case BT_REAL:
  82       c = 'r';
  83       break;
  84     case BT_COMPLEX:
  85       c = 'c';
  86       break;
  87
  88     case BT_HOLLERITH:
  89       c = 'h';
  90       break;
  91
  92     default:
  93       c = 'u';
  94       break;
  95     }
  96
  97   return c;
  98 }
  99
 100
 101 /* Get a symbol for a resolved name. Note, if needed be, the elemental
 102    attribute has be added afterwards.  */
 103
 104 gfc_symbol *
 105 gfc_get_intrinsic_sub_symbol (const char *name)
 106 {
 107   gfc_symbol *sym;
 108
 109   gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
 110   sym->attr.always_explicit = 1;
 111   sym->attr.subroutine = 1;
 112   sym->attr.flavor = FL_PROCEDURE;
 113   sym->attr.proc = PROC_INTRINSIC;
 114
 115   return sym;
 116 }
 117
 118
 119 /* Return a pointer to the name of a conversion function given two
 120    typespecs.  */
 121
 122 static const char *
 123 conv_name (gfc_typespec *from, gfc_typespec *to)
 124 {
 125   return gfc_get_string ("__convert_%c%d_%c%d",
 126                          gfc_type_letter (from->type), from->kind,
 127                          gfc_type_letter (to->type), to->kind);
 128 }
 129
 130
 131 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
 132    corresponds to the conversion.  Returns NULL if the conversion
 133    isn't found.  */
 134
 135 static gfc_intrinsic_sym *
 136 find_conv (gfc_typespec *from, gfc_typespec *to)
 137 {
 138   gfc_intrinsic_sym *sym;
 139   const char *target;
 140   int i;
 141
 142   target = conv_name (from, to);
 143   sym = conversion;
 144
 145   for (i = 0; i < nconv; i++, sym++)
 146     if (target == sym->name)
 147       return sym;
 148
 149   return NULL;
 150 }
 151
 152
 153 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
 154    that corresponds to the conversion.  Returns NULL if the conversion
 155    isn't found.  */
 156
 157 static gfc_intrinsic_sym *
 158 find_char_conv (gfc_typespec *from, gfc_typespec *to)
 159 {
 160   gfc_intrinsic_sym *sym;
 161   const char *target;
 162   int i;
 163
 164   target = conv_name (from, to);
 165   sym = char_conversions;
 166
 167   for (i = 0; i < ncharconv; i++, sym++)
 168     if (target == sym->name)
 169       return sym;
 170
 171   return NULL;
 172 }
 173
 174
 175 /* Interface to the check functions.  We break apart an argument list
 176    and call the proper check function rather than forcing each
 177    function to manipulate the argument list.  */
 178
 179 static gfc_try
 180 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 181 {
 182   gfc_expr *a1, *a2, *a3, *a4, *a5;
 183
 184   if (arg == NULL)
 185     return (*specific->check.f0) ();
 186
 187   a1 = arg->expr;
 188   arg = arg->next;
 189   if (arg == NULL)
 190     return (*specific->check.f1) (a1);
 191
 192   a2 = arg->expr;
 193   arg = arg->next;
 194   if (arg == NULL)
 195     return (*specific->check.f2) (a1, a2);
 196
 197   a3 = arg->expr;
 198   arg = arg->next;
 199   if (arg == NULL)
 200     return (*specific->check.f3) (a1, a2, a3);
 201
 202   a4 = arg->expr;
 203   arg = arg->next;
 204   if (arg == NULL)
 205     return (*specific->check.f4) (a1, a2, a3, a4);
 206
 207   a5 = arg->expr;
 208   arg = arg->next;
 209   if (arg == NULL)
 210     return (*specific->check.f5) (a1, a2, a3, a4, a5);
 211
 212   gfc_internal_error ("do_check(): too many args");
 213 }
 214
 215
 216 /*********** Subroutines to build the intrinsic list ****************/
 217
 218 /* Add a single intrinsic symbol to the current list.
 219
 220    Argument list:
 221       char *     name of function
 222       int       whether function is elemental
 223       int       If the function can be used as an actual argument [1]
 224       bt         return type of function
 225       int       kind of return type of function
 226       int       Fortran standard version
 227       check      pointer to check function
 228       simplify   pointer to simplification function
 229       resolve    pointer to resolution function
 230
 231    Optional arguments come in multiples of five:
 232       char *      name of argument
 233       bt          type of argument
 234       int         kind of argument
 235       int         arg optional flag (1=optional, 0=required)
 236       sym_intent  intent of argument
 237
 238    The sequence is terminated by a NULL name.
 239
 240
 241  [1] Whether a function can or cannot be used as an actual argument is
 242      determined by its presence on the 13.6 list in Fortran 2003.  The
 243      following intrinsics, which are GNU extensions, are considered allowed
 244      as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
 245      ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT.  */
 246
 247 static void
 248 add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
 249          int standard, gfc_check_f check, gfc_simplify_f simplify,
 250          gfc_resolve_f resolve, ...)
 251 {
 252   char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
 253   int optional, first_flag;
 254   sym_intent intent;
 255   va_list argp;
 256
 257   switch (sizing)
 258     {
 259     case SZ_SUBS:
 260       nsub++;
 261       break;
 262
 263     case SZ_FUNCS:
 264       nfunc++;
 265       break;
 266
 267     case SZ_NOTHING:
 268       next_sym->name = gfc_get_string (name);
 269
 270       strcpy (buf, "_gfortran_");
 271       strcat (buf, name);
 272       next_sym->lib_name = gfc_get_string (buf);
 273
 274       next_sym->elemental = (cl == CLASS_ELEMENTAL);
 275       next_sym->inquiry = (cl == CLASS_INQUIRY);
 276       next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
 277       next_sym->actual_ok = actual_ok;
 278       next_sym->ts.type = type;
 279       next_sym->ts.kind = kind;
 280       next_sym->standard = standard;
 281       next_sym->simplify = simplify;
 282       next_sym->check = check;
 283       next_sym->resolve = resolve;
 284       next_sym->specific = 0;
 285       next_sym->generic = 0;
 286       next_sym->conversion = 0;
 287       next_sym->id = id;
 288       break;
 289
 290     default:
 291       gfc_internal_error ("add_sym(): Bad sizing mode");
 292     }
 293
 294   va_start (argp, resolve);
 295
 296   first_flag = 1;
 297
 298   for (;;)
 299     {
 300       name = va_arg (argp, char *);
 301       if (name == NULL)
 302         break;
 303
 304       type = (bt) va_arg (argp, int);
 305       kind = va_arg (argp, int);
 306       optional = va_arg (argp, int);
 307       intent = (sym_intent) va_arg (argp, int);
 308
 309       if (sizing != SZ_NOTHING)
 310         nargs++;
 311       else
 312         {
 313           next_arg++;
 314
 315           if (first_flag)
 316             next_sym->formal = next_arg;
 317           else
 318             (next_arg - 1)->next = next_arg;
 319
 320           first_flag = 0;
 321
 322           strcpy (next_arg->name, name);
 323           next_arg->ts.type = type;
 324           next_arg->ts.kind = kind;
 325           next_arg->optional = optional;
 326           next_arg->intent = intent;
 327         }
 328     }
 329
 330   va_end (argp);
 331
 332   next_sym++;
 333 }
 334
 335
 336 /* Add a symbol to the function list where the function takes
 337    0 arguments.  */
 338
 339 static void
 340 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 341            int kind, int standard,
 342            gfc_try (*check) (void),
 343            gfc_expr *(*simplify) (void),
 344            void (*resolve) (gfc_expr *))
 345 {
 346   gfc_simplify_f sf;
 347   gfc_check_f cf;
 348   gfc_resolve_f rf;
 349
 350   cf.f0 = check;
 351   sf.f0 = simplify;
 352   rf.f0 = resolve;
 353
 354   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 355            (void *) 0);
 356 }
 357
 358
 359 /* Add a symbol to the subroutine list where the subroutine takes
 360    0 arguments.  */
 361
 362 static void
 363 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
 364 {
 365   gfc_check_f cf;
 366   gfc_simplify_f sf;
 367   gfc_resolve_f rf;
 368
 369   cf.f1 = NULL;
 370   sf.f1 = NULL;
 371   rf.s1 = resolve;
 372
 373   add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
 374            (void *) 0);
 375 }
 376
 377
 378 /* Add a symbol to the function list where the function takes
 379    1 arguments.  */
 380
 381 static void
 382 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 383            int kind, int standard,
 384            gfc_try (*check) (gfc_expr *),
 385            gfc_expr *(*simplify) (gfc_expr *),
 386            void (*resolve) (gfc_expr *, gfc_expr *),
 387            const char *a1, bt type1, int kind1, int optional1)
 388 {
 389   gfc_check_f cf;
 390   gfc_simplify_f sf;
 391   gfc_resolve_f rf;
 392
 393   cf.f1 = check;
 394   sf.f1 = simplify;
 395   rf.f1 = resolve;
 396
 397   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 398            a1, type1, kind1, optional1, INTENT_IN,
 399            (void *) 0);
 400 }
 401
 402
 403 /* Add a symbol to the subroutine list where the subroutine takes
 404    1 arguments.  */
 405
 406 static void
 407 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
 408             gfc_try (*check) (gfc_expr *),
 409             gfc_expr *(*simplify) (gfc_expr *),
 410             void (*resolve) (gfc_code *),
 411             const char *a1, bt type1, int kind1, int optional1)
 412 {
 413   gfc_check_f cf;
 414   gfc_simplify_f sf;
 415   gfc_resolve_f rf;
 416
 417   cf.f1 = check;
 418   sf.f1 = simplify;
 419   rf.s1 = resolve;
 420
 421   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 422            a1, type1, kind1, optional1, INTENT_IN,
 423            (void *) 0);
 424 }
 425
 426
 427 /* Add a symbol to the function list where the function takes
 428    1 arguments, specifying the intent of the argument.  */
 429
 430 static void
 431 add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
 432                   int actual_ok, bt type, int kind, int standard,
 433                   gfc_try (*check) (gfc_expr *),
 434                   gfc_expr *(*simplify) (gfc_expr *),
 435                   void (*resolve) (gfc_expr *, gfc_expr *),
 436                   const char *a1, bt type1, int kind1, int optional1,
 437                   sym_intent intent1)
 438 {
 439   gfc_check_f cf;
 440   gfc_simplify_f sf;
 441   gfc_resolve_f rf;
 442
 443   cf.f1 = check;
 444   sf.f1 = simplify;
 445   rf.f1 = resolve;
 446
 447   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 448            a1, type1, kind1, optional1, intent1,
 449            (void *) 0);
 450 }
 451
 452
 453 /* Add a symbol to the subroutine list where the subroutine takes
 454    1 arguments, specifying the intent of the argument.  */
 455
 456 static void
 457 add_sym_1s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
 458                    int kind, int standard,
 459                    gfc_try (*check) (gfc_expr *),
 460                    gfc_expr *(*simplify) (gfc_expr *),
 461                    void (*resolve) (gfc_code *),
 462                    const char *a1, bt type1, int kind1, int optional1,
 463                    sym_intent intent1)
 464 {
 465   gfc_check_f cf;
 466   gfc_simplify_f sf;
 467   gfc_resolve_f rf;
 468
 469   cf.f1 = check;
 470   sf.f1 = simplify;
 471   rf.s1 = resolve;
 472
 473   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 474            a1, type1, kind1, optional1, intent1,
 475            (void *) 0);
 476 }
 477
 478
 479 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
 480    function.  MAX et al take 2 or more arguments.  */
 481
 482 static void
 483 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 484             int kind, int standard,
 485             gfc_try (*check) (gfc_actual_arglist *),
 486             gfc_expr *(*simplify) (gfc_expr *),
 487             void (*resolve) (gfc_expr *, gfc_actual_arglist *),
 488             const char *a1, bt type1, int kind1, int optional1,
 489             const char *a2, bt type2, int kind2, int optional2)
 490 {
 491   gfc_check_f cf;
 492   gfc_simplify_f sf;
 493   gfc_resolve_f rf;
 494
 495   cf.f1m = check;
 496   sf.f1 = simplify;
 497   rf.f1m = resolve;
 498
 499   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 500            a1, type1, kind1, optional1, INTENT_IN,
 501            a2, type2, kind2, optional2, INTENT_IN,
 502            (void *) 0);
 503 }
 504
 505
 506 /* Add a symbol to the function list where the function takes
 507    2 arguments.  */
 508
 509 static void
 510 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 511            int kind, int standard,
 512            gfc_try (*check) (gfc_expr *, gfc_expr *),
 513            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 514            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
 515            const char *a1, bt type1, int kind1, int optional1,
 516            const char *a2, bt type2, int kind2, int optional2)
 517 {
 518   gfc_check_f cf;
 519   gfc_simplify_f sf;
 520   gfc_resolve_f rf;
 521
 522   cf.f2 = check;
 523   sf.f2 = simplify;
 524   rf.f2 = resolve;
 525
 526   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 527            a1, type1, kind1, optional1, INTENT_IN,
 528            a2, type2, kind2, optional2, INTENT_IN,
 529            (void *) 0);
 530 }
 531
 532
 533 /* Add a symbol to the subroutine list where the subroutine takes
 534    2 arguments.  */
 535
 536 static void
 537 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
 538             gfc_try (*check) (gfc_expr *, gfc_expr *),
 539             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 540             void (*resolve) (gfc_code *),
 541             const char *a1, bt type1, int kind1, int optional1,
 542             const char *a2, bt type2, int kind2, int optional2)
 543 {
 544   gfc_check_f cf;
 545   gfc_simplify_f sf;
 546   gfc_resolve_f rf;
 547
 548   cf.f2 = check;
 549   sf.f2 = simplify;
 550   rf.s1 = resolve;
 551
 552   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 553            a1, type1, kind1, optional1, INTENT_IN,
 554            a2, type2, kind2, optional2, INTENT_IN,
 555            (void *) 0);
 556 }
 557
 558
 559 /* Add a symbol to the subroutine list where the subroutine takes
 560    2 arguments, specifying the intent of the arguments.  */
 561
 562 static void
 563 add_sym_2s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
 564                    int kind, int standard,
 565                    gfc_try (*check) (gfc_expr *, gfc_expr *),
 566                    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 567                    void (*resolve) (gfc_code *),
 568                    const char *a1, bt type1, int kind1, int optional1,
 569                    sym_intent intent1, const char *a2, bt type2, int kind2,
 570                    int optional2, sym_intent intent2)
 571 {
 572   gfc_check_f cf;
 573   gfc_simplify_f sf;
 574   gfc_resolve_f rf;
 575
 576   cf.f2 = check;
 577   sf.f2 = simplify;
 578   rf.s1 = resolve;
 579
 580   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 581            a1, type1, kind1, optional1, intent1,
 582            a2, type2, kind2, optional2, intent2,
 583            (void *) 0);
 584 }
 585
 586
 587 /* Add a symbol to the function list where the function takes
 588    3 arguments.  */
 589
 590 static void
 591 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 592            int kind, int standard,
 593            gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
 594            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 595            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 596            const char *a1, bt type1, int kind1, int optional1,
 597            const char *a2, bt type2, int kind2, int optional2,
 598            const char *a3, bt type3, int kind3, int optional3)
 599 {
 600   gfc_check_f cf;
 601   gfc_simplify_f sf;
 602   gfc_resolve_f rf;
 603
 604   cf.f3 = check;
 605   sf.f3 = simplify;
 606   rf.f3 = resolve;
 607
 608   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 609            a1, type1, kind1, optional1, INTENT_IN,
 610            a2, type2, kind2, optional2, INTENT_IN,
 611            a3, type3, kind3, optional3, INTENT_IN,
 612            (void *) 0);
 613 }
 614
 615
 616 /* MINLOC and MAXLOC get special treatment because their argument
 617    might have to be reordered.  */
 618
 619 static void
 620 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 621              int kind, int standard,
 622              gfc_try (*check) (gfc_actual_arglist *),
 623              gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 624              void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 625              const char *a1, bt type1, int kind1, int optional1,
 626              const char *a2, bt type2, int kind2, int optional2,
 627              const char *a3, bt type3, int kind3, int optional3)
 628 {
 629   gfc_check_f cf;
 630   gfc_simplify_f sf;
 631   gfc_resolve_f rf;
 632
 633   cf.f3ml = check;
 634   sf.f3 = simplify;
 635   rf.f3 = resolve;
 636
 637   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 638            a1, type1, kind1, optional1, INTENT_IN,
 639            a2, type2, kind2, optional2, INTENT_IN,
 640            a3, type3, kind3, optional3, INTENT_IN,
 641            (void *) 0);
 642 }
 643
 644
 645 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
 646    their argument also might have to be reordered.  */
 647
 648 static void
 649 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 650               int kind, int standard,
 651               gfc_try (*check) (gfc_actual_arglist *),
 652               gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 653               void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 654               const char *a1, bt type1, int kind1, int optional1,
 655               const char *a2, bt type2, int kind2, int optional2,
 656               const char *a3, bt type3, int kind3, int optional3)
 657 {
 658   gfc_check_f cf;
 659   gfc_simplify_f sf;
 660   gfc_resolve_f rf;
 661
 662   cf.f3red = check;
 663   sf.f3 = simplify;
 664   rf.f3 = resolve;
 665
 666   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 667            a1, type1, kind1, optional1, INTENT_IN,
 668            a2, type2, kind2, optional2, INTENT_IN,
 669            a3, type3, kind3, optional3, INTENT_IN,
 670            (void *) 0);
 671 }
 672
 673
 674 /* Add a symbol to the subroutine list where the subroutine takes
 675    3 arguments.  */
 676
 677 static void
 678 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
 679             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
 680             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 681             void (*resolve) (gfc_code *),
 682             const char *a1, bt type1, int kind1, int optional1,
 683             const char *a2, bt type2, int kind2, int optional2,
 684             const char *a3, bt type3, int kind3, int optional3)
 685 {
 686   gfc_check_f cf;
 687   gfc_simplify_f sf;
 688   gfc_resolve_f rf;
 689
 690   cf.f3 = check;
 691   sf.f3 = simplify;
 692   rf.s1 = resolve;
 693
 694   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 695            a1, type1, kind1, optional1, INTENT_IN,
 696            a2, type2, kind2, optional2, INTENT_IN,
 697            a3, type3, kind3, optional3, INTENT_IN,
 698            (void *) 0);
 699 }
 700
 701
 702 /* Add a symbol to the subroutine list where the subroutine takes
 703    3 arguments, specifying the intent of the arguments.  */
 704
 705 static void
 706 add_sym_3s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
 707                    int kind, int standard,
 708                    gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
 709                    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 710                    void (*resolve) (gfc_code *),
 711                    const char *a1, bt type1, int kind1, int optional1,
 712                    sym_intent intent1, const char *a2, bt type2, int kind2,
 713                    int optional2, sym_intent intent2, const char *a3, bt type3,
 714                    int kind3, int optional3, sym_intent intent3)
 715 {
 716   gfc_check_f cf;
 717   gfc_simplify_f sf;
 718   gfc_resolve_f rf;
 719
 720   cf.f3 = check;
 721   sf.f3 = simplify;
 722   rf.s1 = resolve;
 723
 724   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 725            a1, type1, kind1, optional1, intent1,
 726            a2, type2, kind2, optional2, intent2,
 727            a3, type3, kind3, optional3, intent3,
 728            (void *) 0);
 729 }
 730
 731
 732 /* Add a symbol to the function list where the function takes
 733    4 arguments.  */
 734
 735 static void
 736 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 737            int kind, int standard,
 738            gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 739            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 740                                   gfc_expr *),
 741            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 742                             gfc_expr *),
 743            const char *a1, bt type1, int kind1, int optional1,
 744            const char *a2, bt type2, int kind2, int optional2,
 745            const char *a3, bt type3, int kind3, int optional3,
 746            const char *a4, bt type4, int kind4, int optional4 )
 747 {
 748   gfc_check_f cf;
 749   gfc_simplify_f sf;
 750   gfc_resolve_f rf;
 751
 752   cf.f4 = check;
 753   sf.f4 = simplify;
 754   rf.f4 = resolve;
 755
 756   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 757            a1, type1, kind1, optional1, INTENT_IN,
 758            a2, type2, kind2, optional2, INTENT_IN,
 759            a3, type3, kind3, optional3, INTENT_IN,
 760            a4, type4, kind4, optional4, INTENT_IN,
 761            (void *) 0);
 762 }
 763
 764
 765 /* Add a symbol to the subroutine list where the subroutine takes
 766    4 arguments.  */
 767
 768 static void
 769 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 770             int standard,
 771             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 772             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 773                                    gfc_expr *),
 774             void (*resolve) (gfc_code *),
 775             const char *a1, bt type1, int kind1, int optional1,
 776             sym_intent intent1, const char *a2, bt type2, int kind2,
 777             int optional2, sym_intent intent2, const char *a3, bt type3,
 778             int kind3, int optional3, sym_intent intent3, const char *a4,
 779             bt type4, int kind4, int optional4, sym_intent intent4)
 780 {
 781   gfc_check_f cf;
 782   gfc_simplify_f sf;
 783   gfc_resolve_f rf;
 784
 785   cf.f4 = check;
 786   sf.f4 = simplify;
 787   rf.s1 = resolve;
 788
 789   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 790            a1, type1, kind1, optional1, intent1,
 791            a2, type2, kind2, optional2, intent2,
 792            a3, type3, kind3, optional3, intent3,
 793            a4, type4, kind4, optional4, intent4,
 794            (void *) 0);
 795 }
 796
 797
 798 /* Add a symbol to the subroutine list where the subroutine takes
 799    5 arguments.  */
 800
 801 static void
 802 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 803             int standard,
 804             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 805                           gfc_expr *),
 806             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 807                                    gfc_expr *, gfc_expr *),
 808             void (*resolve) (gfc_code *),
 809             const char *a1, bt type1, int kind1, int optional1,
 810             sym_intent intent1, const char *a2, bt type2, int kind2,
 811             int optional2, sym_intent intent2, const char *a3, bt type3,
 812             int kind3, int optional3, sym_intent intent3, const char *a4,
 813             bt type4, int kind4, int optional4, sym_intent intent4,
 814             const char *a5, bt type5, int kind5, int optional5,
 815             sym_intent intent5)
 816 {
 817   gfc_check_f cf;
 818   gfc_simplify_f sf;
 819   gfc_resolve_f rf;
 820
 821   cf.f5 = check;
 822   sf.f5 = simplify;
 823   rf.s1 = resolve;
 824
 825   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 826            a1, type1, kind1, optional1, intent1,
 827            a2, type2, kind2, optional2, intent2,
 828            a3, type3, kind3, optional3, intent3,
 829            a4, type4, kind4, optional4, intent4,
 830            a5, type5, kind5, optional5, intent5,
 831            (void *) 0);
 832 }
 833
 834
 835 /* Locate an intrinsic symbol given a base pointer, number of elements
 836    in the table and a pointer to a name.  Returns the NULL pointer if
 837    a name is not found.  */
 838
 839 static gfc_intrinsic_sym *
 840 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
 841 {
 842   /* name may be a user-supplied string, so we must first make sure
 843      that we're comparing against a pointer into the global string
 844      table.  */
 845   const char *p = gfc_get_string (name);
 846
 847   while (n > 0)
 848     {
 849       if (p == start->name)
 850         return start;
 851
 852       start++;
 853       n--;
 854     }
 855
 856   return NULL;
 857 }
 858
 859
 860 /* Given a name, find a function in the intrinsic function table.
 861    Returns NULL if not found.  */
 862
 863 gfc_intrinsic_sym *
 864 gfc_find_function (const char *name)
 865 {
 866   gfc_intrinsic_sym *sym;
 867
 868   sym = find_sym (functions, nfunc, name);
 869   if (!sym)
 870     sym = find_sym (conversion, nconv, name);
 871
 872   return sym;
 873 }
 874
 875
 876 /* Given a name, find a function in the intrinsic subroutine table.
 877    Returns NULL if not found.  */
 878
 879 gfc_intrinsic_sym *
 880 gfc_find_subroutine (const char *name)
 881 {
 882   return find_sym (subroutines, nsub, name);
 883 }
 884
 885
 886 /* Given a string, figure out if it is the name of a generic intrinsic
 887    function or not.  */
 888
 889 int
 890 gfc_generic_intrinsic (const char *name)
 891 {
 892   gfc_intrinsic_sym *sym;
 893
 894   sym = gfc_find_function (name);
 895   return (sym == NULL) ? 0 : sym->generic;
 896 }
 897
 898
 899 /* Given a string, figure out if it is the name of a specific
 900    intrinsic function or not.  */
 901
 902 int
 903 gfc_specific_intrinsic (const char *name)
 904 {
 905   gfc_intrinsic_sym *sym;
 906
 907   sym = gfc_find_function (name);
 908   return (sym == NULL) ? 0 : sym->specific;
 909 }
 910
 911
 912 /* Given a string, figure out if it is the name of an intrinsic function
 913    or subroutine allowed as an actual argument or not.  */
 914 int
 915 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
 916 {
 917   gfc_intrinsic_sym *sym;
 918
 919   /* Intrinsic subroutines are not allowed as actual arguments.  */
 920   if (subroutine_flag)
 921     return 0;
 922   else
 923     {
 924       sym = gfc_find_function (name);
 925       return (sym == NULL) ? 0 : sym->actual_ok;
 926     }
 927 }
 928
 929
 930 /* Given a symbol, find out if it is (and is to be treated) an intrinsic.  If
 931    it's name refers to an intrinsic but this intrinsic is not included in the
 932    selected standard, this returns FALSE and sets the symbol's external
 933    attribute.  */
 934
 935 bool
 936 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
 937 {
 938   gfc_intrinsic_sym* isym;
 939   const char* symstd;
 940
 941   /* If INTRINSIC/EXTERNAL state is already known, return.  */
 942   if (sym->attr.intrinsic)
 943     return true;
 944   if (sym->attr.external)
 945     return false;
 946
 947   if (subroutine_flag)
 948     isym = gfc_find_subroutine (sym->name);
 949   else
 950     isym = gfc_find_function (sym->name);
 951
 952   /* No such intrinsic available at all?  */
 953   if (!isym)
 954     return false;
 955
 956   /* See if this intrinsic is allowed in the current standard.  */
 957   if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
 958     {
 959       if (sym->attr.proc == PROC_UNKNOWN
 960           && gfc_option.warn_intrinsics_std)
 961         gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
 962                          " selected standard but %s and '%s' will be"
 963                          " treated as if declared EXTERNAL.  Use an"
 964                          " appropriate -std=* option or define"
 965                          " -fall-intrinsics to allow this intrinsic.",
 966                          sym->name, &loc, symstd, sym->name);
 967
 968       return false;
 969     }
 970
 971   return true;
 972 }
 973
 974
 975 /* Collect a set of intrinsic functions into a generic collection.
 976    The first argument is the name of the generic function, which is
 977    also the name of a specific function.  The rest of the specifics
 978    currently in the table are placed into the list of specific
 979    functions associated with that generic.
 980
 981    PR fortran/32778
 982    FIXME: Remove the argument STANDARD if no regressions are
 983           encountered. Change all callers (approx. 360).
 984 */
 985
 986 static void
 987 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 988 {
 989   gfc_intrinsic_sym *g;
 990
 991   if (sizing != SZ_NOTHING)
 992     return;
 993
 994   g = gfc_find_function (name);
 995   if (g == NULL)
 996     gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
 997                         name);
 998
 999   gcc_assert (g->id == id);
1000
1001   g->generic = 1;
1002   g->specific = 1;
1003   if ((g + 1)->name != NULL)
1004     g->specific_head = g + 1;
1005   g++;
1006
1007   while (g->name != NULL)
1008     {
1009       g->next = g + 1;
1010       g->specific = 1;
1011       g++;
1012     }
1013
1014   g--;
1015   g->next = NULL;
1016 }
1017
1018
1019 /* Create a duplicate intrinsic function entry for the current
1020    function, the only differences being the alternate name and
1021    a different standard if necessary. Note that we use argument
1022    lists more than once, but all argument lists are freed as a
1023    single block.  */
1024
1025 static void
1026 make_alias (const char *name, int standard)
1027 {
1028   switch (sizing)
1029     {
1030     case SZ_FUNCS:
1031       nfunc++;
1032       break;
1033
1034     case SZ_SUBS:
1035       nsub++;
1036       break;
1037
1038     case SZ_NOTHING:
1039       next_sym[0] = next_sym[-1];
1040       next_sym->name = gfc_get_string (name);
1041       next_sym->standard = standard;
1042       next_sym++;
1043       break;
1044
1045     default:
1046       break;
1047     }
1048 }
1049
1050
1051 /* Make the current subroutine noreturn.  */
1052
1053 static void
1054 make_noreturn (void)
1055 {
1056   if (sizing == SZ_NOTHING)
1057     next_sym[-1].noreturn = 1;
1058 }
1059
1060
1061 /* Add intrinsic functions.  */
1062
1063 static void
1064 add_functions (void)
1065 {
1066   /* Argument names as in the standard (to be used as argument keywords).  */
1067   const char
1068     *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1069     *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1070     *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1071     *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1072     *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1073     *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1074     *p = "p", *ar = "array", *shp = "shape", *src = "source",
1075     *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1076     *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1077     *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1078     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1079     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1080     *num = "number", *tm = "time", *nm = "name", *md = "mode",
1081     *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
1082     *ca = "coarray", *sub = "sub";
1083
1084   int di, dr, dd, dl, dc, dz, ii;
1085
1086   di = gfc_default_integer_kind;
1087   dr = gfc_default_real_kind;
1088   dd = gfc_default_double_kind;
1089   dl = gfc_default_logical_kind;
1090   dc = gfc_default_character_kind;
1091   dz = gfc_default_complex_kind;
1092   ii = gfc_index_integer_kind;
1093
1094   add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1095              gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1096              a, BT_REAL, dr, REQUIRED);
1097
1098   add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1099              NULL, gfc_simplify_abs, gfc_resolve_abs,
1100              a, BT_INTEGER, di, REQUIRED);
1101
1102   add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1103              gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1104              a, BT_REAL, dd, REQUIRED);
1105
1106   add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1107              NULL, gfc_simplify_abs, gfc_resolve_abs,
1108              a, BT_COMPLEX, dz, REQUIRED);
1109
1110   add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1111              NULL, gfc_simplify_abs, gfc_resolve_abs,
1112              a, BT_COMPLEX, dd, REQUIRED);
1113
1114   make_alias ("cdabs", GFC_STD_GNU);
1115
1116   make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1117
1118   /* The checking function for ACCESS is called gfc_check_access_func
1119      because the name gfc_check_access is already used in module.c.  */
1120   add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1121              gfc_check_access_func, NULL, gfc_resolve_access,
1122              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1123
1124   make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1125
1126   add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1127              BT_CHARACTER, dc, GFC_STD_F95,
1128              gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1129              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1130
1131   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1132
1133   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1134              gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1135              x, BT_REAL, dr, REQUIRED);
1136
1137   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1138              gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1139              x, BT_REAL, dd, REQUIRED);
1140
1141   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1142
1143   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1144              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1145              gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1146
1147   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1148              gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1149              x, BT_REAL, dd, REQUIRED);
1150
1151   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1152
1153   add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1154              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1155              gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1156
1157   make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1158
1159   add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1160              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1161              gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1162
1163   make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1164
1165   add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1166              gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1167              z, BT_COMPLEX, dz, REQUIRED);
1168
1169   make_alias ("imag", GFC_STD_GNU);
1170   make_alias ("imagpart", GFC_STD_GNU);
1171
1172   add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1173              NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1174              z, BT_COMPLEX, dd, REQUIRED);
1175
1176   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1177
1178   add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1179              gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1180              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1181
1182   add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1183              NULL, gfc_simplify_dint, gfc_resolve_dint,
1184              a, BT_REAL, dd, REQUIRED);
1185
1186   make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1187
1188   add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1189              gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1190              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1191
1192   make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1193
1194   add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1195              gfc_check_allocated, NULL, NULL,
1196              ar, BT_UNKNOWN, 0, REQUIRED);
1197
1198   make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1199
1200   add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1201              gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1202              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1203
1204   add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1205              NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1206              a, BT_REAL, dd, REQUIRED);
1207
1208   make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1209
1210   add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1211              gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1212              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1213
1214   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1215
1216   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1217              gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1218              x, BT_REAL, dr, REQUIRED);
1219
1220   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1221              gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1222              x, BT_REAL, dd, REQUIRED);
1223
1224   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1225
1226   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1227              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1228              gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1229
1230   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1231              gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1232              x, BT_REAL, dd, REQUIRED);
1233
1234   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1235
1236   add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1237              GFC_STD_F95, gfc_check_associated, NULL, NULL,
1238              pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1239
1240   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1241
1242   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1243              gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1244              x, BT_REAL, dr, REQUIRED);
1245
1246   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1247              gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1248              x, BT_REAL, dd, REQUIRED);
1249
1250   /* Two-argument version of atan, equivalent to atan2.  */
1251   add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1252              gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1253              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1254
1255   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1256
1257   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1258              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1259              gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1260
1261   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1262              gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1263              x, BT_REAL, dd, REQUIRED);
1264
1265   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1266
1267   add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1268              gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1269              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1270
1271   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1272              gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1273              y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1274
1275   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1276
1277   /* Bessel and Neumann functions for G77 compatibility.  */
1278   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1279              gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1280              x, BT_REAL, dr, REQUIRED);
1281
1282   make_alias ("bessel_j0", GFC_STD_F2008);
1283
1284   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1285              gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1286              x, BT_REAL, dd, REQUIRED);
1287
1288   make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1289
1290   add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1291              gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1292              x, BT_REAL, dr, REQUIRED);
1293
1294   make_alias ("bessel_j1", GFC_STD_F2008);
1295
1296   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1297              gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1298              x, BT_REAL, dd, REQUIRED);
1299
1300   make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1301
1302   add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1303              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1304              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1305
1306   make_alias ("bessel_jn", GFC_STD_F2008);
1307
1308   add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1309              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1310              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1311
1312   make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1313
1314   add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1315              gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1316              x, BT_REAL, dr, REQUIRED);
1317
1318   make_alias ("bessel_y0", GFC_STD_F2008);
1319
1320   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1321              gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1322              x, BT_REAL, dd, REQUIRED);
1323
1324   make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1325
1326   add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1327              gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1328              x, BT_REAL, dr, REQUIRED);
1329
1330   make_alias ("bessel_y1", GFC_STD_F2008);
1331
1332   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1333              gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1334              x, BT_REAL, dd, REQUIRED);
1335
1336   make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1337
1338   add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1339              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1340              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1341
1342   make_alias ("bessel_yn", GFC_STD_F2008);
1343
1344   add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1345              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1346              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1347
1348   make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1349
1350   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1351              gfc_check_i, gfc_simplify_bit_size, NULL,
1352              i, BT_INTEGER, di, REQUIRED);
1353
1354   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1355
1356   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1357              gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1358              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1359
1360   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1361
1362   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1363              gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1364              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1365
1366   make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1367
1368   add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1369              gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1370              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1371
1372   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1373
1374   add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1375              GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1376              nm, BT_CHARACTER, dc, REQUIRED);
1377
1378   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1379
1380   add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1381              gfc_check_chmod, NULL, gfc_resolve_chmod,
1382              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1383
1384   make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1385
1386   add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1387              gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1388              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1389              kind, BT_INTEGER, di, OPTIONAL);
1390
1391   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1392
1393   add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1394              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1395
1396   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1397                 GFC_STD_F2003);
1398
1399   add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1400              gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1401              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1402
1403   make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1404
1405   /* Making dcmplx a specific of cmplx causes cmplx to return a double
1406      complex instead of the default complex.  */
1407
1408   add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1409              gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1410              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1411
1412   make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1413
1414   add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1415              gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1416              z, BT_COMPLEX, dz, REQUIRED);
1417
1418   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1419              NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1420              z, BT_COMPLEX, dd, REQUIRED);
1421
1422   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1423
1424   add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1425              gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1426              x, BT_REAL, dr, REQUIRED);
1427
1428   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1429              gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1430              x, BT_REAL, dd, REQUIRED);
1431
1432   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1433              NULL, gfc_simplify_cos, gfc_resolve_cos,
1434              x, BT_COMPLEX, dz, REQUIRED);
1435
1436   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1437              NULL, gfc_simplify_cos, gfc_resolve_cos,
1438              x, BT_COMPLEX, dd, REQUIRED);
1439
1440   make_alias ("cdcos", GFC_STD_GNU);
1441
1442   make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1443
1444   add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1445              gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1446              x, BT_REAL, dr, REQUIRED);
1447
1448   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1449              gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1450              x, BT_REAL, dd, REQUIRED);
1451
1452   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1453
1454   add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1455              BT_INTEGER, di, GFC_STD_F95,
1456              gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1457              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1458              kind, BT_INTEGER, di, OPTIONAL);
1459
1460   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1461
1462   add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1463              gfc_check_cshift, NULL, gfc_resolve_cshift,
1464              ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1465              dm, BT_INTEGER, ii, OPTIONAL);
1466
1467   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1468
1469   add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1470               gfc_check_ctime, NULL, gfc_resolve_ctime,
1471               tm, BT_INTEGER, di, REQUIRED);
1472
1473   make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1474
1475   add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1476              gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1477              a, BT_REAL, dr, REQUIRED);
1478
1479   make_alias ("dfloat", GFC_STD_GNU);
1480
1481   make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1482
1483   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1484              gfc_check_digits, gfc_simplify_digits, NULL,
1485              x, BT_UNKNOWN, dr, REQUIRED);
1486
1487   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1488
1489   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1490              gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1491              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1492
1493   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1494              NULL, gfc_simplify_dim, gfc_resolve_dim,
1495              x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1496
1497   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1498              gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1499              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1500
1501   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1502
1503   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1504              GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1505              va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1506
1507   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1508
1509   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1510              gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1511              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1512
1513   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1514
1515   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1516              NULL, NULL, NULL,
1517              a, BT_COMPLEX, dd, REQUIRED);
1518
1519   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1520
1521   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1522              gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1523              ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1524              bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1525
1526   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1527
1528   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1529              gfc_check_x, gfc_simplify_epsilon, NULL,
1530              x, BT_REAL, dr, REQUIRED);
1531
1532   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1533
1534   /* G77 compatibility for the ERF() and ERFC() functions.  */
1535   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1536              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1537              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1538
1539   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1540              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1541              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1542
1543   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1544
1545   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1546              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1547              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1548
1549   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1550              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1551              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1552
1553   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1554
1555   add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1556              BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1557              gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1558              dr, REQUIRED);
1559
1560   make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1561
1562   /* G77 compatibility */
1563   add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1564              gfc_check_dtime_etime, NULL, NULL,
1565              x, BT_REAL, 4, REQUIRED);
1566
1567   make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1568
1569   add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1570              gfc_check_dtime_etime, NULL, NULL,
1571              x, BT_REAL, 4, REQUIRED);
1572
1573   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1574
1575   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
1576              gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1577              x, BT_REAL, dr, REQUIRED);
1578
1579   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1580              gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1581              x, BT_REAL, dd, REQUIRED);
1582
1583   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1584              NULL, gfc_simplify_exp, gfc_resolve_exp,
1585              x, BT_COMPLEX, dz, REQUIRED);
1586
1587   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1588              NULL, gfc_simplify_exp, gfc_resolve_exp,
1589              x, BT_COMPLEX, dd, REQUIRED);
1590
1591   make_alias ("cdexp", GFC_STD_GNU);
1592
1593   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1594
1595   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1596              gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1597              x, BT_REAL, dr, REQUIRED);
1598
1599   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1600
1601   add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1602              ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1603              gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1604              a, BT_UNKNOWN, 0, REQUIRED,
1605              mo, BT_UNKNOWN, 0, REQUIRED);
1606
1607   add_sym_0 ("fdate",  GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1608              NULL, NULL, gfc_resolve_fdate);
1609
1610   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1611
1612   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1613              gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1614              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1615
1616   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1617
1618   /* G77 compatible fnum */
1619   add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1620              gfc_check_fnum, NULL, gfc_resolve_fnum,
1621              ut, BT_INTEGER, di, REQUIRED);
1622
1623   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1624
1625   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1626              gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1627              x, BT_REAL, dr, REQUIRED);
1628
1629   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1630
1631   add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1632              GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1633              ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1634
1635   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1636
1637   add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1638              gfc_check_ftell, NULL, gfc_resolve_ftell,
1639              ut, BT_INTEGER, di, REQUIRED);
1640
1641   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1642
1643   add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1644              gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1645              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1646
1647   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1648
1649   add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1650              gfc_check_fgetput, NULL, gfc_resolve_fget,
1651              c, BT_CHARACTER, dc, REQUIRED);
1652
1653   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1654
1655   add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1656              gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1657              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1658
1659   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1660
1661   add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1662              gfc_check_fgetput, NULL, gfc_resolve_fput,
1663              c, BT_CHARACTER, dc, REQUIRED);
1664
1665   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1666
1667   add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1668              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1669              gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1670
1671   add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1672              gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1673              x, BT_REAL, dr, REQUIRED);
1674
1675   make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1676
1677   /* Unix IDs (g77 compatibility)  */
1678   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,  GFC_STD_GNU,
1679              NULL, NULL, gfc_resolve_getcwd,
1680              c, BT_CHARACTER, dc, REQUIRED);
1681
1682   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1683
1684   add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1685              NULL, NULL, gfc_resolve_getgid);
1686
1687   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1688
1689   add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1690              NULL, NULL, gfc_resolve_getpid);
1691
1692   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1693
1694   add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1695              NULL, NULL, gfc_resolve_getuid);
1696
1697   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1698
1699   add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1700              gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1701              a, BT_CHARACTER, dc, REQUIRED);
1702
1703   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1704
1705   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1706              gfc_check_huge, gfc_simplify_huge, NULL,
1707              x, BT_UNKNOWN, dr, REQUIRED);
1708
1709   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1710
1711   add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1712              BT_REAL, dr, GFC_STD_F2008,
1713              gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1714              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1715
1716   make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1717
1718   add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1719              BT_INTEGER, di, GFC_STD_F95,
1720              gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1721              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1722
1723   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1724
1725   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1726              gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1727              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1728
1729   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1730
1731   add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1732              gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1733              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1734
1735   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1736
1737   add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1738              NULL, NULL, NULL);
1739
1740   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1741
1742   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1743              gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1744              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1745
1746   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1747
1748   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1749              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1750              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1751              ln, BT_INTEGER, di, REQUIRED);
1752
1753   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1754
1755   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1756              gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1757              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1758
1759   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1760
1761   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1762              BT_INTEGER, di, GFC_STD_F77,
1763              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1764              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1765
1766   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1767
1768   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1769              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1770              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1771
1772   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1773
1774   add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1775              gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1776              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1777
1778   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1779
1780   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1781              NULL, NULL, gfc_resolve_ierrno);
1782
1783   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1784
1785   add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1786              gfc_check_image_index, gfc_simplify_image_index, NULL,
1787              ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1788
1789   /* The resolution function for INDEX is called gfc_resolve_index_func
1790      because the name gfc_resolve_index is already used in resolve.c.  */
1791   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1792              BT_INTEGER, di, GFC_STD_F77,
1793              gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1794              stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1795              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1796
1797   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1798
1799   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1800              gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1801              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1802
1803   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1804              NULL, gfc_simplify_ifix, NULL,
1805              a, BT_REAL, dr, REQUIRED);
1806
1807   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1808              NULL, gfc_simplify_idint, NULL,
1809              a, BT_REAL, dd, REQUIRED);
1810
1811   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1812
1813   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1814              gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1815              a, BT_REAL, dr, REQUIRED);
1816
1817   make_alias ("short", GFC_STD_GNU);
1818
1819   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1820
1821   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1822              gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1823              a, BT_REAL, dr, REQUIRED);
1824
1825   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1826
1827   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1828              gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1829              a, BT_REAL, dr, REQUIRED);
1830
1831   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1832
1833   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1834              gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1835              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1836
1837   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1838
1839   add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1840              gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1841              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1842
1843   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1844
1845   /* The following function is for G77 compatibility.  */
1846   add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1847              gfc_check_irand, NULL, NULL,
1848              i, BT_INTEGER, 4, OPTIONAL);
1849
1850   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1851
1852   add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1853              gfc_check_isatty, NULL, gfc_resolve_isatty,
1854              ut, BT_INTEGER, di, REQUIRED);
1855
1856   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1857
1858   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1859              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1860              gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1861              i, BT_INTEGER, 0, REQUIRED);
1862
1863   make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1864
1865   add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1866              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1867              gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1868              i, BT_INTEGER, 0, REQUIRED);
1869
1870   make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1871
1872   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1873              BT_LOGICAL, dl, GFC_STD_GNU,
1874              gfc_check_isnan, gfc_simplify_isnan, NULL,
1875              x, BT_REAL, 0, REQUIRED);
1876
1877   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1878
1879   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1880              gfc_check_ishft, NULL, gfc_resolve_rshift,
1881              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1882
1883   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1884
1885   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1886              gfc_check_ishft, NULL, gfc_resolve_lshift,
1887              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1888
1889   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1890
1891   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1892              gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1893              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1894
1895   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1896
1897   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1898              gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1899              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1900              sz, BT_INTEGER, di, OPTIONAL);
1901
1902   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1903
1904   add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1905              gfc_check_kill, NULL, gfc_resolve_kill,
1906              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1907
1908   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1909
1910   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1911              gfc_check_kind, gfc_simplify_kind, NULL,
1912              x, BT_REAL, dr, REQUIRED);
1913
1914   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1915
1916   add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1917              BT_INTEGER, di, GFC_STD_F95,
1918              gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1919              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1920              kind, BT_INTEGER, di, OPTIONAL);
1921
1922   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1923
1924   add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
1925              BT_INTEGER, di, GFC_STD_F95,
1926              gfc_check_lcobound, gfc_simplify_lcobound, NULL,
1927              ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1928              kind, BT_INTEGER, di, OPTIONAL);
1929
1930   make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F95);
1931
1932   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1933              BT_INTEGER, di, GFC_STD_F2008,
1934              gfc_check_i, gfc_simplify_leadz, NULL,
1935              i, BT_INTEGER, di, REQUIRED);
1936
1937   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1938
1939   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1940              BT_INTEGER, di, GFC_STD_F77,
1941              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1942              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1943
1944   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1945
1946   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1947              BT_INTEGER, di, GFC_STD_F95,
1948              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1949              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1950
1951   make_alias ("lnblnk", GFC_STD_GNU);
1952
1953   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1954
1955   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1956              dr, GFC_STD_GNU,
1957              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1958              x, BT_REAL, dr, REQUIRED);
1959
1960   make_alias ("log_gamma", GFC_STD_F2008);
1961
1962   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1963              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1964              x, BT_REAL, dr, REQUIRED);
1965
1966   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1967              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1968              x, BT_REAL, dr, REQUIRED);
1969
1970   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1971
1972
1973   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1974              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1975              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1976
1977   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1978
1979   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1980              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1981              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1982
1983   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1984
1985   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1986              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1987              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1988
1989   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1990
1991   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1992              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1993              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1994
1995   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1996
1997   add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1998              GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1999              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2000
2001   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2002
2003   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2004              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2005              x, BT_REAL, dr, REQUIRED);
2006
2007   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2008              NULL, gfc_simplify_log, gfc_resolve_log,
2009              x, BT_REAL, dr, REQUIRED);
2010
2011   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2012              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2013              x, BT_REAL, dd, REQUIRED);
2014
2015   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2016              NULL, gfc_simplify_log, gfc_resolve_log,
2017              x, BT_COMPLEX, dz, REQUIRED);
2018
2019   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
2020              NULL, gfc_simplify_log, gfc_resolve_log,
2021              x, BT_COMPLEX, dd, REQUIRED);
2022
2023   make_alias ("cdlog", GFC_STD_GNU);
2024
2025   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2026
2027   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2028              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2029              x, BT_REAL, dr, REQUIRED);
2030
2031   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2032              NULL, gfc_simplify_log10, gfc_resolve_log10,
2033              x, BT_REAL, dr, REQUIRED);
2034
2035   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2036              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2037              x, BT_REAL, dd, REQUIRED);
2038
2039   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2040
2041   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2042              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2043              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2044
2045   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2046
2047   add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2048              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2049              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2050
2051   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2052
2053   add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2054              GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2055              sz, BT_INTEGER, di, REQUIRED);
2056
2057   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2058
2059   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2060              gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2061              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2062
2063   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2064
2065   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2066      int(max).  The max function must take at least two arguments.  */
2067
2068   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2069              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2070              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2071
2072   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2073              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2074              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2075
2076   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2077              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2078              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2079
2080   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2081              gfc_check_min_max_real, gfc_simplify_max, NULL,
2082              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2083
2084   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2085              gfc_check_min_max_real, gfc_simplify_max, NULL,
2086              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2087
2088   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2089              gfc_check_min_max_double, gfc_simplify_max, NULL,
2090              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2091
2092   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2093
2094   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2095              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2096              x, BT_UNKNOWN, dr, REQUIRED);
2097
2098   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2099
2100   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2101                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2102                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2103                msk, BT_LOGICAL, dl, OPTIONAL);
2104
2105   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2106
2107   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2108                 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2109                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2110                 msk, BT_LOGICAL, dl, OPTIONAL);
2111
2112   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2113
2114   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2115              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2116
2117   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2118
2119   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2120              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2121
2122   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2123
2124   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2125              gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2126              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2127              msk, BT_LOGICAL, dl, REQUIRED);
2128
2129   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2130
2131   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2132      int(min).  */
2133
2134   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2135               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2136               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2137
2138   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2139               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2140               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2141
2142   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2143               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2144               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2145
2146   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2147               gfc_check_min_max_real, gfc_simplify_min, NULL,
2148               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2149
2150   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2151               gfc_check_min_max_real, gfc_simplify_min, NULL,
2152               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2153
2154   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2155               gfc_check_min_max_double, gfc_simplify_min, NULL,
2156               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2157
2158   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2159
2160   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2161              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2162              x, BT_UNKNOWN, dr, REQUIRED);
2163
2164   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2165
2166   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2167                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2168                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2169                msk, BT_LOGICAL, dl, OPTIONAL);
2170
2171   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2172
2173   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2174                 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2175                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2176                 msk, BT_LOGICAL, dl, OPTIONAL);
2177
2178   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2179
2180   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2181              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2182              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2183
2184   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2185              NULL, gfc_simplify_mod, gfc_resolve_mod,
2186              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2187
2188   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2189              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2190              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2191
2192   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2193
2194   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2195              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2196              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2197
2198   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2199
2200   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2201              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2202              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2203
2204   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2205
2206   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2207              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2208              a, BT_CHARACTER, dc, REQUIRED);
2209
2210   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2211
2212   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2213              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2214              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2215
2216   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2217              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2218              a, BT_REAL, dd, REQUIRED);
2219
2220   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2221
2222   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2223              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2224              i, BT_INTEGER, di, REQUIRED);
2225
2226   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2227
2228   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2229              gfc_check_null, gfc_simplify_null, NULL,
2230              mo, BT_INTEGER, di, OPTIONAL);
2231
2232   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2233
2234   add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2235              NULL, gfc_simplify_num_images, NULL);
2236
2237   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2238              gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2239              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2240              v, BT_REAL, dr, OPTIONAL);
2241
2242   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2243
2244   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2245              gfc_check_precision, gfc_simplify_precision, NULL,
2246              x, BT_UNKNOWN, 0, REQUIRED);
2247
2248   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2249
2250   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2251                     BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2252                     a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2253
2254   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2255
2256   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2257                 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2258                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2259                 msk, BT_LOGICAL, dl, OPTIONAL);
2260
2261   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2262
2263   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2264              gfc_check_radix, gfc_simplify_radix, NULL,
2265              x, BT_UNKNOWN, 0, REQUIRED);
2266
2267   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2268
2269   /* The following function is for G77 compatibility.  */
2270   add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2271              gfc_check_rand, NULL, NULL,
2272              i, BT_INTEGER, 4, OPTIONAL);
2273
2274   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2275      use slightly different shoddy multiplicative congruential PRNG.  */
2276   make_alias ("ran", GFC_STD_GNU);
2277
2278   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2279
2280   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2281              gfc_check_range, gfc_simplify_range, NULL,
2282              x, BT_REAL, dr, REQUIRED);
2283
2284   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2285
2286   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2287              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2288              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2289
2290   /* This provides compatibility with g77.  */
2291   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2292              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2293              a, BT_UNKNOWN, dr, REQUIRED);
2294
2295   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2296              gfc_check_i, gfc_simplify_float, NULL,
2297              a, BT_INTEGER, di, REQUIRED);
2298
2299   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2300              NULL, gfc_simplify_sngl, NULL,
2301              a, BT_REAL, dd, REQUIRED);
2302
2303   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2304
2305   add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2306              GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2307              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2308
2309   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2310
2311   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2312              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2313              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2314
2315   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2316
2317   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2318              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2319              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2320              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2321
2322   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2323
2324   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2325              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2326              x, BT_REAL, dr, REQUIRED);
2327
2328   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2329
2330   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2331              BT_LOGICAL, dl, GFC_STD_F2003,
2332              gfc_check_same_type_as, NULL, NULL,
2333              a, BT_UNKNOWN, 0, REQUIRED,
2334              b, BT_UNKNOWN, 0, REQUIRED);
2335
2336   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2337              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2338              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2339
2340   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2341
2342   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2343              BT_INTEGER, di, GFC_STD_F95,
2344              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2345              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2346              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2347
2348   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2349
2350   /* Added for G77 compatibility garbage.  */
2351   add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2352              NULL, NULL, NULL);
2353
2354   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2355
2356   /* Added for G77 compatibility.  */
2357   add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2358              gfc_check_secnds, NULL, gfc_resolve_secnds,
2359              x, BT_REAL, dr, REQUIRED);
2360
2361   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2362
2363   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2364              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2365              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2366              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2367
2368   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2369
2370   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2371              GFC_STD_F95, gfc_check_selected_int_kind,
2372              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2373
2374   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2375
2376   add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2377              GFC_STD_F95, gfc_check_selected_real_kind,
2378              gfc_simplify_selected_real_kind, NULL,
2379              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2380
2381   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2382
2383   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2384              gfc_check_set_exponent, gfc_simplify_set_exponent,
2385              gfc_resolve_set_exponent,
2386              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2387
2388   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2389
2390   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2391              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2392              src, BT_REAL, dr, REQUIRED);
2393
2394   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2395
2396   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2397              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2398              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2399
2400   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2401              NULL, gfc_simplify_sign, gfc_resolve_sign,
2402              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2403
2404   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2405              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2406              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2407
2408   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2409
2410   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2411              gfc_check_signal, NULL, gfc_resolve_signal,
2412              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2413
2414   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2415
2416   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2417              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2418              x, BT_REAL, dr, REQUIRED);
2419
2420   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2421              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2422              x, BT_REAL, dd, REQUIRED);
2423
2424   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2425              NULL, gfc_simplify_sin, gfc_resolve_sin,
2426              x, BT_COMPLEX, dz, REQUIRED);
2427
2428   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2429              NULL, gfc_simplify_sin, gfc_resolve_sin,
2430              x, BT_COMPLEX, dd, REQUIRED);
2431
2432   make_alias ("cdsin", GFC_STD_GNU);
2433
2434   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2435
2436   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2437              gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2438              x, BT_REAL, dr, REQUIRED);
2439
2440   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2441              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2442              x, BT_REAL, dd, REQUIRED);
2443
2444   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2445
2446   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2447              BT_INTEGER, di, GFC_STD_F95,
2448              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2449              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2450              kind, BT_INTEGER, di, OPTIONAL);
2451
2452   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2453
2454   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2455              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2456              x, BT_UNKNOWN, 0, REQUIRED);
2457
2458   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2459   make_alias ("c_sizeof", GFC_STD_F2008);
2460
2461   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2462              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2463              x, BT_REAL, dr, REQUIRED);
2464
2465   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2466
2467   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2468              gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2469              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2470              ncopies, BT_INTEGER, di, REQUIRED);
2471
2472   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2473
2474   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2475              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2476              x, BT_REAL, dr, REQUIRED);
2477
2478   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2479              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2480              x, BT_REAL, dd, REQUIRED);
2481
2482   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2483              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2484              x, BT_COMPLEX, dz, REQUIRED);
2485
2486   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2487              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2488              x, BT_COMPLEX, dd, REQUIRED);
2489
2490   make_alias ("cdsqrt", GFC_STD_GNU);
2491
2492   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2493
2494   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2495              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2496              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2497
2498   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2499
2500   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2501                 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2502                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2503                 msk, BT_LOGICAL, dl, OPTIONAL);
2504
2505   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2506
2507   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2508              GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2509              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2510
2511   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2512
2513   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2514              GFC_STD_GNU, NULL, NULL, NULL,
2515              com, BT_CHARACTER, dc, REQUIRED);
2516
2517   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2518
2519   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2520              gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2521              x, BT_REAL, dr, REQUIRED);
2522
2523   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2524              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2525              x, BT_REAL, dd, REQUIRED);
2526
2527   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2528
2529   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2530              gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2531              x, BT_REAL, dr, REQUIRED);
2532
2533   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2534              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2535              x, BT_REAL, dd, REQUIRED);
2536
2537   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2538
2539   add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2540              gfc_check_this_image, gfc_simplify_this_image, NULL,
2541              ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2542
2543   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2544              NULL, NULL, gfc_resolve_time);
2545
2546   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2547
2548   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2549              NULL, NULL, gfc_resolve_time8);
2550
2551   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2552
2553   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2554              gfc_check_x, gfc_simplify_tiny, NULL,
2555              x, BT_REAL, dr, REQUIRED);
2556
2557   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2558
2559   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2560              BT_INTEGER, di, GFC_STD_F2008,
2561              gfc_check_i, gfc_simplify_trailz, NULL,
2562              i, BT_INTEGER, di, REQUIRED);
2563
2564   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2565
2566   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2567              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2568              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2569              sz, BT_INTEGER, di, OPTIONAL);
2570
2571   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2572
2573   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2574              gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2575              m, BT_REAL, dr, REQUIRED);
2576
2577   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2578
2579   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2580              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2581              stg, BT_CHARACTER, dc, REQUIRED);
2582
2583   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2584
2585   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2586              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2587              ut, BT_INTEGER, di, REQUIRED);
2588
2589   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2590
2591   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2592              BT_INTEGER, di, GFC_STD_F95,
2593              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2594              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2595              kind, BT_INTEGER, di, OPTIONAL);
2596
2597   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2598
2599   add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2600             BT_INTEGER, di, GFC_STD_F95,
2601             gfc_check_ucobound, gfc_simplify_ucobound, NULL,
2602             ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2603             kind, BT_INTEGER, di, OPTIONAL);
2604
2605   make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F95);
2606
2607   /* g77 compatibility for UMASK.  */
2608   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2609              GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2610              msk, BT_INTEGER, di, REQUIRED);
2611
2612   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2613
2614   /* g77 compatibility for UNLINK.  */
2615   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2616              gfc_check_unlink, NULL, gfc_resolve_unlink,
2617              "path", BT_CHARACTER, dc, REQUIRED);
2618
2619   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2620
2621   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2622              gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2623              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2624              f, BT_REAL, dr, REQUIRED);
2625
2626   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2627
2628   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2629              BT_INTEGER, di, GFC_STD_F95,
2630              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2631              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2632              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2633
2634   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2635
2636   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2637              GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2638              x, BT_UNKNOWN, 0, REQUIRED);
2639
2640   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2641 }
2642
2643
2644 /* Add intrinsic subroutines.  */
2645
2646 static void
2647 add_subroutines (void)
2648 {
2649   /* Argument names as in the standard (to be used as argument keywords).  */
2650   const char
2651     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2652     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2653     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2654     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2655     *com = "command", *length = "length", *st = "status",
2656     *val = "value", *num = "number", *name = "name",
2657     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2658     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2659     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2660     *p2 = "path2", *msk = "mask", *old = "old";
2661
2662   int di, dr, dc, dl, ii;
2663
2664   di = gfc_default_integer_kind;
2665   dr = gfc_default_real_kind;
2666   dc = gfc_default_character_kind;
2667   dl = gfc_default_logical_kind;
2668   ii = gfc_index_integer_kind;
2669
2670   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2671
2672   make_noreturn();
2673
2674   add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2675                      GFC_STD_F95, gfc_check_cpu_time, NULL,
2676                      gfc_resolve_cpu_time,
2677                      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2678
2679   /* More G77 compatibility garbage.  */
2680   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2681               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2682               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2683
2684   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2685               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2686               vl, BT_INTEGER, 4, REQUIRED);
2687
2688   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2689               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2690               vl, BT_INTEGER, 4, REQUIRED);
2691
2692   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2693               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2694               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2695
2696   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2697               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2698               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2699
2700   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2701               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2702               tm, BT_REAL, dr, REQUIRED);
2703
2704   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2705               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2706               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2707
2708   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2709               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2710               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2711               st, BT_INTEGER, di, OPTIONAL);
2712
2713   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2714               GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2715               dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2716               tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2717               zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2718               vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2719
2720   /* More G77 compatibility garbage.  */
2721   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2722               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2723               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2724
2725   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2726               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2727               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2728
2729   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2730               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2731               dt, BT_CHARACTER, dc, REQUIRED);
2732
2733   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2734               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2735               dc, REQUIRED);
2736
2737   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2738               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2739               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2740
2741   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2742               NULL, NULL, NULL,
2743               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2744               REQUIRED);
2745
2746   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2747               gfc_check_getarg, NULL, gfc_resolve_getarg,
2748               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2749
2750   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2751               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2752               dc, REQUIRED);
2753
2754   /* F2003 commandline routines.  */
2755
2756   add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2757                      0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2758                      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2759                      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2760                      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2761
2762   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2763               BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2764               gfc_resolve_get_command_argument,
2765               num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2766               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2767               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2768               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2769
2770   /* F2003 subroutine to get environment variables.  */
2771
2772   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2773               NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2774               NULL, NULL, gfc_resolve_get_environment_variable,
2775               name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2776               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2777               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2778               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2779               trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2780
2781   add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2782                      GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2783                      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2784                      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2785
2786   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2787               GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2788               gfc_resolve_mvbits,
2789               f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2790               fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2791               ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2792               t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2793               tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2794
2795   add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2796                      BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2797                      gfc_resolve_random_number,
2798                      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2799
2800   add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2801                      BT_UNKNOWN, 0, GFC_STD_F95,
2802                      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2803                      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2804                      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2805                      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2806
2807   /* More G77 compatibility garbage.  */
2808   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2809               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2810               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2811               st, BT_INTEGER, di, OPTIONAL);
2812
2813   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2814               gfc_check_srand, NULL, gfc_resolve_srand,
2815               "seed", BT_INTEGER, 4, REQUIRED);
2816
2817   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2818               gfc_check_exit, NULL, gfc_resolve_exit,
2819               st, BT_INTEGER, di, OPTIONAL);
2820
2821   make_noreturn();
2822
2823   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2824               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2825               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2826               st, BT_INTEGER, di, OPTIONAL);
2827
2828   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2829               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2830               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2831
2832   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2833               gfc_check_flush, NULL, gfc_resolve_flush,
2834               ut, BT_INTEGER, di, OPTIONAL);
2835
2836   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2837               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2838               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2839               st, BT_INTEGER, di, OPTIONAL);
2840
2841   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2842               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2843               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2844
2845   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2846               gfc_check_free, NULL, gfc_resolve_free,
2847               ptr, BT_INTEGER, ii, REQUIRED);
2848
2849   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2850               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2851               ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2852               of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2853               whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2854               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2855
2856   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2857               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2858               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2859
2860   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2861               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2862               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2863
2864   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2865               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2866               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2867
2868   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2869               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2870               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2871               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2872
2873   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2874               gfc_check_perror, NULL, gfc_resolve_perror,
2875               "string", BT_CHARACTER, dc, REQUIRED);
2876
2877   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2878               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2879               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2880               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2881
2882   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2883               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2884               sec, BT_INTEGER, di, REQUIRED);
2885
2886   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2887               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2888               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2889               st, BT_INTEGER, di, OPTIONAL);
2890
2891   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2892               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2893               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2894               st, BT_INTEGER, di, OPTIONAL);
2895
2896   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2897               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2898               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2899               st, BT_INTEGER, di, OPTIONAL);
2900
2901   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2902               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2903               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2904               st, BT_INTEGER, di, OPTIONAL);
2905
2906   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2907               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2908               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2909               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2910
2911   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2912               NULL, NULL, gfc_resolve_system_sub,
2913               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2914
2915   add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2916                      BT_UNKNOWN, 0, GFC_STD_F95,
2917                      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2918                      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2919                      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2920                      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2921
2922   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2923               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2924               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2925
2926   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2927               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2928               msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2929
2930   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2931               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2932               "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2933 }
2934
2935
2936 /* Add a function to the list of conversion symbols.  */
2937
2938 static void
2939 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2940 {
2941   gfc_typespec from, to;
2942   gfc_intrinsic_sym *sym;
2943
2944   if (sizing == SZ_CONVS)
2945     {
2946       nconv++;
2947       return;
2948     }
2949
2950   gfc_clear_ts (&from);
2951   from.type = from_type;
2952   from.kind = from_kind;
2953
2954   gfc_clear_ts (&to);
2955   to.type = to_type;
2956   to.kind = to_kind;
2957
2958   sym = conversion + nconv;
2959
2960   sym->name = conv_name (&from, &to);
2961   sym->lib_name = sym->name;
2962   sym->simplify.cc = gfc_convert_constant;
2963   sym->standard = standard;
2964   sym->elemental = 1;
2965   sym->conversion = 1;
2966   sym->ts = to;
2967   sym->id = GFC_ISYM_CONVERSION;
2968
2969   nconv++;
2970 }
2971
2972
2973 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2974    functions by looping over the kind tables.  */
2975
2976 static void
2977 add_conversions (void)
2978 {
2979   int i, j;
2980
2981   /* Integer-Integer conversions.  */
2982   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2983     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2984       {
2985         if (i == j)
2986           continue;
2987
2988         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2989                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2990       }
2991
2992   /* Integer-Real/Complex conversions.  */
2993   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2994     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2995       {
2996         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2997                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2998
2999         add_conv (BT_REAL, gfc_real_kinds[j].kind,
3000                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3001
3002         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3003                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3004
3005         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3006                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3007       }
3008
3009   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3010     {
3011       /* Hollerith-Integer conversions.  */
3012       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3013         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3014                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3015       /* Hollerith-Real conversions.  */
3016       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3017         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3018                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3019       /* Hollerith-Complex conversions.  */
3020       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3021         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3022                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3023
3024       /* Hollerith-Character conversions.  */
3025       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3026                   gfc_default_character_kind, GFC_STD_LEGACY);
3027
3028       /* Hollerith-Logical conversions.  */
3029       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3030         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3031                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3032     }
3033
3034   /* Real/Complex - Real/Complex conversions.  */
3035   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3036     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3037       {
3038         if (i != j)
3039           {
3040             add_conv (BT_REAL, gfc_real_kinds[i].kind,
3041                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3042
3043             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3044                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3045           }
3046
3047         add_conv (BT_REAL, gfc_real_kinds[i].kind,
3048                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3049
3050         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3051                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3052       }
3053
3054   /* Logical/Logical kind conversion.  */
3055   for (i = 0; gfc_logical_kinds[i].kind; i++)
3056     for (j = 0; gfc_logical_kinds[j].kind; j++)
3057       {
3058         if (i == j)
3059           continue;
3060
3061         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3062                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3063       }
3064
3065   /* Integer-Logical and Logical-Integer conversions.  */
3066   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3067     for (i=0; gfc_integer_kinds[i].kind; i++)
3068       for (j=0; gfc_logical_kinds[j].kind; j++)
3069         {
3070           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3071                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3072           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3073                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3074         }
3075 }
3076
3077
3078 static void
3079 add_char_conversions (void)
3080 {
3081   int n, i, j;
3082
3083   /* Count possible conversions.  */
3084   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3085     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3086       if (i != j)
3087         ncharconv++;
3088
3089   /* Allocate memory.  */
3090   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3091
3092   /* Add the conversions themselves.  */
3093   n = 0;
3094   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3095     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3096       {
3097         gfc_typespec from, to;
3098
3099         if (i == j)
3100           continue;
3101
3102         gfc_clear_ts (&from);
3103         from.type = BT_CHARACTER;
3104         from.kind = gfc_character_kinds[i].kind;
3105
3106         gfc_clear_ts (&to);
3107         to.type = BT_CHARACTER;
3108         to.kind = gfc_character_kinds[j].kind;
3109
3110         char_conversions[n].name = conv_name (&from, &to);
3111         char_conversions[n].lib_name = char_conversions[n].name;
3112         char_conversions[n].simplify.cc = gfc_convert_char_constant;
3113         char_conversions[n].standard = GFC_STD_F2003;
3114         char_conversions[n].elemental = 1;
3115         char_conversions[n].conversion = 0;
3116         char_conversions[n].ts = to;
3117         char_conversions[n].id = GFC_ISYM_CONVERSION;
3118
3119         n++;
3120       }
3121 }
3122
3123
3124 /* Initialize the table of intrinsics.  */
3125 void
3126 gfc_intrinsic_init_1 (void)
3127 {
3128   int i;
3129
3130   nargs = nfunc = nsub = nconv = 0;
3131
3132   /* Create a namespace to hold the resolved intrinsic symbols.  */
3133   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3134
3135   sizing = SZ_FUNCS;
3136   add_functions ();
3137   sizing = SZ_SUBS;
3138   add_subroutines ();
3139   sizing = SZ_CONVS;
3140   add_conversions ();
3141
3142   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3143                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3144                         + sizeof (gfc_intrinsic_arg) * nargs);
3145
3146   next_sym = functions;
3147   subroutines = functions + nfunc;
3148
3149   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3150
3151   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3152
3153   sizing = SZ_NOTHING;
3154   nconv = 0;
3155
3156   add_functions ();
3157   add_subroutines ();
3158   add_conversions ();
3159
3160   /* Character conversion intrinsics need to be treated separately.  */
3161   add_char_conversions ();
3162
3163   /* Set the pure flag.  All intrinsic functions are pure, and
3164      intrinsic subroutines are pure if they are elemental.  */
3165
3166   for (i = 0; i < nfunc; i++)
3167     functions[i].pure = 1;
3168
3169   for (i = 0; i < nsub; i++)
3170     subroutines[i].pure = subroutines[i].elemental;
3171 }
3172
3173
3174 void
3175 gfc_intrinsic_done_1 (void)
3176 {
3177   gfc_free (functions);
3178   gfc_free (conversion);
3179   gfc_free (char_conversions);
3180   gfc_free_namespace (gfc_intrinsic_namespace);
3181 }
3182
3183
3184 /******** Subroutines to check intrinsic interfaces ***********/
3185
3186 /* Given a formal argument list, remove any NULL arguments that may
3187    have been left behind by a sort against some formal argument list.  */
3188
3189 static void
3190 remove_nullargs (gfc_actual_arglist **ap)
3191 {
3192   gfc_actual_arglist *head, *tail, *next;
3193
3194   tail = NULL;
3195
3196   for (head = *ap; head; head = next)
3197     {
3198       next = head->next;
3199
3200       if (head->expr == NULL && !head->label)
3201         {
3202           head->next = NULL;
3203           gfc_free_actual_arglist (head);
3204         }
3205       else
3206         {
3207           if (tail == NULL)
3208             *ap = head;
3209           else
3210             tail->next = head;
3211
3212           tail = head;
3213           tail->next = NULL;
3214         }
3215     }
3216
3217   if (tail == NULL)
3218     *ap = NULL;
3219 }
3220
3221
3222 /* Given an actual arglist and a formal arglist, sort the actual
3223    arglist so that its arguments are in a one-to-one correspondence
3224    with the format arglist.  Arguments that are not present are given
3225    a blank gfc_actual_arglist structure.  If something is obviously
3226    wrong (say, a missing required argument) we abort sorting and
3227    return FAILURE.  */
3228
3229 static gfc_try
3230 sort_actual (const char *name, gfc_actual_arglist **ap,
3231              gfc_intrinsic_arg *formal, locus *where)
3232 {
3233   gfc_actual_arglist *actual, *a;
3234   gfc_intrinsic_arg *f;
3235
3236   remove_nullargs (ap);
3237   actual = *ap;
3238
3239   for (f = formal; f; f = f->next)
3240     f->actual = NULL;
3241
3242   f = formal;
3243   a = actual;
3244
3245   if (f == NULL && a == NULL)   /* No arguments */
3246     return SUCCESS;
3247
3248   for (;;)
3249     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3250       if (f == NULL)
3251         break;
3252       if (a == NULL)
3253         goto optional;
3254
3255       if (a->name != NULL)
3256         goto keywords;
3257
3258       f->actual = a;
3259
3260       f = f->next;
3261       a = a->next;
3262     }
3263
3264   if (a == NULL)
3265     goto do_sort;
3266
3267   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3268   return FAILURE;
3269
3270 keywords:
3271   /* Associate the remaining actual arguments, all of which have
3272      to be keyword arguments.  */
3273   for (; a; a = a->next)
3274     {
3275       for (f = formal; f; f = f->next)
3276         if (strcmp (a->name, f->name) == 0)
3277           break;
3278
3279       if (f == NULL)
3280         {
3281           if (a->name[0] == '%')
3282             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3283                        "are not allowed in this context at %L", where);
3284           else
3285             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3286                        a->name, name, where);
3287           return FAILURE;
3288         }
3289
3290       if (f->actual != NULL)
3291         {
3292           gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3293                      f->name, name, where);
3294           return FAILURE;
3295         }
3296
3297       f->actual = a;
3298     }
3299
3300 optional:
3301   /* At this point, all unmatched formal args must be optional.  */
3302   for (f = formal; f; f = f->next)
3303     {
3304       if (f->actual == NULL && f->optional == 0)
3305         {
3306           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3307                      f->name, name, where);
3308           return FAILURE;
3309         }
3310     }
3311
3312 do_sort:
3313   /* Using the formal argument list, string the actual argument list
3314      together in a way that corresponds with the formal list.  */
3315   actual = NULL;
3316
3317   for (f = formal; f; f = f->next)
3318     {
3319       if (f->actual && f->actual->label != NULL && f->ts.type)
3320         {
3321           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3322           return FAILURE;
3323         }
3324
3325       if (f->actual == NULL)
3326         {
3327           a = gfc_get_actual_arglist ();
3328           a->missing_arg_type = f->ts.type;
3329         }
3330       else
3331         a = f->actual;
3332
3333       if (actual == NULL)
3334         *ap = a;
3335       else
3336         actual->next = a;
3337
3338       actual = a;
3339     }
3340   actual->next = NULL;          /* End the sorted argument list.  */
3341
3342   return SUCCESS;
3343 }
3344
3345
3346 /* Compare an actual argument list with an intrinsic's formal argument
3347    list.  The lists are checked for agreement of type.  We don't check
3348    for arrayness here.  */
3349
3350 static gfc_try
3351 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3352                int error_flag)
3353 {
3354   gfc_actual_arglist *actual;
3355   gfc_intrinsic_arg *formal;
3356   int i;
3357
3358   formal = sym->formal;
3359   actual = *ap;
3360
3361   i = 0;
3362   for (; formal; formal = formal->next, actual = actual->next, i++)
3363     {
3364       gfc_typespec ts;
3365
3366       if (actual->expr == NULL)
3367         continue;
3368
3369       ts = formal->ts;
3370
3371       /* A kind of 0 means we don't check for kind.  */
3372       if (ts.kind == 0)
3373         ts.kind = actual->expr->ts.kind;
3374
3375       if (!gfc_compare_types (&ts, &actual->expr->ts))
3376         {
3377           if (error_flag)
3378             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3379                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3380                        gfc_current_intrinsic, &actual->expr->where,
3381                        gfc_typename (&formal->ts),
3382                        gfc_typename (&actual->expr->ts));
3383           return FAILURE;
3384         }
3385     }
3386
3387   return SUCCESS;
3388 }
3389
3390
3391 /* Given a pointer to an intrinsic symbol and an expression node that
3392    represent the function call to that subroutine, figure out the type
3393    of the result.  This may involve calling a resolution subroutine.  */
3394
3395 static void
3396 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3397 {
3398   gfc_expr *a1, *a2, *a3, *a4, *a5;
3399   gfc_actual_arglist *arg;
3400
3401   if (specific->resolve.f1 == NULL)
3402     {
3403       if (e->value.function.name == NULL)
3404         e->value.function.name = specific->lib_name;
3405
3406       if (e->ts.type == BT_UNKNOWN)
3407         e->ts = specific->ts;
3408       return;
3409     }
3410
3411   arg = e->value.function.actual;
3412
3413   /* Special case hacks for MIN and MAX.  */
3414   if (specific->resolve.f1m == gfc_resolve_max
3415       || specific->resolve.f1m == gfc_resolve_min)
3416     {
3417       (*specific->resolve.f1m) (e, arg);
3418       return;
3419     }
3420
3421   if (arg == NULL)
3422     {
3423       (*specific->resolve.f0) (e);
3424       return;
3425     }
3426
3427   a1 = arg->expr;
3428   arg = arg->next;
3429
3430   if (arg == NULL)
3431     {
3432       (*specific->resolve.f1) (e, a1);
3433       return;
3434     }
3435
3436   a2 = arg->expr;
3437   arg = arg->next;
3438
3439   if (arg == NULL)
3440     {
3441       (*specific->resolve.f2) (e, a1, a2);
3442       return;
3443     }
3444
3445   a3 = arg->expr;
3446   arg = arg->next;
3447
3448   if (arg == NULL)
3449     {
3450       (*specific->resolve.f3) (e, a1, a2, a3);
3451       return;
3452     }
3453
3454   a4 = arg->expr;
3455   arg = arg->next;
3456
3457   if (arg == NULL)
3458     {
3459       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3460       return;
3461     }
3462
3463   a5 = arg->expr;
3464   arg = arg->next;
3465
3466   if (arg == NULL)
3467     {
3468       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3469       return;
3470     }
3471
3472   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3473 }
3474
3475
3476 /* Given an intrinsic symbol node and an expression node, call the
3477    simplification function (if there is one), perhaps replacing the
3478    expression with something simpler.  We return FAILURE on an error
3479    of the simplification, SUCCESS if the simplification worked, even
3480    if nothing has changed in the expression itself.  */
3481
3482 static gfc_try
3483 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3484 {
3485   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3486   gfc_actual_arglist *arg;
3487
3488   /* Max and min require special handling due to the variable number
3489      of args.  */
3490   if (specific->simplify.f1 == gfc_simplify_min)
3491     {
3492       result = gfc_simplify_min (e);
3493       goto finish;
3494     }
3495
3496   if (specific->simplify.f1 == gfc_simplify_max)
3497     {
3498       result = gfc_simplify_max (e);
3499       goto finish;
3500     }
3501
3502   if (specific->simplify.f1 == NULL)
3503     {
3504       result = NULL;
3505       goto finish;
3506     }
3507
3508   arg = e->value.function.actual;
3509
3510   if (arg == NULL)
3511     {
3512       result = (*specific->simplify.f0) ();
3513       goto finish;
3514     }
3515
3516   a1 = arg->expr;
3517   arg = arg->next;
3518
3519   if (specific->simplify.cc == gfc_convert_constant
3520       || specific->simplify.cc == gfc_convert_char_constant)
3521     {
3522       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3523       goto finish;
3524     }
3525
3526   if (arg == NULL)
3527     result = (*specific->simplify.f1) (a1);
3528   else
3529     {
3530       a2 = arg->expr;
3531       arg = arg->next;
3532
3533       if (arg == NULL)
3534         result = (*specific->simplify.f2) (a1, a2);
3535       else
3536         {
3537           a3 = arg->expr;
3538           arg = arg->next;
3539
3540           if (arg == NULL)
3541             result = (*specific->simplify.f3) (a1, a2, a3);
3542           else
3543             {
3544               a4 = arg->expr;
3545               arg = arg->next;
3546
3547               if (arg == NULL)
3548                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3549               else
3550                 {
3551                   a5 = arg->expr;
3552                   arg = arg->next;
3553
3554                   if (arg == NULL)
3555                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3556                   else
3557                     gfc_internal_error
3558                       ("do_simplify(): Too many args for intrinsic");
3559                 }
3560             }
3561         }
3562     }
3563
3564 finish:
3565   if (result == &gfc_bad_expr)
3566     return FAILURE;
3567
3568   if (result == NULL)
3569     resolve_intrinsic (specific, e);    /* Must call at run-time */
3570   else
3571     {
3572       result->where = e->where;
3573       gfc_replace_expr (e, result);
3574     }
3575
3576   return SUCCESS;
3577 }
3578
3579
3580 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3581    error messages.  This subroutine returns FAILURE if a subroutine
3582    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3583    list cannot match any intrinsic.  */
3584
3585 static void
3586 init_arglist (gfc_intrinsic_sym *isym)
3587 {
3588   gfc_intrinsic_arg *formal;
3589   int i;
3590
3591   gfc_current_intrinsic = isym->name;
3592
3593   i = 0;
3594   for (formal = isym->formal; formal; formal = formal->next)
3595     {
3596       if (i >= MAX_INTRINSIC_ARGS)
3597         gfc_internal_error ("init_arglist(): too many arguments");
3598       gfc_current_intrinsic_arg[i++] = formal->name;
3599     }
3600 }
3601
3602
3603 /* Given a pointer to an intrinsic symbol and an expression consisting
3604    of a function call, see if the function call is consistent with the
3605    intrinsic's formal argument list.  Return SUCCESS if the expression
3606    and intrinsic match, FAILURE otherwise.  */
3607
3608 static gfc_try
3609 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3610 {
3611   gfc_actual_arglist *arg, **ap;
3612   gfc_try t;
3613
3614   ap = &expr->value.function.actual;
3615
3616   init_arglist (specific);
3617
3618   /* Don't attempt to sort the argument list for min or max.  */
3619   if (specific->check.f1m == gfc_check_min_max
3620       || specific->check.f1m == gfc_check_min_max_integer
3621       || specific->check.f1m == gfc_check_min_max_real
3622       || specific->check.f1m == gfc_check_min_max_double)
3623     return (*specific->check.f1m) (*ap);
3624
3625   if (sort_actual (specific->name, ap, specific->formal,
3626                    &expr->where) == FAILURE)
3627     return FAILURE;
3628
3629   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3630     /* This is special because we might have to reorder the argument list.  */
3631     t = gfc_check_minloc_maxloc (*ap);
3632   else if (specific->check.f3red == gfc_check_minval_maxval)
3633     /* This is also special because we also might have to reorder the
3634        argument list.  */
3635     t = gfc_check_minval_maxval (*ap);
3636   else if (specific->check.f3red == gfc_check_product_sum)
3637     /* Same here. The difference to the previous case is that we allow a
3638        general numeric type.  */
3639     t = gfc_check_product_sum (*ap);
3640   else
3641      {
3642        if (specific->check.f1 == NULL)
3643          {
3644            t = check_arglist (ap, specific, error_flag);
3645            if (t == SUCCESS)
3646              expr->ts = specific->ts;
3647          }
3648        else
3649          t = do_check (specific, *ap);
3650      }
3651
3652   /* Check conformance of elemental intrinsics.  */
3653   if (t == SUCCESS && specific->elemental)
3654     {
3655       int n = 0;
3656       gfc_expr *first_expr;
3657       arg = expr->value.function.actual;
3658
3659       /* There is no elemental intrinsic without arguments.  */
3660       gcc_assert(arg != NULL);
3661       first_expr = arg->expr;
3662
3663       for ( ; arg && arg->expr; arg = arg->next, n++)
3664         if (gfc_check_conformance (first_expr, arg->expr,
3665                                    "arguments '%s' and '%s' for "
3666                                    "intrinsic '%s'",
3667                                    gfc_current_intrinsic_arg[0],
3668                                    gfc_current_intrinsic_arg[n],
3669                                    gfc_current_intrinsic) == FAILURE)
3670           return FAILURE;
3671     }
3672
3673   if (t == FAILURE)
3674     remove_nullargs (ap);
3675
3676   return t;
3677 }
3678
3679
3680 /* Check whether an intrinsic belongs to whatever standard the user
3681    has chosen, taking also into account -fall-intrinsics.  Here, no
3682    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3683    textual representation of the symbols standard status (like
3684    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3685    can be used to construct a detailed warning/error message in case of
3686    a FAILURE.  */
3687
3688 gfc_try
3689 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3690                               const char** symstd, bool silent, locus where)
3691 {
3692   const char* symstd_msg;
3693
3694   /* For -fall-intrinsics, just succeed.  */
3695   if (gfc_option.flag_all_intrinsics)
3696     return SUCCESS;
3697
3698   /* Find the symbol's standard message for later usage.  */
3699   switch (isym->standard)
3700     {
3701     case GFC_STD_F77:
3702       symstd_msg = "available since Fortran 77";
3703       break;
3704
3705     case GFC_STD_F95_OBS:
3706       symstd_msg = "obsolescent in Fortran 95";
3707       break;
3708
3709     case GFC_STD_F95_DEL:
3710       symstd_msg = "deleted in Fortran 95";
3711       break;
3712
3713     case GFC_STD_F95:
3714       symstd_msg = "new in Fortran 95";
3715       break;
3716
3717     case GFC_STD_F2003:
3718       symstd_msg = "new in Fortran 2003";
3719       break;
3720
3721     case GFC_STD_F2008:
3722       symstd_msg = "new in Fortran 2008";
3723       break;
3724
3725     case GFC_STD_GNU:
3726       symstd_msg = "a GNU Fortran extension";
3727       break;
3728
3729     case GFC_STD_LEGACY:
3730       symstd_msg = "for backward compatibility";
3731       break;
3732
3733     default:
3734       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3735                           isym->name, isym->standard);
3736     }
3737
3738   /* If warning about the standard, warn and succeed.  */
3739   if (gfc_option.warn_std & isym->standard)
3740     {
3741       /* Do only print a warning if not a GNU extension.  */
3742       if (!silent && isym->standard != GFC_STD_GNU)
3743         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3744                      isym->name, _(symstd_msg), &where);
3745
3746       return SUCCESS;
3747     }
3748
3749   /* If allowing the symbol's standard, succeed, too.  */
3750   if (gfc_option.allow_std & isym->standard)
3751     return SUCCESS;
3752
3753   /* Otherwise, fail.  */
3754   if (symstd)
3755     *symstd = _(symstd_msg);
3756   return FAILURE;
3757 }
3758
3759
3760 /* See if a function call corresponds to an intrinsic function call.
3761    We return:
3762
3763     MATCH_YES    if the call corresponds to an intrinsic, simplification
3764                  is done if possible.
3765
3766     MATCH_NO     if the call does not correspond to an intrinsic
3767
3768     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3769                  error during the simplification process.
3770
3771    The error_flag parameter enables an error reporting.  */
3772
3773 match
3774 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3775 {
3776   gfc_intrinsic_sym *isym, *specific;
3777   gfc_actual_arglist *actual;
3778   const char *name;
3779   int flag;
3780
3781   if (expr->value.function.isym != NULL)
3782     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3783            ? MATCH_ERROR : MATCH_YES;
3784
3785   if (!error_flag)
3786     gfc_push_suppress_errors ();
3787   flag = 0;
3788
3789   for (actual = expr->value.function.actual; actual; actual = actual->next)
3790     if (actual->expr != NULL)
3791       flag |= (actual->expr->ts.type != BT_INTEGER
3792                && actual->expr->ts.type != BT_CHARACTER);
3793
3794   name = expr->symtree->n.sym->name;
3795
3796   isym = specific = gfc_find_function (name);
3797   if (isym == NULL)
3798     {
3799       if (!error_flag)
3800         gfc_pop_suppress_errors ();
3801       return MATCH_NO;
3802     }
3803
3804   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3805        || isym->id == GFC_ISYM_CMPLX)
3806       && gfc_init_expr_flag
3807       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3808                          "as initialization expression at %L", name,
3809                          &expr->where) == FAILURE)
3810     {
3811       if (!error_flag)
3812         gfc_pop_suppress_errors ();
3813       return MATCH_ERROR;
3814     }
3815
3816   gfc_current_intrinsic_where = &expr->where;
3817
3818   /* Bypass the generic list for min and max.  */
3819   if (isym->check.f1m == gfc_check_min_max)
3820     {
3821       init_arglist (isym);
3822
3823       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3824         goto got_specific;
3825
3826       if (!error_flag)
3827         gfc_pop_suppress_errors ();
3828       return MATCH_NO;
3829     }
3830
3831   /* If the function is generic, check all of its specific
3832      incarnations.  If the generic name is also a specific, we check
3833      that name last, so that any error message will correspond to the
3834      specific.  */
3835   gfc_push_suppress_errors ();
3836
3837   if (isym->generic)
3838     {
3839       for (specific = isym->specific_head; specific;
3840            specific = specific->next)
3841         {
3842           if (specific == isym)
3843             continue;
3844           if (check_specific (specific, expr, 0) == SUCCESS)
3845             {
3846               gfc_pop_suppress_errors ();
3847               goto got_specific;
3848             }
3849         }
3850     }
3851
3852   gfc_pop_suppress_errors ();
3853
3854   if (check_specific (isym, expr, error_flag) == FAILURE)
3855     {
3856       if (!error_flag)
3857         gfc_pop_suppress_errors ();
3858       return MATCH_NO;
3859     }
3860
3861   specific = isym;
3862
3863 got_specific:
3864   expr->value.function.isym = specific;
3865   gfc_intrinsic_symbol (expr->symtree->n.sym);
3866
3867   if (!error_flag)
3868     gfc_pop_suppress_errors ();
3869
3870   if (do_simplify (specific, expr) == FAILURE)
3871     return MATCH_ERROR;
3872
3873   /* F95, 7.1.6.1, Initialization expressions
3874      (4) An elemental intrinsic function reference of type integer or
3875          character where each argument is an initialization expression
3876          of type integer or character
3877
3878      F2003, 7.1.7 Initialization expression
3879      (4)   A reference to an elemental standard intrinsic function,
3880            where each argument is an initialization expression  */
3881
3882   if (gfc_init_expr_flag && isym->elemental && flag
3883       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3884                         "as initialization expression with non-integer/non-"
3885                         "character arguments at %L", &expr->where) == FAILURE)
3886     return MATCH_ERROR;
3887
3888   return MATCH_YES;
3889 }
3890
3891
3892 /* See if a CALL statement corresponds to an intrinsic subroutine.
3893    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3894    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3895    correspond).  */
3896
3897 match
3898 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3899 {
3900   gfc_intrinsic_sym *isym;
3901   const char *name;
3902
3903   name = c->symtree->n.sym->name;
3904
3905   isym = gfc_find_subroutine (name);
3906   if (isym == NULL)
3907     return MATCH_NO;
3908
3909   if (!error_flag)
3910     gfc_push_suppress_errors ();
3911
3912   init_arglist (isym);
3913
3914   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3915     goto fail;
3916
3917   if (isym->check.f1 != NULL)
3918     {
3919       if (do_check (isym, c->ext.actual) == FAILURE)
3920         goto fail;
3921     }
3922   else
3923     {
3924       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3925         goto fail;
3926     }
3927
3928   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3929      seen at this point.  */
3930   if (!error_flag)
3931     gfc_pop_suppress_errors ();
3932
3933   c->resolved_isym = isym;
3934   if (isym->resolve.s1 != NULL)
3935     isym->resolve.s1 (c);
3936   else
3937     {
3938       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3939       c->resolved_sym->attr.elemental = isym->elemental;
3940     }
3941
3942   if (gfc_pure (NULL) && !isym->elemental)
3943     {
3944       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3945                  &c->loc);
3946       return MATCH_ERROR;
3947     }
3948
3949   c->resolved_sym->attr.noreturn = isym->noreturn;
3950
3951   return MATCH_YES;
3952
3953 fail:
3954   if (!error_flag)
3955     gfc_pop_suppress_errors ();
3956   return MATCH_NO;
3957 }
3958
3959
3960 /* Call gfc_convert_type() with warning enabled.  */
3961
3962 gfc_try
3963 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3964 {
3965   return gfc_convert_type_warn (expr, ts, eflag, 1);
3966 }
3967
3968
3969 /* Try to convert an expression (in place) from one type to another.
3970    'eflag' controls the behavior on error.
3971
3972    The possible values are:
3973
3974      1 Generate a gfc_error()
3975      2 Generate a gfc_internal_error().
3976
3977    'wflag' controls the warning related to conversion.  */
3978
3979 gfc_try
3980 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3981 {
3982   gfc_intrinsic_sym *sym;
3983   gfc_typespec from_ts;
3984   locus old_where;
3985   gfc_expr *new_expr;
3986   int rank;
3987   mpz_t *shape;
3988
3989   from_ts = expr->ts;           /* expr->ts gets clobbered */
3990
3991   if (ts->type == BT_UNKNOWN)
3992     goto bad;
3993
3994   /* NULL and zero size arrays get their type here.  */
3995   if (expr->expr_type == EXPR_NULL
3996       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3997     {
3998       /* Sometimes the RHS acquire the type.  */
3999       expr->ts = *ts;
4000       return SUCCESS;
4001     }
4002
4003   if (expr->ts.type == BT_UNKNOWN)
4004     goto bad;
4005
4006   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4007       && gfc_compare_types (&expr->ts, ts))
4008     return SUCCESS;
4009
4010   sym = find_conv (&expr->ts, ts);
4011   if (sym == NULL)
4012     goto bad;
4013
4014   /* At this point, a conversion is necessary. A warning may be needed.  */
4015   if ((gfc_option.warn_std & sym->standard) != 0)
4016     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4017                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4018   else if (wflag && gfc_option.warn_conversion)
4019     {
4020       /* If the types are the same (but not LOGICAL), and if from-kind
4021          is larger than to-kind, this may indicate a loss of precision.
4022          The same holds for conversions from REAL to COMPLEX.  */
4023       if (((from_ts.type == ts->type && from_ts.type != BT_LOGICAL)
4024              && from_ts.kind > ts->kind)
4025           || ((from_ts.type == BT_REAL && ts->type == BT_COMPLEX)
4026               && from_ts.kind > ts->kind))
4027         gfc_warning_now ("Possible loss of precision in conversion "
4028                          "from %s to %s at %L", gfc_typename (&from_ts),
4029                          gfc_typename (ts), &expr->where);
4030
4031       /* If INTEGER is converted to REAL/COMPLEX, this is generally ok if
4032          the kind of the INTEGER value is less or equal to the kind of the
4033          REAL/COMPLEX one. Otherwise the value may not fit.
4034          Assignment of an overly large integer constant also generates
4035          an overflow error with range checking. */
4036       else if (from_ts.type == BT_INTEGER
4037                && (ts->type == BT_REAL || ts->type == BT_COMPLEX)
4038                && from_ts.kind > ts->kind)
4039         gfc_warning_now ("Possible loss of digits in conversion "
4040                          "from %s to %s at %L", gfc_typename (&from_ts),
4041                          gfc_typename (ts), &expr->where);
4042
4043       /* If REAL/COMPLEX is converted to INTEGER, or COMPLEX is converted
4044         to REAL we almost certainly have a loss of digits, regardless of
4045         the respective kinds.  */
4046       else if (((from_ts.type == BT_REAL || from_ts.type == BT_COMPLEX)
4047                  && ts->type == BT_INTEGER)
4048                || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4049         gfc_warning_now ("Likely loss of digits in conversion from"
4050                         "%s to %s at %L", gfc_typename (&from_ts),
4051                         gfc_typename (ts), &expr->where);
4052     }
4053
4054   /* Insert a pre-resolved function call to the right function.  */
4055   old_where = expr->where;
4056   rank = expr->rank;
4057   shape = expr->shape;
4058
4059   new_expr = gfc_get_expr ();
4060   *new_expr = *expr;
4061
4062   new_expr = gfc_build_conversion (new_expr);
4063   new_expr->value.function.name = sym->lib_name;
4064   new_expr->value.function.isym = sym;
4065   new_expr->where = old_where;
4066   new_expr->rank = rank;
4067   new_expr->shape = gfc_copy_shape (shape, rank);
4068
4069   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4070   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4071   new_expr->symtree->n.sym->ts = *ts;
4072   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4073   new_expr->symtree->n.sym->attr.function = 1;
4074   new_expr->symtree->n.sym->attr.elemental = 1;
4075   new_expr->symtree->n.sym->attr.pure = 1;
4076   new_expr->symtree->n.sym->attr.referenced = 1;
4077   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4078   gfc_commit_symbol (new_expr->symtree->n.sym);
4079
4080   *expr = *new_expr;
4081
4082   gfc_free (new_expr);
4083   expr->ts = *ts;
4084
4085   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4086       && do_simplify (sym, expr) == FAILURE)
4087     {
4088
4089       if (eflag == 2)
4090         goto bad;
4091       return FAILURE;           /* Error already generated in do_simplify() */
4092     }
4093
4094   return SUCCESS;
4095
4096 bad:
4097   if (eflag == 1)
4098     {
4099       gfc_error ("Can't convert %s to %s at %L",
4100                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4101       return FAILURE;
4102     }
4103
4104   gfc_internal_error ("Can't convert %s to %s at %L",
4105                       gfc_typename (&from_ts), gfc_typename (ts),
4106                       &expr->where);
4107   /* Not reached */
4108 }
4109
4110
4111 gfc_try
4112 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4113 {
4114   gfc_intrinsic_sym *sym;
4115   locus old_where;
4116   gfc_expr *new_expr;
4117   int rank;
4118   mpz_t *shape;
4119
4120   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4121
4122   sym = find_char_conv (&expr->ts, ts);
4123   gcc_assert (sym);
4124
4125   /* Insert a pre-resolved function call to the right function.  */
4126   old_where = expr->where;
4127   rank = expr->rank;
4128   shape = expr->shape;
4129
4130   new_expr = gfc_get_expr ();
4131   *new_expr = *expr;
4132
4133   new_expr = gfc_build_conversion (new_expr);
4134   new_expr->value.function.name = sym->lib_name;
4135   new_expr->value.function.isym = sym;
4136   new_expr->where = old_where;
4137   new_expr->rank = rank;
4138   new_expr->shape = gfc_copy_shape (shape, rank);
4139
4140   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4141   new_expr->symtree->n.sym->ts = *ts;
4142   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4143   new_expr->symtree->n.sym->attr.function = 1;
4144   new_expr->symtree->n.sym->attr.elemental = 1;
4145   new_expr->symtree->n.sym->attr.referenced = 1;
4146   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4147   gfc_commit_symbol (new_expr->symtree->n.sym);
4148
4149   *expr = *new_expr;
4150
4151   gfc_free (new_expr);
4152   expr->ts = *ts;
4153
4154   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4155       && do_simplify (sym, expr) == FAILURE)
4156     {
4157       /* Error already generated in do_simplify() */
4158       return FAILURE;
4159     }
4160
4161   return SUCCESS;
4162 }
4163
4164
4165 /* Check if the passed name is name of an intrinsic (taking into account the
4166    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4167    warn about this as a user-procedure having the same name as an intrinsic
4168    (-Wintrinsic-shadow enabled) and do so if we should.  */
4169
4170 void
4171 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4172 {
4173   gfc_intrinsic_sym* isym;
4174
4175   /* If the warning is disabled, do nothing at all.  */
4176   if (!gfc_option.warn_intrinsic_shadow)
4177     return;
4178
4179   /* Try to find an intrinsic of the same name.  */
4180   if (func)
4181     isym = gfc_find_function (sym->name);
4182   else
4183     isym = gfc_find_subroutine (sym->name);
4184
4185   /* If no intrinsic was found with this name or it's not included in the
4186      selected standard, everything's fine.  */
4187   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4188                                              sym->declared_at) == FAILURE)
4189     return;
4190
4191   /* Emit the warning.  */
4192   if (in_module)
4193     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4194                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4195                  " declarations may be required.",
4196                  sym->name, &sym->declared_at);
4197   else
4198     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4199                  " only be called via an explicit interface or if declared"
4200                  " EXTERNAL.", sym->name, &sym->declared_at);
4201 }