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_bitfcn, 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_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1480
1481   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1482              gfc_check_digits, gfc_simplify_digits, NULL,
1483              x, BT_UNKNOWN, dr, REQUIRED);
1484
1485   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1486
1487   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1488              gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1489              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1490
1491   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1492              NULL, gfc_simplify_dim, gfc_resolve_dim,
1493              x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1494
1495   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1496              gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1497              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1498
1499   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1500
1501   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1502              GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1503              va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1504
1505   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1506
1507   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1508              gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1509              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1510
1511   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1512
1513   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1514              NULL, NULL, NULL,
1515              a, BT_COMPLEX, dd, REQUIRED);
1516
1517   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1518
1519   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1520              gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1521              ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1522              bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1523
1524   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1525
1526   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1527              gfc_check_x, gfc_simplify_epsilon, NULL,
1528              x, BT_REAL, dr, REQUIRED);
1529
1530   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1531
1532   /* G77 compatibility for the ERF() and ERFC() functions.  */
1533   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1534              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1535              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1536
1537   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1538              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1539              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1540
1541   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1542
1543   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1544              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1545              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1546
1547   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1548              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1549              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1550
1551   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1552
1553   add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1554              BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1555              gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1556              dr, REQUIRED);
1557
1558   make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1559
1560   /* G77 compatibility */
1561   add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1562              gfc_check_dtime_etime, NULL, NULL,
1563              x, BT_REAL, 4, REQUIRED);
1564
1565   make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1566
1567   add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1568              gfc_check_dtime_etime, NULL, NULL,
1569              x, BT_REAL, 4, REQUIRED);
1570
1571   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1572
1573   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
1574              gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1575              x, BT_REAL, dr, REQUIRED);
1576
1577   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1578              gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1579              x, BT_REAL, dd, REQUIRED);
1580
1581   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1582              NULL, gfc_simplify_exp, gfc_resolve_exp,
1583              x, BT_COMPLEX, dz, REQUIRED);
1584
1585   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1586              NULL, gfc_simplify_exp, gfc_resolve_exp,
1587              x, BT_COMPLEX, dd, REQUIRED);
1588
1589   make_alias ("cdexp", GFC_STD_GNU);
1590
1591   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1592
1593   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1594              gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1595              x, BT_REAL, dr, REQUIRED);
1596
1597   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1598
1599   add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1600              ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1601              gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1602              a, BT_UNKNOWN, 0, REQUIRED,
1603              mo, BT_UNKNOWN, 0, REQUIRED);
1604
1605   add_sym_0 ("fdate",  GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1606              NULL, NULL, gfc_resolve_fdate);
1607
1608   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1609
1610   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1611              gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1612              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1613
1614   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1615
1616   /* G77 compatible fnum */
1617   add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1618              gfc_check_fnum, NULL, gfc_resolve_fnum,
1619              ut, BT_INTEGER, di, REQUIRED);
1620
1621   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1622
1623   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1624              gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1625              x, BT_REAL, dr, REQUIRED);
1626
1627   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1628
1629   add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1630              GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1631              ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1632
1633   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1634
1635   add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1636              gfc_check_ftell, NULL, gfc_resolve_ftell,
1637              ut, BT_INTEGER, di, REQUIRED);
1638
1639   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1640
1641   add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1642              gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1643              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1644
1645   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1646
1647   add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1648              gfc_check_fgetput, NULL, gfc_resolve_fget,
1649              c, BT_CHARACTER, dc, REQUIRED);
1650
1651   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1652
1653   add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1654              gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1655              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1656
1657   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1658
1659   add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1660              gfc_check_fgetput, NULL, gfc_resolve_fput,
1661              c, BT_CHARACTER, dc, REQUIRED);
1662
1663   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1664
1665   add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1666              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1667              gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1668
1669   add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1670              gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1671              x, BT_REAL, dr, REQUIRED);
1672
1673   make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1674
1675   /* Unix IDs (g77 compatibility)  */
1676   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,  GFC_STD_GNU,
1677              NULL, NULL, gfc_resolve_getcwd,
1678              c, BT_CHARACTER, dc, REQUIRED);
1679
1680   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1681
1682   add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1683              NULL, NULL, gfc_resolve_getgid);
1684
1685   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1686
1687   add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1688              NULL, NULL, gfc_resolve_getpid);
1689
1690   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1691
1692   add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1693              NULL, NULL, gfc_resolve_getuid);
1694
1695   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1696
1697   add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1698              gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1699              a, BT_CHARACTER, dc, REQUIRED);
1700
1701   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1702
1703   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1704              gfc_check_huge, gfc_simplify_huge, NULL,
1705              x, BT_UNKNOWN, dr, REQUIRED);
1706
1707   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1708
1709   add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1710              BT_REAL, dr, GFC_STD_F2008,
1711              gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1712              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1713
1714   make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1715
1716   add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1717              BT_INTEGER, di, GFC_STD_F95,
1718              gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1719              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1720
1721   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1722
1723   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1724              gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1725              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1726
1727   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1728
1729   add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1730              gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1731              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1732
1733   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1734
1735   add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1736              NULL, NULL, NULL);
1737
1738   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1739
1740   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1741              gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1742              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1743
1744   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1745
1746   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1747              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1748              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1749              ln, BT_INTEGER, di, REQUIRED);
1750
1751   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1752
1753   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1754              gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1755              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1756
1757   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1758
1759   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1760              BT_INTEGER, di, GFC_STD_F77,
1761              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1762              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1763
1764   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1765
1766   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1767              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1768              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1769
1770   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1771
1772   add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1773              gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1774              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1775
1776   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1777
1778   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1779              NULL, NULL, gfc_resolve_ierrno);
1780
1781   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1782
1783   add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1784              gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
1785              ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1786
1787   /* The resolution function for INDEX is called gfc_resolve_index_func
1788      because the name gfc_resolve_index is already used in resolve.c.  */
1789   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1790              BT_INTEGER, di, GFC_STD_F77,
1791              gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1792              stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1793              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1794
1795   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1796
1797   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1798              gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1799              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1800
1801   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1802              NULL, gfc_simplify_ifix, NULL,
1803              a, BT_REAL, dr, REQUIRED);
1804
1805   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1806              NULL, gfc_simplify_idint, NULL,
1807              a, BT_REAL, dd, REQUIRED);
1808
1809   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1810
1811   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1812              gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1813              a, BT_REAL, dr, REQUIRED);
1814
1815   make_alias ("short", GFC_STD_GNU);
1816
1817   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1818
1819   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1820              gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1821              a, BT_REAL, dr, REQUIRED);
1822
1823   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1824
1825   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1826              gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1827              a, BT_REAL, dr, REQUIRED);
1828
1829   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1830
1831   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1832              gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1833              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1834
1835   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1836
1837   add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1838              gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1839              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1840
1841   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1842
1843   /* The following function is for G77 compatibility.  */
1844   add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1845              gfc_check_irand, NULL, NULL,
1846              i, BT_INTEGER, 4, OPTIONAL);
1847
1848   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1849
1850   add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1851              gfc_check_isatty, NULL, gfc_resolve_isatty,
1852              ut, BT_INTEGER, di, REQUIRED);
1853
1854   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1855
1856   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1857              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1858              gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1859              i, BT_INTEGER, 0, REQUIRED);
1860
1861   make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1862
1863   add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1864              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1865              gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1866              i, BT_INTEGER, 0, REQUIRED);
1867
1868   make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1869
1870   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1871              BT_LOGICAL, dl, GFC_STD_GNU,
1872              gfc_check_isnan, gfc_simplify_isnan, NULL,
1873              x, BT_REAL, 0, REQUIRED);
1874
1875   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1876
1877   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1878              gfc_check_ishft, NULL, gfc_resolve_rshift,
1879              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1880
1881   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1882
1883   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1884              gfc_check_ishft, NULL, gfc_resolve_lshift,
1885              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1886
1887   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1888
1889   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1890              gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1891              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1892
1893   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1894
1895   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1896              gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1897              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1898              sz, BT_INTEGER, di, OPTIONAL);
1899
1900   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1901
1902   add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1903              gfc_check_kill, NULL, gfc_resolve_kill,
1904              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1905
1906   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1907
1908   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1909              gfc_check_kind, gfc_simplify_kind, NULL,
1910              x, BT_REAL, dr, REQUIRED);
1911
1912   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1913
1914   add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1915              BT_INTEGER, di, GFC_STD_F95,
1916              gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1917              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1918              kind, BT_INTEGER, di, OPTIONAL);
1919
1920   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1921
1922   add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
1923              BT_INTEGER, di, GFC_STD_F2008,
1924              gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
1925              ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1926              kind, BT_INTEGER, di, OPTIONAL);
1927
1928   make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
1929
1930   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1931              BT_INTEGER, di, GFC_STD_F2008,
1932              gfc_check_i, gfc_simplify_leadz, NULL,
1933              i, BT_INTEGER, di, REQUIRED);
1934
1935   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1936
1937   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1938              BT_INTEGER, di, GFC_STD_F77,
1939              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1940              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1941
1942   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1943
1944   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1945              BT_INTEGER, di, GFC_STD_F95,
1946              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1947              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1948
1949   make_alias ("lnblnk", GFC_STD_GNU);
1950
1951   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1952
1953   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1954              dr, GFC_STD_GNU,
1955              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1956              x, BT_REAL, dr, REQUIRED);
1957
1958   make_alias ("log_gamma", GFC_STD_F2008);
1959
1960   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1961              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1962              x, BT_REAL, dr, REQUIRED);
1963
1964   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1965              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1966              x, BT_REAL, dr, REQUIRED);
1967
1968   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1969
1970
1971   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1972              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1973              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1974
1975   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1976
1977   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1978              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1979              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1980
1981   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1982
1983   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1984              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1985              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1986
1987   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1988
1989   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1990              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1991              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1992
1993   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1994
1995   add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1996              GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1997              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
1998
1999   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2000
2001   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2002              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2003              x, BT_REAL, dr, REQUIRED);
2004
2005   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2006              NULL, gfc_simplify_log, gfc_resolve_log,
2007              x, BT_REAL, dr, REQUIRED);
2008
2009   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2010              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2011              x, BT_REAL, dd, REQUIRED);
2012
2013   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2014              NULL, gfc_simplify_log, gfc_resolve_log,
2015              x, BT_COMPLEX, dz, REQUIRED);
2016
2017   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
2018              NULL, gfc_simplify_log, gfc_resolve_log,
2019              x, BT_COMPLEX, dd, REQUIRED);
2020
2021   make_alias ("cdlog", GFC_STD_GNU);
2022
2023   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2024
2025   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2026              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2027              x, BT_REAL, dr, REQUIRED);
2028
2029   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2030              NULL, gfc_simplify_log10, gfc_resolve_log10,
2031              x, BT_REAL, dr, REQUIRED);
2032
2033   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2034              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2035              x, BT_REAL, dd, REQUIRED);
2036
2037   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2038
2039   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2040              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2041              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2042
2043   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2044
2045   add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2046              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2047              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2048
2049   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2050
2051   add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2052              GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2053              sz, BT_INTEGER, di, REQUIRED);
2054
2055   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2056
2057   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2058              gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2059              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2060
2061   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2062
2063   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2064      int(max).  The max function must take at least two arguments.  */
2065
2066   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2067              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2068              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2069
2070   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2071              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2072              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2073
2074   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2075              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2076              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2077
2078   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2079              gfc_check_min_max_real, gfc_simplify_max, NULL,
2080              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2081
2082   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2083              gfc_check_min_max_real, gfc_simplify_max, NULL,
2084              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2085
2086   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2087              gfc_check_min_max_double, gfc_simplify_max, NULL,
2088              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2089
2090   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2091
2092   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2093              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2094              x, BT_UNKNOWN, dr, REQUIRED);
2095
2096   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2097
2098   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2099                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2100                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2101                msk, BT_LOGICAL, dl, OPTIONAL);
2102
2103   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2104
2105   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2106                 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2107                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2108                 msk, BT_LOGICAL, dl, OPTIONAL);
2109
2110   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2111
2112   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2113              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2114
2115   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2116
2117   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2118              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2119
2120   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2121
2122   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2123              gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2124              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2125              msk, BT_LOGICAL, dl, REQUIRED);
2126
2127   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2128
2129   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2130      int(min).  */
2131
2132   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2133               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2134               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2135
2136   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2137               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2138               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2139
2140   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2141               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2142               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2143
2144   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2145               gfc_check_min_max_real, gfc_simplify_min, NULL,
2146               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2147
2148   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2149               gfc_check_min_max_real, gfc_simplify_min, NULL,
2150               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2151
2152   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2153               gfc_check_min_max_double, gfc_simplify_min, NULL,
2154               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2155
2156   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2157
2158   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2159              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2160              x, BT_UNKNOWN, dr, REQUIRED);
2161
2162   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2163
2164   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2165                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2166                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2167                msk, BT_LOGICAL, dl, OPTIONAL);
2168
2169   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2170
2171   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2172                 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2173                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2174                 msk, BT_LOGICAL, dl, OPTIONAL);
2175
2176   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2177
2178   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2179              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2180              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2181
2182   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2183              NULL, gfc_simplify_mod, gfc_resolve_mod,
2184              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2185
2186   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2187              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2188              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2189
2190   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2191
2192   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2193              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2194              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2195
2196   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2197
2198   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2199              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2200              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2201
2202   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2203
2204   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2205              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2206              a, BT_CHARACTER, dc, REQUIRED);
2207
2208   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2209
2210   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2211              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2212              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2213
2214   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2215              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2216              a, BT_REAL, dd, REQUIRED);
2217
2218   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2219
2220   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2221              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2222              i, BT_INTEGER, di, REQUIRED);
2223
2224   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2225
2226   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2227              gfc_check_null, gfc_simplify_null, NULL,
2228              mo, BT_INTEGER, di, OPTIONAL);
2229
2230   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2231
2232   add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2233              NULL, gfc_simplify_num_images, NULL);
2234
2235   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2236              gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2237              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2238              v, BT_REAL, dr, OPTIONAL);
2239
2240   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2241
2242   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2243              gfc_check_precision, gfc_simplify_precision, NULL,
2244              x, BT_UNKNOWN, 0, REQUIRED);
2245
2246   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2247
2248   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2249                     BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2250                     a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2251
2252   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2253
2254   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2255                 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2256                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2257                 msk, BT_LOGICAL, dl, OPTIONAL);
2258
2259   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2260
2261   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2262              gfc_check_radix, gfc_simplify_radix, NULL,
2263              x, BT_UNKNOWN, 0, REQUIRED);
2264
2265   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2266
2267   /* The following function is for G77 compatibility.  */
2268   add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2269              gfc_check_rand, NULL, NULL,
2270              i, BT_INTEGER, 4, OPTIONAL);
2271
2272   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2273      use slightly different shoddy multiplicative congruential PRNG.  */
2274   make_alias ("ran", GFC_STD_GNU);
2275
2276   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2277
2278   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2279              gfc_check_range, gfc_simplify_range, NULL,
2280              x, BT_REAL, dr, REQUIRED);
2281
2282   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2283
2284   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2285              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2286              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2287
2288   /* This provides compatibility with g77.  */
2289   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2290              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2291              a, BT_UNKNOWN, dr, REQUIRED);
2292
2293   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2294              gfc_check_float, gfc_simplify_float, NULL,
2295              a, BT_INTEGER, di, REQUIRED);
2296
2297   add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2298              gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2299              a, BT_REAL, dr, REQUIRED);
2300
2301   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2302              gfc_check_sngl, gfc_simplify_sngl, NULL,
2303              a, BT_REAL, dd, REQUIRED);
2304
2305   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2306
2307   add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2308              GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2309              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2310
2311   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2312
2313   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2314              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2315              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2316
2317   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2318
2319   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2320              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2321              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2322              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2323
2324   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2325
2326   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2327              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2328              x, BT_REAL, dr, REQUIRED);
2329
2330   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2331
2332   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2333              BT_LOGICAL, dl, GFC_STD_F2003,
2334              gfc_check_same_type_as, NULL, NULL,
2335              a, BT_UNKNOWN, 0, REQUIRED,
2336              b, BT_UNKNOWN, 0, REQUIRED);
2337
2338   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2339              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2340              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2341
2342   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2343
2344   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2345              BT_INTEGER, di, GFC_STD_F95,
2346              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2347              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2348              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2349
2350   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2351
2352   /* Added for G77 compatibility garbage.  */
2353   add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2354              NULL, NULL, NULL);
2355
2356   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2357
2358   /* Added for G77 compatibility.  */
2359   add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2360              gfc_check_secnds, NULL, gfc_resolve_secnds,
2361              x, BT_REAL, dr, REQUIRED);
2362
2363   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2364
2365   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2366              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2367              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2368              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2369
2370   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2371
2372   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2373              GFC_STD_F95, gfc_check_selected_int_kind,
2374              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2375
2376   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2377
2378   add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2379              GFC_STD_F95, gfc_check_selected_real_kind,
2380              gfc_simplify_selected_real_kind, NULL,
2381              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2382
2383   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2384
2385   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2386              gfc_check_set_exponent, gfc_simplify_set_exponent,
2387              gfc_resolve_set_exponent,
2388              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2389
2390   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2391
2392   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2393              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2394              src, BT_REAL, dr, REQUIRED);
2395
2396   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2397
2398   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2399              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2400              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2401
2402   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2403              NULL, gfc_simplify_sign, gfc_resolve_sign,
2404              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2405
2406   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2407              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2408              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2409
2410   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2411
2412   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2413              gfc_check_signal, NULL, gfc_resolve_signal,
2414              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2415
2416   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2417
2418   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2419              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2420              x, BT_REAL, dr, REQUIRED);
2421
2422   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2423              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2424              x, BT_REAL, dd, REQUIRED);
2425
2426   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2427              NULL, gfc_simplify_sin, gfc_resolve_sin,
2428              x, BT_COMPLEX, dz, REQUIRED);
2429
2430   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2431              NULL, gfc_simplify_sin, gfc_resolve_sin,
2432              x, BT_COMPLEX, dd, REQUIRED);
2433
2434   make_alias ("cdsin", GFC_STD_GNU);
2435
2436   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2437
2438   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2439              gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2440              x, BT_REAL, dr, REQUIRED);
2441
2442   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2443              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2444              x, BT_REAL, dd, REQUIRED);
2445
2446   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2447
2448   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2449              BT_INTEGER, di, GFC_STD_F95,
2450              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2451              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2452              kind, BT_INTEGER, di, OPTIONAL);
2453
2454   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2455
2456   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2457              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2458              x, BT_UNKNOWN, 0, REQUIRED);
2459
2460   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2461   make_alias ("c_sizeof", GFC_STD_F2008);
2462
2463   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2464              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2465              x, BT_REAL, dr, REQUIRED);
2466
2467   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2468
2469   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2470              gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2471              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2472              ncopies, BT_INTEGER, di, REQUIRED);
2473
2474   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2475
2476   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2477              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2478              x, BT_REAL, dr, REQUIRED);
2479
2480   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2481              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2482              x, BT_REAL, dd, REQUIRED);
2483
2484   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2485              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2486              x, BT_COMPLEX, dz, REQUIRED);
2487
2488   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2489              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2490              x, BT_COMPLEX, dd, REQUIRED);
2491
2492   make_alias ("cdsqrt", GFC_STD_GNU);
2493
2494   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2495
2496   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2497              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2498              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2499
2500   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2501
2502   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2503                 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2504                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2505                 msk, BT_LOGICAL, dl, OPTIONAL);
2506
2507   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2508
2509   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2510              GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2511              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2512
2513   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2514
2515   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2516              GFC_STD_GNU, NULL, NULL, NULL,
2517              com, BT_CHARACTER, dc, REQUIRED);
2518
2519   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2520
2521   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2522              gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2523              x, BT_REAL, dr, REQUIRED);
2524
2525   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2526              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2527              x, BT_REAL, dd, REQUIRED);
2528
2529   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2530
2531   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2532              gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2533              x, BT_REAL, dr, REQUIRED);
2534
2535   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2536              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2537              x, BT_REAL, dd, REQUIRED);
2538
2539   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2540
2541   add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2542              gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
2543              ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2544
2545   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2546              NULL, NULL, gfc_resolve_time);
2547
2548   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2549
2550   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2551              NULL, NULL, gfc_resolve_time8);
2552
2553   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2554
2555   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2556              gfc_check_x, gfc_simplify_tiny, NULL,
2557              x, BT_REAL, dr, REQUIRED);
2558
2559   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2560
2561   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2562              BT_INTEGER, di, GFC_STD_F2008,
2563              gfc_check_i, gfc_simplify_trailz, NULL,
2564              i, BT_INTEGER, di, REQUIRED);
2565
2566   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2567
2568   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2569              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2570              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2571              sz, BT_INTEGER, di, OPTIONAL);
2572
2573   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2574
2575   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2576              gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2577              m, BT_REAL, dr, REQUIRED);
2578
2579   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2580
2581   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2582              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2583              stg, BT_CHARACTER, dc, REQUIRED);
2584
2585   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2586
2587   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2588              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2589              ut, BT_INTEGER, di, REQUIRED);
2590
2591   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2592
2593   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2594              BT_INTEGER, di, GFC_STD_F95,
2595              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2596              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2597              kind, BT_INTEGER, di, OPTIONAL);
2598
2599   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2600
2601   add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2602             BT_INTEGER, di, GFC_STD_F2008,
2603             gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2604             ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2605             kind, BT_INTEGER, di, OPTIONAL);
2606
2607   make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
2608
2609   /* g77 compatibility for UMASK.  */
2610   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2611              GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2612              msk, BT_INTEGER, di, REQUIRED);
2613
2614   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2615
2616   /* g77 compatibility for UNLINK.  */
2617   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2618              gfc_check_unlink, NULL, gfc_resolve_unlink,
2619              "path", BT_CHARACTER, dc, REQUIRED);
2620
2621   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2622
2623   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2624              gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2625              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2626              f, BT_REAL, dr, REQUIRED);
2627
2628   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2629
2630   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2631              BT_INTEGER, di, GFC_STD_F95,
2632              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2633              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2634              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2635
2636   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2637
2638   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2639              GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2640              x, BT_UNKNOWN, 0, REQUIRED);
2641
2642   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2643 }
2644
2645
2646 /* Add intrinsic subroutines.  */
2647
2648 static void
2649 add_subroutines (void)
2650 {
2651   /* Argument names as in the standard (to be used as argument keywords).  */
2652   const char
2653     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2654     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2655     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2656     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2657     *com = "command", *length = "length", *st = "status",
2658     *val = "value", *num = "number", *name = "name",
2659     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2660     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2661     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2662     *p2 = "path2", *msk = "mask", *old = "old";
2663
2664   int di, dr, dc, dl, ii;
2665
2666   di = gfc_default_integer_kind;
2667   dr = gfc_default_real_kind;
2668   dc = gfc_default_character_kind;
2669   dl = gfc_default_logical_kind;
2670   ii = gfc_index_integer_kind;
2671
2672   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2673
2674   make_noreturn();
2675
2676   add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2677                      GFC_STD_F95, gfc_check_cpu_time, NULL,
2678                      gfc_resolve_cpu_time,
2679                      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2680
2681   /* More G77 compatibility garbage.  */
2682   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2684               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2685
2686   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2687               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2688               vl, BT_INTEGER, 4, REQUIRED);
2689
2690   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2691               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2692               vl, BT_INTEGER, 4, REQUIRED);
2693
2694   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2695               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2696               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2697
2698   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2699               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2700               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2701
2702   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2703               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2704               tm, BT_REAL, dr, REQUIRED);
2705
2706   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2707               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2708               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2709
2710   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2711               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2712               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2713               st, BT_INTEGER, di, OPTIONAL);
2714
2715   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2716               GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2717               dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2718               tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2719               zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2720               vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2721
2722   /* More G77 compatibility garbage.  */
2723   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2724               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2725               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2726
2727   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2728               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2729               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2730
2731   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2732               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2733               dt, BT_CHARACTER, dc, REQUIRED);
2734
2735   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2736               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2737               dc, REQUIRED);
2738
2739   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2740               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2741               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2742
2743   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2744               NULL, NULL, NULL,
2745               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2746               REQUIRED);
2747
2748   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2749               gfc_check_getarg, NULL, gfc_resolve_getarg,
2750               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2751
2752   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2753               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2754               dc, REQUIRED);
2755
2756   /* F2003 commandline routines.  */
2757
2758   add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2759                      0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2760                      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2761                      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2762                      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2763
2764   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2765               BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2766               gfc_resolve_get_command_argument,
2767               num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2768               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2769               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2770               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2771
2772   /* F2003 subroutine to get environment variables.  */
2773
2774   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2775               NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2776               NULL, NULL, gfc_resolve_get_environment_variable,
2777               name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2778               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2779               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2780               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2781               trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2782
2783   add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2784                      GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2785                      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2786                      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2787
2788   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2789               GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2790               gfc_resolve_mvbits,
2791               f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2792               fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2793               ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2794               t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2795               tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2796
2797   add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2798                      BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2799                      gfc_resolve_random_number,
2800                      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2801
2802   add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2803                      BT_UNKNOWN, 0, GFC_STD_F95,
2804                      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2805                      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2806                      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2807                      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2808
2809   /* More G77 compatibility garbage.  */
2810   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2811               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2812               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2813               st, BT_INTEGER, di, OPTIONAL);
2814
2815   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2816               gfc_check_srand, NULL, gfc_resolve_srand,
2817               "seed", BT_INTEGER, 4, REQUIRED);
2818
2819   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2820               gfc_check_exit, NULL, gfc_resolve_exit,
2821               st, BT_INTEGER, di, OPTIONAL);
2822
2823   make_noreturn();
2824
2825   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2826               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2827               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2828               st, BT_INTEGER, di, OPTIONAL);
2829
2830   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2831               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2832               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2833
2834   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2835               gfc_check_flush, NULL, gfc_resolve_flush,
2836               ut, BT_INTEGER, di, OPTIONAL);
2837
2838   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2839               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2840               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2841               st, BT_INTEGER, di, OPTIONAL);
2842
2843   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2844               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2845               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2846
2847   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2848               gfc_check_free, NULL, gfc_resolve_free,
2849               ptr, BT_INTEGER, ii, REQUIRED);
2850
2851   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2852               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2853               ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2854               of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2855               whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2856               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2857
2858   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2859               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2860               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2861
2862   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2863               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2864               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2865
2866   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2867               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2868               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2869
2870   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2871               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2872               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2873               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2874
2875   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2876               gfc_check_perror, NULL, gfc_resolve_perror,
2877               "string", BT_CHARACTER, dc, REQUIRED);
2878
2879   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2880               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2881               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2882               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2883
2884   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2885               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2886               sec, BT_INTEGER, di, REQUIRED);
2887
2888   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2889               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2890               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2891               st, BT_INTEGER, di, OPTIONAL);
2892
2893   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2894               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2895               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2896               st, BT_INTEGER, di, OPTIONAL);
2897
2898   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2899               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2900               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2901               st, BT_INTEGER, di, OPTIONAL);
2902
2903   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2904               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2905               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2906               st, BT_INTEGER, di, OPTIONAL);
2907
2908   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2909               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2910               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2911               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2912
2913   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2914               NULL, NULL, gfc_resolve_system_sub,
2915               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2916
2917   add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2918                      BT_UNKNOWN, 0, GFC_STD_F95,
2919                      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2920                      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2921                      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2922                      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2923
2924   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2925               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2926               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2927
2928   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2929               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2930               msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2931
2932   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2933               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2934               "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2935 }
2936
2937
2938 /* Add a function to the list of conversion symbols.  */
2939
2940 static void
2941 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2942 {
2943   gfc_typespec from, to;
2944   gfc_intrinsic_sym *sym;
2945
2946   if (sizing == SZ_CONVS)
2947     {
2948       nconv++;
2949       return;
2950     }
2951
2952   gfc_clear_ts (&from);
2953   from.type = from_type;
2954   from.kind = from_kind;
2955
2956   gfc_clear_ts (&to);
2957   to.type = to_type;
2958   to.kind = to_kind;
2959
2960   sym = conversion + nconv;
2961
2962   sym->name = conv_name (&from, &to);
2963   sym->lib_name = sym->name;
2964   sym->simplify.cc = gfc_convert_constant;
2965   sym->standard = standard;
2966   sym->elemental = 1;
2967   sym->conversion = 1;
2968   sym->ts = to;
2969   sym->id = GFC_ISYM_CONVERSION;
2970
2971   nconv++;
2972 }
2973
2974
2975 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2976    functions by looping over the kind tables.  */
2977
2978 static void
2979 add_conversions (void)
2980 {
2981   int i, j;
2982
2983   /* Integer-Integer conversions.  */
2984   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2985     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2986       {
2987         if (i == j)
2988           continue;
2989
2990         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2991                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2992       }
2993
2994   /* Integer-Real/Complex conversions.  */
2995   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2996     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2997       {
2998         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2999                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3000
3001         add_conv (BT_REAL, gfc_real_kinds[j].kind,
3002                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3003
3004         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3005                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3006
3007         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3008                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3009       }
3010
3011   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3012     {
3013       /* Hollerith-Integer conversions.  */
3014       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3015         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3016                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3017       /* Hollerith-Real conversions.  */
3018       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3019         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3020                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3021       /* Hollerith-Complex conversions.  */
3022       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3023         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3024                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3025
3026       /* Hollerith-Character conversions.  */
3027       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3028                   gfc_default_character_kind, GFC_STD_LEGACY);
3029
3030       /* Hollerith-Logical conversions.  */
3031       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3032         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3033                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3034     }
3035
3036   /* Real/Complex - Real/Complex conversions.  */
3037   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3038     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3039       {
3040         if (i != j)
3041           {
3042             add_conv (BT_REAL, gfc_real_kinds[i].kind,
3043                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3044
3045             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3046                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3047           }
3048
3049         add_conv (BT_REAL, gfc_real_kinds[i].kind,
3050                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3051
3052         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3053                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3054       }
3055
3056   /* Logical/Logical kind conversion.  */
3057   for (i = 0; gfc_logical_kinds[i].kind; i++)
3058     for (j = 0; gfc_logical_kinds[j].kind; j++)
3059       {
3060         if (i == j)
3061           continue;
3062
3063         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3064                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3065       }
3066
3067   /* Integer-Logical and Logical-Integer conversions.  */
3068   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3069     for (i=0; gfc_integer_kinds[i].kind; i++)
3070       for (j=0; gfc_logical_kinds[j].kind; j++)
3071         {
3072           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3073                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3074           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3075                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3076         }
3077 }
3078
3079
3080 static void
3081 add_char_conversions (void)
3082 {
3083   int n, i, j;
3084
3085   /* Count possible conversions.  */
3086   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3087     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3088       if (i != j)
3089         ncharconv++;
3090
3091   /* Allocate memory.  */
3092   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3093
3094   /* Add the conversions themselves.  */
3095   n = 0;
3096   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3097     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3098       {
3099         gfc_typespec from, to;
3100
3101         if (i == j)
3102           continue;
3103
3104         gfc_clear_ts (&from);
3105         from.type = BT_CHARACTER;
3106         from.kind = gfc_character_kinds[i].kind;
3107
3108         gfc_clear_ts (&to);
3109         to.type = BT_CHARACTER;
3110         to.kind = gfc_character_kinds[j].kind;
3111
3112         char_conversions[n].name = conv_name (&from, &to);
3113         char_conversions[n].lib_name = char_conversions[n].name;
3114         char_conversions[n].simplify.cc = gfc_convert_char_constant;
3115         char_conversions[n].standard = GFC_STD_F2003;
3116         char_conversions[n].elemental = 1;
3117         char_conversions[n].conversion = 0;
3118         char_conversions[n].ts = to;
3119         char_conversions[n].id = GFC_ISYM_CONVERSION;
3120
3121         n++;
3122       }
3123 }
3124
3125
3126 /* Initialize the table of intrinsics.  */
3127 void
3128 gfc_intrinsic_init_1 (void)
3129 {
3130   int i;
3131
3132   nargs = nfunc = nsub = nconv = 0;
3133
3134   /* Create a namespace to hold the resolved intrinsic symbols.  */
3135   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3136
3137   sizing = SZ_FUNCS;
3138   add_functions ();
3139   sizing = SZ_SUBS;
3140   add_subroutines ();
3141   sizing = SZ_CONVS;
3142   add_conversions ();
3143
3144   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3145                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3146                         + sizeof (gfc_intrinsic_arg) * nargs);
3147
3148   next_sym = functions;
3149   subroutines = functions + nfunc;
3150
3151   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3152
3153   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3154
3155   sizing = SZ_NOTHING;
3156   nconv = 0;
3157
3158   add_functions ();
3159   add_subroutines ();
3160   add_conversions ();
3161
3162   /* Character conversion intrinsics need to be treated separately.  */
3163   add_char_conversions ();
3164
3165   /* Set the pure flag.  All intrinsic functions are pure, and
3166      intrinsic subroutines are pure if they are elemental.  */
3167
3168   for (i = 0; i < nfunc; i++)
3169     functions[i].pure = 1;
3170
3171   for (i = 0; i < nsub; i++)
3172     subroutines[i].pure = subroutines[i].elemental;
3173 }
3174
3175
3176 void
3177 gfc_intrinsic_done_1 (void)
3178 {
3179   gfc_free (functions);
3180   gfc_free (conversion);
3181   gfc_free (char_conversions);
3182   gfc_free_namespace (gfc_intrinsic_namespace);
3183 }
3184
3185
3186 /******** Subroutines to check intrinsic interfaces ***********/
3187
3188 /* Given a formal argument list, remove any NULL arguments that may
3189    have been left behind by a sort against some formal argument list.  */
3190
3191 static void
3192 remove_nullargs (gfc_actual_arglist **ap)
3193 {
3194   gfc_actual_arglist *head, *tail, *next;
3195
3196   tail = NULL;
3197
3198   for (head = *ap; head; head = next)
3199     {
3200       next = head->next;
3201
3202       if (head->expr == NULL && !head->label)
3203         {
3204           head->next = NULL;
3205           gfc_free_actual_arglist (head);
3206         }
3207       else
3208         {
3209           if (tail == NULL)
3210             *ap = head;
3211           else
3212             tail->next = head;
3213
3214           tail = head;
3215           tail->next = NULL;
3216         }
3217     }
3218
3219   if (tail == NULL)
3220     *ap = NULL;
3221 }
3222
3223
3224 /* Given an actual arglist and a formal arglist, sort the actual
3225    arglist so that its arguments are in a one-to-one correspondence
3226    with the format arglist.  Arguments that are not present are given
3227    a blank gfc_actual_arglist structure.  If something is obviously
3228    wrong (say, a missing required argument) we abort sorting and
3229    return FAILURE.  */
3230
3231 static gfc_try
3232 sort_actual (const char *name, gfc_actual_arglist **ap,
3233              gfc_intrinsic_arg *formal, locus *where)
3234 {
3235   gfc_actual_arglist *actual, *a;
3236   gfc_intrinsic_arg *f;
3237
3238   remove_nullargs (ap);
3239   actual = *ap;
3240
3241   for (f = formal; f; f = f->next)
3242     f->actual = NULL;
3243
3244   f = formal;
3245   a = actual;
3246
3247   if (f == NULL && a == NULL)   /* No arguments */
3248     return SUCCESS;
3249
3250   for (;;)
3251     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3252       if (f == NULL)
3253         break;
3254       if (a == NULL)
3255         goto optional;
3256
3257       if (a->name != NULL)
3258         goto keywords;
3259
3260       f->actual = a;
3261
3262       f = f->next;
3263       a = a->next;
3264     }
3265
3266   if (a == NULL)
3267     goto do_sort;
3268
3269   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3270   return FAILURE;
3271
3272 keywords:
3273   /* Associate the remaining actual arguments, all of which have
3274      to be keyword arguments.  */
3275   for (; a; a = a->next)
3276     {
3277       for (f = formal; f; f = f->next)
3278         if (strcmp (a->name, f->name) == 0)
3279           break;
3280
3281       if (f == NULL)
3282         {
3283           if (a->name[0] == '%')
3284             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3285                        "are not allowed in this context at %L", where);
3286           else
3287             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3288                        a->name, name, where);
3289           return FAILURE;
3290         }
3291
3292       if (f->actual != NULL)
3293         {
3294           gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3295                      f->name, name, where);
3296           return FAILURE;
3297         }
3298
3299       f->actual = a;
3300     }
3301
3302 optional:
3303   /* At this point, all unmatched formal args must be optional.  */
3304   for (f = formal; f; f = f->next)
3305     {
3306       if (f->actual == NULL && f->optional == 0)
3307         {
3308           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3309                      f->name, name, where);
3310           return FAILURE;
3311         }
3312     }
3313
3314 do_sort:
3315   /* Using the formal argument list, string the actual argument list
3316      together in a way that corresponds with the formal list.  */
3317   actual = NULL;
3318
3319   for (f = formal; f; f = f->next)
3320     {
3321       if (f->actual && f->actual->label != NULL && f->ts.type)
3322         {
3323           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3324           return FAILURE;
3325         }
3326
3327       if (f->actual == NULL)
3328         {
3329           a = gfc_get_actual_arglist ();
3330           a->missing_arg_type = f->ts.type;
3331         }
3332       else
3333         a = f->actual;
3334
3335       if (actual == NULL)
3336         *ap = a;
3337       else
3338         actual->next = a;
3339
3340       actual = a;
3341     }
3342   actual->next = NULL;          /* End the sorted argument list.  */
3343
3344   return SUCCESS;
3345 }
3346
3347
3348 /* Compare an actual argument list with an intrinsic's formal argument
3349    list.  The lists are checked for agreement of type.  We don't check
3350    for arrayness here.  */
3351
3352 static gfc_try
3353 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3354                int error_flag)
3355 {
3356   gfc_actual_arglist *actual;
3357   gfc_intrinsic_arg *formal;
3358   int i;
3359
3360   formal = sym->formal;
3361   actual = *ap;
3362
3363   i = 0;
3364   for (; formal; formal = formal->next, actual = actual->next, i++)
3365     {
3366       gfc_typespec ts;
3367
3368       if (actual->expr == NULL)
3369         continue;
3370
3371       ts = formal->ts;
3372
3373       /* A kind of 0 means we don't check for kind.  */
3374       if (ts.kind == 0)
3375         ts.kind = actual->expr->ts.kind;
3376
3377       if (!gfc_compare_types (&ts, &actual->expr->ts))
3378         {
3379           if (error_flag)
3380             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3381                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3382                        gfc_current_intrinsic, &actual->expr->where,
3383                        gfc_typename (&formal->ts),
3384                        gfc_typename (&actual->expr->ts));
3385           return FAILURE;
3386         }
3387     }
3388
3389   return SUCCESS;
3390 }
3391
3392
3393 /* Given a pointer to an intrinsic symbol and an expression node that
3394    represent the function call to that subroutine, figure out the type
3395    of the result.  This may involve calling a resolution subroutine.  */
3396
3397 static void
3398 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3399 {
3400   gfc_expr *a1, *a2, *a3, *a4, *a5;
3401   gfc_actual_arglist *arg;
3402
3403   if (specific->resolve.f1 == NULL)
3404     {
3405       if (e->value.function.name == NULL)
3406         e->value.function.name = specific->lib_name;
3407
3408       if (e->ts.type == BT_UNKNOWN)
3409         e->ts = specific->ts;
3410       return;
3411     }
3412
3413   arg = e->value.function.actual;
3414
3415   /* Special case hacks for MIN and MAX.  */
3416   if (specific->resolve.f1m == gfc_resolve_max
3417       || specific->resolve.f1m == gfc_resolve_min)
3418     {
3419       (*specific->resolve.f1m) (e, arg);
3420       return;
3421     }
3422
3423   if (arg == NULL)
3424     {
3425       (*specific->resolve.f0) (e);
3426       return;
3427     }
3428
3429   a1 = arg->expr;
3430   arg = arg->next;
3431
3432   if (arg == NULL)
3433     {
3434       (*specific->resolve.f1) (e, a1);
3435       return;
3436     }
3437
3438   a2 = arg->expr;
3439   arg = arg->next;
3440
3441   if (arg == NULL)
3442     {
3443       (*specific->resolve.f2) (e, a1, a2);
3444       return;
3445     }
3446
3447   a3 = arg->expr;
3448   arg = arg->next;
3449
3450   if (arg == NULL)
3451     {
3452       (*specific->resolve.f3) (e, a1, a2, a3);
3453       return;
3454     }
3455
3456   a4 = arg->expr;
3457   arg = arg->next;
3458
3459   if (arg == NULL)
3460     {
3461       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3462       return;
3463     }
3464
3465   a5 = arg->expr;
3466   arg = arg->next;
3467
3468   if (arg == NULL)
3469     {
3470       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3471       return;
3472     }
3473
3474   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3475 }
3476
3477
3478 /* Given an intrinsic symbol node and an expression node, call the
3479    simplification function (if there is one), perhaps replacing the
3480    expression with something simpler.  We return FAILURE on an error
3481    of the simplification, SUCCESS if the simplification worked, even
3482    if nothing has changed in the expression itself.  */
3483
3484 static gfc_try
3485 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3486 {
3487   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3488   gfc_actual_arglist *arg;
3489
3490   /* Max and min require special handling due to the variable number
3491      of args.  */
3492   if (specific->simplify.f1 == gfc_simplify_min)
3493     {
3494       result = gfc_simplify_min (e);
3495       goto finish;
3496     }
3497
3498   if (specific->simplify.f1 == gfc_simplify_max)
3499     {
3500       result = gfc_simplify_max (e);
3501       goto finish;
3502     }
3503
3504   if (specific->simplify.f1 == NULL)
3505     {
3506       result = NULL;
3507       goto finish;
3508     }
3509
3510   arg = e->value.function.actual;
3511
3512   if (arg == NULL)
3513     {
3514       result = (*specific->simplify.f0) ();
3515       goto finish;
3516     }
3517
3518   a1 = arg->expr;
3519   arg = arg->next;
3520
3521   if (specific->simplify.cc == gfc_convert_constant
3522       || specific->simplify.cc == gfc_convert_char_constant)
3523     {
3524       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3525       goto finish;
3526     }
3527
3528   if (arg == NULL)
3529     result = (*specific->simplify.f1) (a1);
3530   else
3531     {
3532       a2 = arg->expr;
3533       arg = arg->next;
3534
3535       if (arg == NULL)
3536         result = (*specific->simplify.f2) (a1, a2);
3537       else
3538         {
3539           a3 = arg->expr;
3540           arg = arg->next;
3541
3542           if (arg == NULL)
3543             result = (*specific->simplify.f3) (a1, a2, a3);
3544           else
3545             {
3546               a4 = arg->expr;
3547               arg = arg->next;
3548
3549               if (arg == NULL)
3550                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3551               else
3552                 {
3553                   a5 = arg->expr;
3554                   arg = arg->next;
3555
3556                   if (arg == NULL)
3557                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3558                   else
3559                     gfc_internal_error
3560                       ("do_simplify(): Too many args for intrinsic");
3561                 }
3562             }
3563         }
3564     }
3565
3566 finish:
3567   if (result == &gfc_bad_expr)
3568     return FAILURE;
3569
3570   if (result == NULL)
3571     resolve_intrinsic (specific, e);    /* Must call at run-time */
3572   else
3573     {
3574       result->where = e->where;
3575       gfc_replace_expr (e, result);
3576     }
3577
3578   return SUCCESS;
3579 }
3580
3581
3582 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3583    error messages.  This subroutine returns FAILURE if a subroutine
3584    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3585    list cannot match any intrinsic.  */
3586
3587 static void
3588 init_arglist (gfc_intrinsic_sym *isym)
3589 {
3590   gfc_intrinsic_arg *formal;
3591   int i;
3592
3593   gfc_current_intrinsic = isym->name;
3594
3595   i = 0;
3596   for (formal = isym->formal; formal; formal = formal->next)
3597     {
3598       if (i >= MAX_INTRINSIC_ARGS)
3599         gfc_internal_error ("init_arglist(): too many arguments");
3600       gfc_current_intrinsic_arg[i++] = formal->name;
3601     }
3602 }
3603
3604
3605 /* Given a pointer to an intrinsic symbol and an expression consisting
3606    of a function call, see if the function call is consistent with the
3607    intrinsic's formal argument list.  Return SUCCESS if the expression
3608    and intrinsic match, FAILURE otherwise.  */
3609
3610 static gfc_try
3611 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3612 {
3613   gfc_actual_arglist *arg, **ap;
3614   gfc_try t;
3615
3616   ap = &expr->value.function.actual;
3617
3618   init_arglist (specific);
3619
3620   /* Don't attempt to sort the argument list for min or max.  */
3621   if (specific->check.f1m == gfc_check_min_max
3622       || specific->check.f1m == gfc_check_min_max_integer
3623       || specific->check.f1m == gfc_check_min_max_real
3624       || specific->check.f1m == gfc_check_min_max_double)
3625     return (*specific->check.f1m) (*ap);
3626
3627   if (sort_actual (specific->name, ap, specific->formal,
3628                    &expr->where) == FAILURE)
3629     return FAILURE;
3630
3631   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3632     /* This is special because we might have to reorder the argument list.  */
3633     t = gfc_check_minloc_maxloc (*ap);
3634   else if (specific->check.f3red == gfc_check_minval_maxval)
3635     /* This is also special because we also might have to reorder the
3636        argument list.  */
3637     t = gfc_check_minval_maxval (*ap);
3638   else if (specific->check.f3red == gfc_check_product_sum)
3639     /* Same here. The difference to the previous case is that we allow a
3640        general numeric type.  */
3641     t = gfc_check_product_sum (*ap);
3642   else
3643      {
3644        if (specific->check.f1 == NULL)
3645          {
3646            t = check_arglist (ap, specific, error_flag);
3647            if (t == SUCCESS)
3648              expr->ts = specific->ts;
3649          }
3650        else
3651          t = do_check (specific, *ap);
3652      }
3653
3654   /* Check conformance of elemental intrinsics.  */
3655   if (t == SUCCESS && specific->elemental)
3656     {
3657       int n = 0;
3658       gfc_expr *first_expr;
3659       arg = expr->value.function.actual;
3660
3661       /* There is no elemental intrinsic without arguments.  */
3662       gcc_assert(arg != NULL);
3663       first_expr = arg->expr;
3664
3665       for ( ; arg && arg->expr; arg = arg->next, n++)
3666         if (gfc_check_conformance (first_expr, arg->expr,
3667                                    "arguments '%s' and '%s' for "
3668                                    "intrinsic '%s'",
3669                                    gfc_current_intrinsic_arg[0],
3670                                    gfc_current_intrinsic_arg[n],
3671                                    gfc_current_intrinsic) == FAILURE)
3672           return FAILURE;
3673     }
3674
3675   if (t == FAILURE)
3676     remove_nullargs (ap);
3677
3678   return t;
3679 }
3680
3681
3682 /* Check whether an intrinsic belongs to whatever standard the user
3683    has chosen, taking also into account -fall-intrinsics.  Here, no
3684    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3685    textual representation of the symbols standard status (like
3686    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3687    can be used to construct a detailed warning/error message in case of
3688    a FAILURE.  */
3689
3690 gfc_try
3691 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3692                               const char** symstd, bool silent, locus where)
3693 {
3694   const char* symstd_msg;
3695
3696   /* For -fall-intrinsics, just succeed.  */
3697   if (gfc_option.flag_all_intrinsics)
3698     return SUCCESS;
3699
3700   /* Find the symbol's standard message for later usage.  */
3701   switch (isym->standard)
3702     {
3703     case GFC_STD_F77:
3704       symstd_msg = "available since Fortran 77";
3705       break;
3706
3707     case GFC_STD_F95_OBS:
3708       symstd_msg = "obsolescent in Fortran 95";
3709       break;
3710
3711     case GFC_STD_F95_DEL:
3712       symstd_msg = "deleted in Fortran 95";
3713       break;
3714
3715     case GFC_STD_F95:
3716       symstd_msg = "new in Fortran 95";
3717       break;
3718
3719     case GFC_STD_F2003:
3720       symstd_msg = "new in Fortran 2003";
3721       break;
3722
3723     case GFC_STD_F2008:
3724       symstd_msg = "new in Fortran 2008";
3725       break;
3726
3727     case GFC_STD_GNU:
3728       symstd_msg = "a GNU Fortran extension";
3729       break;
3730
3731     case GFC_STD_LEGACY:
3732       symstd_msg = "for backward compatibility";
3733       break;
3734
3735     default:
3736       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3737                           isym->name, isym->standard);
3738     }
3739
3740   /* If warning about the standard, warn and succeed.  */
3741   if (gfc_option.warn_std & isym->standard)
3742     {
3743       /* Do only print a warning if not a GNU extension.  */
3744       if (!silent && isym->standard != GFC_STD_GNU)
3745         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3746                      isym->name, _(symstd_msg), &where);
3747
3748       return SUCCESS;
3749     }
3750
3751   /* If allowing the symbol's standard, succeed, too.  */
3752   if (gfc_option.allow_std & isym->standard)
3753     return SUCCESS;
3754
3755   /* Otherwise, fail.  */
3756   if (symstd)
3757     *symstd = _(symstd_msg);
3758   return FAILURE;
3759 }
3760
3761
3762 /* See if a function call corresponds to an intrinsic function call.
3763    We return:
3764
3765     MATCH_YES    if the call corresponds to an intrinsic, simplification
3766                  is done if possible.
3767
3768     MATCH_NO     if the call does not correspond to an intrinsic
3769
3770     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3771                  error during the simplification process.
3772
3773    The error_flag parameter enables an error reporting.  */
3774
3775 match
3776 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3777 {
3778   gfc_intrinsic_sym *isym, *specific;
3779   gfc_actual_arglist *actual;
3780   const char *name;
3781   int flag;
3782
3783   if (expr->value.function.isym != NULL)
3784     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3785            ? MATCH_ERROR : MATCH_YES;
3786
3787   if (!error_flag)
3788     gfc_push_suppress_errors ();
3789   flag = 0;
3790
3791   for (actual = expr->value.function.actual; actual; actual = actual->next)
3792     if (actual->expr != NULL)
3793       flag |= (actual->expr->ts.type != BT_INTEGER
3794                && actual->expr->ts.type != BT_CHARACTER);
3795
3796   name = expr->symtree->n.sym->name;
3797
3798   isym = specific = gfc_find_function (name);
3799   if (isym == NULL)
3800     {
3801       if (!error_flag)
3802         gfc_pop_suppress_errors ();
3803       return MATCH_NO;
3804     }
3805
3806   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3807        || isym->id == GFC_ISYM_CMPLX)
3808       && gfc_init_expr_flag
3809       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3810                          "as initialization expression at %L", name,
3811                          &expr->where) == FAILURE)
3812     {
3813       if (!error_flag)
3814         gfc_pop_suppress_errors ();
3815       return MATCH_ERROR;
3816     }
3817
3818   gfc_current_intrinsic_where = &expr->where;
3819
3820   /* Bypass the generic list for min and max.  */
3821   if (isym->check.f1m == gfc_check_min_max)
3822     {
3823       init_arglist (isym);
3824
3825       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3826         goto got_specific;
3827
3828       if (!error_flag)
3829         gfc_pop_suppress_errors ();
3830       return MATCH_NO;
3831     }
3832
3833   /* If the function is generic, check all of its specific
3834      incarnations.  If the generic name is also a specific, we check
3835      that name last, so that any error message will correspond to the
3836      specific.  */
3837   gfc_push_suppress_errors ();
3838
3839   if (isym->generic)
3840     {
3841       for (specific = isym->specific_head; specific;
3842            specific = specific->next)
3843         {
3844           if (specific == isym)
3845             continue;
3846           if (check_specific (specific, expr, 0) == SUCCESS)
3847             {
3848               gfc_pop_suppress_errors ();
3849               goto got_specific;
3850             }
3851         }
3852     }
3853
3854   gfc_pop_suppress_errors ();
3855
3856   if (check_specific (isym, expr, error_flag) == FAILURE)
3857     {
3858       if (!error_flag)
3859         gfc_pop_suppress_errors ();
3860       return MATCH_NO;
3861     }
3862
3863   specific = isym;
3864
3865 got_specific:
3866   expr->value.function.isym = specific;
3867   gfc_intrinsic_symbol (expr->symtree->n.sym);
3868
3869   if (!error_flag)
3870     gfc_pop_suppress_errors ();
3871
3872   if (do_simplify (specific, expr) == FAILURE)
3873     return MATCH_ERROR;
3874
3875   /* F95, 7.1.6.1, Initialization expressions
3876      (4) An elemental intrinsic function reference of type integer or
3877          character where each argument is an initialization expression
3878          of type integer or character
3879
3880      F2003, 7.1.7 Initialization expression
3881      (4)   A reference to an elemental standard intrinsic function,
3882            where each argument is an initialization expression  */
3883
3884   if (gfc_init_expr_flag && isym->elemental && flag
3885       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3886                         "as initialization expression with non-integer/non-"
3887                         "character arguments at %L", &expr->where) == FAILURE)
3888     return MATCH_ERROR;
3889
3890   return MATCH_YES;
3891 }
3892
3893
3894 /* See if a CALL statement corresponds to an intrinsic subroutine.
3895    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3896    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3897    correspond).  */
3898
3899 match
3900 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3901 {
3902   gfc_intrinsic_sym *isym;
3903   const char *name;
3904
3905   name = c->symtree->n.sym->name;
3906
3907   isym = gfc_find_subroutine (name);
3908   if (isym == NULL)
3909     return MATCH_NO;
3910
3911   if (!error_flag)
3912     gfc_push_suppress_errors ();
3913
3914   init_arglist (isym);
3915
3916   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3917     goto fail;
3918
3919   if (isym->check.f1 != NULL)
3920     {
3921       if (do_check (isym, c->ext.actual) == FAILURE)
3922         goto fail;
3923     }
3924   else
3925     {
3926       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3927         goto fail;
3928     }
3929
3930   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3931      seen at this point.  */
3932   if (!error_flag)
3933     gfc_pop_suppress_errors ();
3934
3935   c->resolved_isym = isym;
3936   if (isym->resolve.s1 != NULL)
3937     isym->resolve.s1 (c);
3938   else
3939     {
3940       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3941       c->resolved_sym->attr.elemental = isym->elemental;
3942     }
3943
3944   if (gfc_pure (NULL) && !isym->elemental)
3945     {
3946       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3947                  &c->loc);
3948       return MATCH_ERROR;
3949     }
3950
3951   c->resolved_sym->attr.noreturn = isym->noreturn;
3952
3953   return MATCH_YES;
3954
3955 fail:
3956   if (!error_flag)
3957     gfc_pop_suppress_errors ();
3958   return MATCH_NO;
3959 }
3960
3961
3962 /* Call gfc_convert_type() with warning enabled.  */
3963
3964 gfc_try
3965 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3966 {
3967   return gfc_convert_type_warn (expr, ts, eflag, 1);
3968 }
3969
3970
3971 /* Try to convert an expression (in place) from one type to another.
3972    'eflag' controls the behavior on error.
3973
3974    The possible values are:
3975
3976      1 Generate a gfc_error()
3977      2 Generate a gfc_internal_error().
3978
3979    'wflag' controls the warning related to conversion.  */
3980
3981 gfc_try
3982 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3983 {
3984   gfc_intrinsic_sym *sym;
3985   gfc_typespec from_ts;
3986   locus old_where;
3987   gfc_expr *new_expr;
3988   int rank;
3989   mpz_t *shape;
3990
3991   from_ts = expr->ts;           /* expr->ts gets clobbered */
3992
3993   if (ts->type == BT_UNKNOWN)
3994     goto bad;
3995
3996   /* NULL and zero size arrays get their type here.  */
3997   if (expr->expr_type == EXPR_NULL
3998       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3999     {
4000       /* Sometimes the RHS acquire the type.  */
4001       expr->ts = *ts;
4002       return SUCCESS;
4003     }
4004
4005   if (expr->ts.type == BT_UNKNOWN)
4006     goto bad;
4007
4008   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4009       && gfc_compare_types (&expr->ts, ts))
4010     return SUCCESS;
4011
4012   sym = find_conv (&expr->ts, ts);
4013   if (sym == NULL)
4014     goto bad;
4015
4016   /* At this point, a conversion is necessary. A warning may be needed.  */
4017   if ((gfc_option.warn_std & sym->standard) != 0)
4018     {
4019       gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4020                        gfc_typename (&from_ts), gfc_typename (ts),
4021                        &expr->where);
4022     }
4023   else if (wflag)
4024     {
4025       if (gfc_option.flag_range_check
4026           && expr->expr_type == EXPR_CONSTANT
4027           && from_ts.type == ts->type)
4028         {
4029           /* Do nothing. Constants of the same type are range-checked
4030              elsewhere. If a value too large for the target type is
4031              assigned, an error is generated. Not checking here avoids
4032              duplications of warnings/errors.
4033              If range checking was disabled, but -Wconversion enabled,
4034              a non range checked warning is generated below.  */
4035         }
4036       else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4037         {
4038           /* Do nothing. This block exists only to simplify the other
4039              else-if expressions.
4040                LOGICAL <> LOGICAL    no warning, independent of kind values
4041                LOGICAL <> INTEGER    extension, warned elsewhere
4042                LOGICAL <> REAL       invalid, error generated elsewhere
4043                LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
4044         }
4045       else if (from_ts.type == ts->type
4046                || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4047                || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4048                || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4049         {
4050           /* Larger kinds can hold values of smaller kinds without problems.
4051              Hence, only warn if target kind is smaller than the source
4052              kind - or if -Wconversion-extra is specified.  */
4053           if (gfc_option.warn_conversion_extra)
4054             gfc_warning_now ("Conversion from %s to %s at %L",
4055                              gfc_typename (&from_ts), gfc_typename (ts),
4056                              &expr->where);
4057           else if (gfc_option.warn_conversion
4058                    && from_ts.kind > ts->kind)
4059             gfc_warning_now ("Possible change of value in conversion "
4060                              "from %s to %s at %L", gfc_typename (&from_ts),
4061                              gfc_typename (ts), &expr->where);
4062         }
4063       else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4064                || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4065                || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4066         {
4067           /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4068              usually comes with a loss of information, regardless of kinds.  */
4069           if (gfc_option.warn_conversion_extra
4070               || gfc_option.warn_conversion)
4071             gfc_warning_now ("Possible change of value in conversion "
4072                              "from %s to %s at %L", gfc_typename (&from_ts),
4073                              gfc_typename (ts), &expr->where);
4074         }
4075       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4076         {
4077           /* If HOLLERITH is involved, all bets are off.  */
4078           if (gfc_option.warn_conversion_extra
4079               || gfc_option.warn_conversion)
4080             gfc_warning_now ("Conversion from %s to %s at %L",
4081                              gfc_typename (&from_ts), gfc_typename (ts),
4082                              &expr->where);
4083         }
4084       else
4085         gcc_unreachable ();
4086     }
4087
4088   /* Insert a pre-resolved function call to the right function.  */
4089   old_where = expr->where;
4090   rank = expr->rank;
4091   shape = expr->shape;
4092
4093   new_expr = gfc_get_expr ();
4094   *new_expr = *expr;
4095
4096   new_expr = gfc_build_conversion (new_expr);
4097   new_expr->value.function.name = sym->lib_name;
4098   new_expr->value.function.isym = sym;
4099   new_expr->where = old_where;
4100   new_expr->rank = rank;
4101   new_expr->shape = gfc_copy_shape (shape, rank);
4102
4103   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4104   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4105   new_expr->symtree->n.sym->ts = *ts;
4106   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4107   new_expr->symtree->n.sym->attr.function = 1;
4108   new_expr->symtree->n.sym->attr.elemental = 1;
4109   new_expr->symtree->n.sym->attr.pure = 1;
4110   new_expr->symtree->n.sym->attr.referenced = 1;
4111   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4112   gfc_commit_symbol (new_expr->symtree->n.sym);
4113
4114   *expr = *new_expr;
4115
4116   gfc_free (new_expr);
4117   expr->ts = *ts;
4118
4119   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4120       && do_simplify (sym, expr) == FAILURE)
4121     {
4122
4123       if (eflag == 2)
4124         goto bad;
4125       return FAILURE;           /* Error already generated in do_simplify() */
4126     }
4127
4128   return SUCCESS;
4129
4130 bad:
4131   if (eflag == 1)
4132     {
4133       gfc_error ("Can't convert %s to %s at %L",
4134                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4135       return FAILURE;
4136     }
4137
4138   gfc_internal_error ("Can't convert %s to %s at %L",
4139                       gfc_typename (&from_ts), gfc_typename (ts),
4140                       &expr->where);
4141   /* Not reached */
4142 }
4143
4144
4145 gfc_try
4146 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4147 {
4148   gfc_intrinsic_sym *sym;
4149   locus old_where;
4150   gfc_expr *new_expr;
4151   int rank;
4152   mpz_t *shape;
4153
4154   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4155
4156   sym = find_char_conv (&expr->ts, ts);
4157   gcc_assert (sym);
4158
4159   /* Insert a pre-resolved function call to the right function.  */
4160   old_where = expr->where;
4161   rank = expr->rank;
4162   shape = expr->shape;
4163
4164   new_expr = gfc_get_expr ();
4165   *new_expr = *expr;
4166
4167   new_expr = gfc_build_conversion (new_expr);
4168   new_expr->value.function.name = sym->lib_name;
4169   new_expr->value.function.isym = sym;
4170   new_expr->where = old_where;
4171   new_expr->rank = rank;
4172   new_expr->shape = gfc_copy_shape (shape, rank);
4173
4174   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4175   new_expr->symtree->n.sym->ts = *ts;
4176   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4177   new_expr->symtree->n.sym->attr.function = 1;
4178   new_expr->symtree->n.sym->attr.elemental = 1;
4179   new_expr->symtree->n.sym->attr.referenced = 1;
4180   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4181   gfc_commit_symbol (new_expr->symtree->n.sym);
4182
4183   *expr = *new_expr;
4184
4185   gfc_free (new_expr);
4186   expr->ts = *ts;
4187
4188   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4189       && do_simplify (sym, expr) == FAILURE)
4190     {
4191       /* Error already generated in do_simplify() */
4192       return FAILURE;
4193     }
4194
4195   return SUCCESS;
4196 }
4197
4198
4199 /* Check if the passed name is name of an intrinsic (taking into account the
4200    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4201    warn about this as a user-procedure having the same name as an intrinsic
4202    (-Wintrinsic-shadow enabled) and do so if we should.  */
4203
4204 void
4205 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4206 {
4207   gfc_intrinsic_sym* isym;
4208
4209   /* If the warning is disabled, do nothing at all.  */
4210   if (!gfc_option.warn_intrinsic_shadow)
4211     return;
4212
4213   /* Try to find an intrinsic of the same name.  */
4214   if (func)
4215     isym = gfc_find_function (sym->name);
4216   else
4217     isym = gfc_find_subroutine (sym->name);
4218
4219   /* If no intrinsic was found with this name or it's not included in the
4220      selected standard, everything's fine.  */
4221   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4222                                              sym->declared_at) == FAILURE)
4223     return;
4224
4225   /* Emit the warning.  */
4226   if (in_module)
4227     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4228                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4229                  " declarations may be required.",
4230                  sym->name, &sym->declared_at);
4231   else
4232     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4233                  " only be called via an explicit interface or if declared"
4234                  " EXTERNAL.", sym->name, &sym->declared_at);
4235 }