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_3 ("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              "radix", BT_INTEGER, di, OPTIONAL);
2383
2384   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2385
2386   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2387              gfc_check_set_exponent, gfc_simplify_set_exponent,
2388              gfc_resolve_set_exponent,
2389              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2390
2391   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2392
2393   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2394              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2395              src, BT_REAL, dr, REQUIRED);
2396
2397   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2398
2399   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2400              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2401              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2402
2403   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2404              NULL, gfc_simplify_sign, gfc_resolve_sign,
2405              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2406
2407   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2408              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2409              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2410
2411   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2412
2413   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2414              gfc_check_signal, NULL, gfc_resolve_signal,
2415              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2416
2417   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2418
2419   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2420              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2421              x, BT_REAL, dr, REQUIRED);
2422
2423   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2424              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2425              x, BT_REAL, dd, REQUIRED);
2426
2427   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2428              NULL, gfc_simplify_sin, gfc_resolve_sin,
2429              x, BT_COMPLEX, dz, REQUIRED);
2430
2431   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2432              NULL, gfc_simplify_sin, gfc_resolve_sin,
2433              x, BT_COMPLEX, dd, REQUIRED);
2434
2435   make_alias ("cdsin", GFC_STD_GNU);
2436
2437   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2438
2439   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2440              gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2441              x, BT_REAL, dr, REQUIRED);
2442
2443   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2444              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2445              x, BT_REAL, dd, REQUIRED);
2446
2447   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2448
2449   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2450              BT_INTEGER, di, GFC_STD_F95,
2451              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2452              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2453              kind, BT_INTEGER, di, OPTIONAL);
2454
2455   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2456
2457   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2458              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2459              x, BT_UNKNOWN, 0, REQUIRED);
2460
2461   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2462
2463   add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
2464              BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
2465              x, BT_UNKNOWN, 0, REQUIRED);
2466
2467   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2468              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2469              x, BT_REAL, dr, REQUIRED);
2470
2471   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2472
2473   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2474              gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2475              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2476              ncopies, BT_INTEGER, di, REQUIRED);
2477
2478   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2479
2480   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2481              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2482              x, BT_REAL, dr, REQUIRED);
2483
2484   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2485              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2486              x, BT_REAL, dd, REQUIRED);
2487
2488   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2489              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2490              x, BT_COMPLEX, dz, REQUIRED);
2491
2492   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2493              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2494              x, BT_COMPLEX, dd, REQUIRED);
2495
2496   make_alias ("cdsqrt", GFC_STD_GNU);
2497
2498   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2499
2500   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2501              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2502              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2503
2504   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2505
2506   add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2507              BT_INTEGER, di, GFC_STD_F2008,
2508              gfc_check_storage_size, NULL, gfc_resolve_storage_size,
2509              a, BT_UNKNOWN, 0, REQUIRED,
2510              kind, BT_INTEGER, di, OPTIONAL);
2511
2512   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2513                 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2514                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2515                 msk, BT_LOGICAL, dl, OPTIONAL);
2516
2517   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2518
2519   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2520              GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2521              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2522
2523   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2524
2525   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2526              GFC_STD_GNU, NULL, NULL, NULL,
2527              com, BT_CHARACTER, dc, REQUIRED);
2528
2529   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2530
2531   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2532              gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2533              x, BT_REAL, dr, REQUIRED);
2534
2535   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2536              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2537              x, BT_REAL, dd, REQUIRED);
2538
2539   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2540
2541   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2542              gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2543              x, BT_REAL, dr, REQUIRED);
2544
2545   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2546              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2547              x, BT_REAL, dd, REQUIRED);
2548
2549   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2550
2551   add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2552              gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
2553              ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2554
2555   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2556              NULL, NULL, gfc_resolve_time);
2557
2558   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2559
2560   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2561              NULL, NULL, gfc_resolve_time8);
2562
2563   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2564
2565   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2566              gfc_check_x, gfc_simplify_tiny, NULL,
2567              x, BT_REAL, dr, REQUIRED);
2568
2569   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2570
2571   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2572              BT_INTEGER, di, GFC_STD_F2008,
2573              gfc_check_i, gfc_simplify_trailz, NULL,
2574              i, BT_INTEGER, di, REQUIRED);
2575
2576   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2577
2578   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2579              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2580              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2581              sz, BT_INTEGER, di, OPTIONAL);
2582
2583   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2584
2585   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2586              gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2587              m, BT_REAL, dr, REQUIRED);
2588
2589   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2590
2591   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2592              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2593              stg, BT_CHARACTER, dc, REQUIRED);
2594
2595   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2596
2597   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2598              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2599              ut, BT_INTEGER, di, REQUIRED);
2600
2601   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2602
2603   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2604              BT_INTEGER, di, GFC_STD_F95,
2605              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2606              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2607              kind, BT_INTEGER, di, OPTIONAL);
2608
2609   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2610
2611   add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2612             BT_INTEGER, di, GFC_STD_F2008,
2613             gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2614             ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2615             kind, BT_INTEGER, di, OPTIONAL);
2616
2617   make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
2618
2619   /* g77 compatibility for UMASK.  */
2620   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2621              GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2622              msk, BT_INTEGER, di, REQUIRED);
2623
2624   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2625
2626   /* g77 compatibility for UNLINK.  */
2627   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2628              gfc_check_unlink, NULL, gfc_resolve_unlink,
2629              "path", BT_CHARACTER, dc, REQUIRED);
2630
2631   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2632
2633   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2634              gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2635              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2636              f, BT_REAL, dr, REQUIRED);
2637
2638   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2639
2640   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2641              BT_INTEGER, di, GFC_STD_F95,
2642              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2643              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2644              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2645
2646   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2647
2648   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2649              GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2650              x, BT_UNKNOWN, 0, REQUIRED);
2651
2652   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2653 }
2654
2655
2656 /* Add intrinsic subroutines.  */
2657
2658 static void
2659 add_subroutines (void)
2660 {
2661   /* Argument names as in the standard (to be used as argument keywords).  */
2662   const char
2663     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2664     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2665     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2666     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2667     *com = "command", *length = "length", *st = "status",
2668     *val = "value", *num = "number", *name = "name",
2669     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2670     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2671     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2672     *p2 = "path2", *msk = "mask", *old = "old";
2673
2674   int di, dr, dc, dl, ii;
2675
2676   di = gfc_default_integer_kind;
2677   dr = gfc_default_real_kind;
2678   dc = gfc_default_character_kind;
2679   dl = gfc_default_logical_kind;
2680   ii = gfc_index_integer_kind;
2681
2682   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2683
2684   make_noreturn();
2685
2686   add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2687                      GFC_STD_F95, gfc_check_cpu_time, NULL,
2688                      gfc_resolve_cpu_time,
2689                      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2690
2691   /* More G77 compatibility garbage.  */
2692   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2693               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2694               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2695
2696   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2697               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2698               vl, BT_INTEGER, 4, REQUIRED);
2699
2700   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2701               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2702               vl, BT_INTEGER, 4, REQUIRED);
2703
2704   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2705               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2706               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2707
2708   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2709               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2710               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2711
2712   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2713               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2714               tm, BT_REAL, dr, REQUIRED);
2715
2716   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2717               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2718               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2719
2720   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2721               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2722               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2723               st, BT_INTEGER, di, OPTIONAL);
2724
2725   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2726               GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2727               dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2728               tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2729               zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2730               vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2731
2732   /* More G77 compatibility garbage.  */
2733   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2734               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2735               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2736
2737   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2738               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2739               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2740
2741   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2742               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2743               dt, BT_CHARACTER, dc, REQUIRED);
2744
2745   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2746               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2747               dc, REQUIRED);
2748
2749   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2750               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2751               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2752
2753   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2754               NULL, NULL, NULL,
2755               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2756               REQUIRED);
2757
2758   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2759               gfc_check_getarg, NULL, gfc_resolve_getarg,
2760               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2761
2762   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2763               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2764               dc, REQUIRED);
2765
2766   /* F2003 commandline routines.  */
2767
2768   add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2769                      0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2770                      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2771                      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2772                      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2773
2774   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2775               BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2776               gfc_resolve_get_command_argument,
2777               num, BT_INTEGER, di, 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
2782   /* F2003 subroutine to get environment variables.  */
2783
2784   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2785               NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2786               NULL, NULL, gfc_resolve_get_environment_variable,
2787               name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2788               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2789               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2790               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2791               trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2792
2793   add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2794                      GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2795                      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2796                      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2797
2798   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2799               GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2800               gfc_resolve_mvbits,
2801               f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2802               fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2803               ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2804               t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2805               tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2806
2807   add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2808                      BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2809                      gfc_resolve_random_number,
2810                      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2811
2812   add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2813                      BT_UNKNOWN, 0, GFC_STD_F95,
2814                      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2815                      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2816                      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2817                      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2818
2819   /* More G77 compatibility garbage.  */
2820   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2821               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2822               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2823               st, BT_INTEGER, di, OPTIONAL);
2824
2825   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2826               gfc_check_srand, NULL, gfc_resolve_srand,
2827               "seed", BT_INTEGER, 4, REQUIRED);
2828
2829   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2830               gfc_check_exit, NULL, gfc_resolve_exit,
2831               st, BT_INTEGER, di, OPTIONAL);
2832
2833   make_noreturn();
2834
2835   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2836               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2837               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2838               st, BT_INTEGER, di, OPTIONAL);
2839
2840   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2841               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2842               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2843
2844   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2845               gfc_check_flush, NULL, gfc_resolve_flush,
2846               ut, BT_INTEGER, di, OPTIONAL);
2847
2848   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2849               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2850               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2851               st, BT_INTEGER, di, OPTIONAL);
2852
2853   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2854               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2855               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2856
2857   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2858               gfc_check_free, NULL, gfc_resolve_free,
2859               ptr, BT_INTEGER, ii, REQUIRED);
2860
2861   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2862               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2863               ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2864               of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2865               whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2866               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2867
2868   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2869               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2870               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2871
2872   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2873               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2874               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2875
2876   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2877               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2878               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2879
2880   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2881               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2882               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2883               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2884
2885   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2886               gfc_check_perror, NULL, gfc_resolve_perror,
2887               "string", BT_CHARACTER, dc, REQUIRED);
2888
2889   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2890               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2891               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2892               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2893
2894   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2895               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2896               sec, BT_INTEGER, di, REQUIRED);
2897
2898   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2899               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2900               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2901               st, BT_INTEGER, di, OPTIONAL);
2902
2903   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2904               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2905               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2906               st, BT_INTEGER, di, OPTIONAL);
2907
2908   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2909               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2910               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2911               st, BT_INTEGER, di, OPTIONAL);
2912
2913   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2914               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2915               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2916               st, BT_INTEGER, di, OPTIONAL);
2917
2918   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2919               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2920               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2921               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2922
2923   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2924               NULL, NULL, gfc_resolve_system_sub,
2925               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2926
2927   add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2928                      BT_UNKNOWN, 0, GFC_STD_F95,
2929                      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2930                      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2931                      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2932                      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2933
2934   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2935               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2936               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2937
2938   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2939               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2940               msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2941
2942   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2943               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2944               "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2945 }
2946
2947
2948 /* Add a function to the list of conversion symbols.  */
2949
2950 static void
2951 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2952 {
2953   gfc_typespec from, to;
2954   gfc_intrinsic_sym *sym;
2955
2956   if (sizing == SZ_CONVS)
2957     {
2958       nconv++;
2959       return;
2960     }
2961
2962   gfc_clear_ts (&from);
2963   from.type = from_type;
2964   from.kind = from_kind;
2965
2966   gfc_clear_ts (&to);
2967   to.type = to_type;
2968   to.kind = to_kind;
2969
2970   sym = conversion + nconv;
2971
2972   sym->name = conv_name (&from, &to);
2973   sym->lib_name = sym->name;
2974   sym->simplify.cc = gfc_convert_constant;
2975   sym->standard = standard;
2976   sym->elemental = 1;
2977   sym->conversion = 1;
2978   sym->ts = to;
2979   sym->id = GFC_ISYM_CONVERSION;
2980
2981   nconv++;
2982 }
2983
2984
2985 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2986    functions by looping over the kind tables.  */
2987
2988 static void
2989 add_conversions (void)
2990 {
2991   int i, j;
2992
2993   /* Integer-Integer conversions.  */
2994   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2995     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2996       {
2997         if (i == j)
2998           continue;
2999
3000         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3001                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
3002       }
3003
3004   /* Integer-Real/Complex conversions.  */
3005   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3006     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3007       {
3008         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3009                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3010
3011         add_conv (BT_REAL, gfc_real_kinds[j].kind,
3012                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3013
3014         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3015                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3016
3017         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3018                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3019       }
3020
3021   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3022     {
3023       /* Hollerith-Integer conversions.  */
3024       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3025         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3026                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3027       /* Hollerith-Real conversions.  */
3028       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3029         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3030                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3031       /* Hollerith-Complex conversions.  */
3032       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3033         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3034                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3035
3036       /* Hollerith-Character conversions.  */
3037       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3038                   gfc_default_character_kind, GFC_STD_LEGACY);
3039
3040       /* Hollerith-Logical conversions.  */
3041       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3042         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3043                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3044     }
3045
3046   /* Real/Complex - Real/Complex conversions.  */
3047   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3048     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3049       {
3050         if (i != j)
3051           {
3052             add_conv (BT_REAL, gfc_real_kinds[i].kind,
3053                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3054
3055             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3056                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3057           }
3058
3059         add_conv (BT_REAL, gfc_real_kinds[i].kind,
3060                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3061
3062         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3063                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3064       }
3065
3066   /* Logical/Logical kind conversion.  */
3067   for (i = 0; gfc_logical_kinds[i].kind; i++)
3068     for (j = 0; gfc_logical_kinds[j].kind; j++)
3069       {
3070         if (i == j)
3071           continue;
3072
3073         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3074                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3075       }
3076
3077   /* Integer-Logical and Logical-Integer conversions.  */
3078   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3079     for (i=0; gfc_integer_kinds[i].kind; i++)
3080       for (j=0; gfc_logical_kinds[j].kind; j++)
3081         {
3082           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3083                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3084           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3085                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3086         }
3087 }
3088
3089
3090 static void
3091 add_char_conversions (void)
3092 {
3093   int n, i, j;
3094
3095   /* Count possible conversions.  */
3096   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3097     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3098       if (i != j)
3099         ncharconv++;
3100
3101   /* Allocate memory.  */
3102   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3103
3104   /* Add the conversions themselves.  */
3105   n = 0;
3106   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3107     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3108       {
3109         gfc_typespec from, to;
3110
3111         if (i == j)
3112           continue;
3113
3114         gfc_clear_ts (&from);
3115         from.type = BT_CHARACTER;
3116         from.kind = gfc_character_kinds[i].kind;
3117
3118         gfc_clear_ts (&to);
3119         to.type = BT_CHARACTER;
3120         to.kind = gfc_character_kinds[j].kind;
3121
3122         char_conversions[n].name = conv_name (&from, &to);
3123         char_conversions[n].lib_name = char_conversions[n].name;
3124         char_conversions[n].simplify.cc = gfc_convert_char_constant;
3125         char_conversions[n].standard = GFC_STD_F2003;
3126         char_conversions[n].elemental = 1;
3127         char_conversions[n].conversion = 0;
3128         char_conversions[n].ts = to;
3129         char_conversions[n].id = GFC_ISYM_CONVERSION;
3130
3131         n++;
3132       }
3133 }
3134
3135
3136 /* Initialize the table of intrinsics.  */
3137 void
3138 gfc_intrinsic_init_1 (void)
3139 {
3140   int i;
3141
3142   nargs = nfunc = nsub = nconv = 0;
3143
3144   /* Create a namespace to hold the resolved intrinsic symbols.  */
3145   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3146
3147   sizing = SZ_FUNCS;
3148   add_functions ();
3149   sizing = SZ_SUBS;
3150   add_subroutines ();
3151   sizing = SZ_CONVS;
3152   add_conversions ();
3153
3154   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3155                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3156                         + sizeof (gfc_intrinsic_arg) * nargs);
3157
3158   next_sym = functions;
3159   subroutines = functions + nfunc;
3160
3161   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3162
3163   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3164
3165   sizing = SZ_NOTHING;
3166   nconv = 0;
3167
3168   add_functions ();
3169   add_subroutines ();
3170   add_conversions ();
3171
3172   /* Character conversion intrinsics need to be treated separately.  */
3173   add_char_conversions ();
3174
3175   /* Set the pure flag.  All intrinsic functions are pure, and
3176      intrinsic subroutines are pure if they are elemental.  */
3177
3178   for (i = 0; i < nfunc; i++)
3179     functions[i].pure = 1;
3180
3181   for (i = 0; i < nsub; i++)
3182     subroutines[i].pure = subroutines[i].elemental;
3183 }
3184
3185
3186 void
3187 gfc_intrinsic_done_1 (void)
3188 {
3189   gfc_free (functions);
3190   gfc_free (conversion);
3191   gfc_free (char_conversions);
3192   gfc_free_namespace (gfc_intrinsic_namespace);
3193 }
3194
3195
3196 /******** Subroutines to check intrinsic interfaces ***********/
3197
3198 /* Given a formal argument list, remove any NULL arguments that may
3199    have been left behind by a sort against some formal argument list.  */
3200
3201 static void
3202 remove_nullargs (gfc_actual_arglist **ap)
3203 {
3204   gfc_actual_arglist *head, *tail, *next;
3205
3206   tail = NULL;
3207
3208   for (head = *ap; head; head = next)
3209     {
3210       next = head->next;
3211
3212       if (head->expr == NULL && !head->label)
3213         {
3214           head->next = NULL;
3215           gfc_free_actual_arglist (head);
3216         }
3217       else
3218         {
3219           if (tail == NULL)
3220             *ap = head;
3221           else
3222             tail->next = head;
3223
3224           tail = head;
3225           tail->next = NULL;
3226         }
3227     }
3228
3229   if (tail == NULL)
3230     *ap = NULL;
3231 }
3232
3233
3234 /* Given an actual arglist and a formal arglist, sort the actual
3235    arglist so that its arguments are in a one-to-one correspondence
3236    with the format arglist.  Arguments that are not present are given
3237    a blank gfc_actual_arglist structure.  If something is obviously
3238    wrong (say, a missing required argument) we abort sorting and
3239    return FAILURE.  */
3240
3241 static gfc_try
3242 sort_actual (const char *name, gfc_actual_arglist **ap,
3243              gfc_intrinsic_arg *formal, locus *where)
3244 {
3245   gfc_actual_arglist *actual, *a;
3246   gfc_intrinsic_arg *f;
3247
3248   remove_nullargs (ap);
3249   actual = *ap;
3250
3251   for (f = formal; f; f = f->next)
3252     f->actual = NULL;
3253
3254   f = formal;
3255   a = actual;
3256
3257   if (f == NULL && a == NULL)   /* No arguments */
3258     return SUCCESS;
3259
3260   for (;;)
3261     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3262       if (f == NULL)
3263         break;
3264       if (a == NULL)
3265         goto optional;
3266
3267       if (a->name != NULL)
3268         goto keywords;
3269
3270       f->actual = a;
3271
3272       f = f->next;
3273       a = a->next;
3274     }
3275
3276   if (a == NULL)
3277     goto do_sort;
3278
3279   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3280   return FAILURE;
3281
3282 keywords:
3283   /* Associate the remaining actual arguments, all of which have
3284      to be keyword arguments.  */
3285   for (; a; a = a->next)
3286     {
3287       for (f = formal; f; f = f->next)
3288         if (strcmp (a->name, f->name) == 0)
3289           break;
3290
3291       if (f == NULL)
3292         {
3293           if (a->name[0] == '%')
3294             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3295                        "are not allowed in this context at %L", where);
3296           else
3297             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3298                        a->name, name, where);
3299           return FAILURE;
3300         }
3301
3302       if (f->actual != NULL)
3303         {
3304           gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3305                      f->name, name, where);
3306           return FAILURE;
3307         }
3308
3309       f->actual = a;
3310     }
3311
3312 optional:
3313   /* At this point, all unmatched formal args must be optional.  */
3314   for (f = formal; f; f = f->next)
3315     {
3316       if (f->actual == NULL && f->optional == 0)
3317         {
3318           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3319                      f->name, name, where);
3320           return FAILURE;
3321         }
3322     }
3323
3324 do_sort:
3325   /* Using the formal argument list, string the actual argument list
3326      together in a way that corresponds with the formal list.  */
3327   actual = NULL;
3328
3329   for (f = formal; f; f = f->next)
3330     {
3331       if (f->actual && f->actual->label != NULL && f->ts.type)
3332         {
3333           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3334           return FAILURE;
3335         }
3336
3337       if (f->actual == NULL)
3338         {
3339           a = gfc_get_actual_arglist ();
3340           a->missing_arg_type = f->ts.type;
3341         }
3342       else
3343         a = f->actual;
3344
3345       if (actual == NULL)
3346         *ap = a;
3347       else
3348         actual->next = a;
3349
3350       actual = a;
3351     }
3352   actual->next = NULL;          /* End the sorted argument list.  */
3353
3354   return SUCCESS;
3355 }
3356
3357
3358 /* Compare an actual argument list with an intrinsic's formal argument
3359    list.  The lists are checked for agreement of type.  We don't check
3360    for arrayness here.  */
3361
3362 static gfc_try
3363 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3364                int error_flag)
3365 {
3366   gfc_actual_arglist *actual;
3367   gfc_intrinsic_arg *formal;
3368   int i;
3369
3370   formal = sym->formal;
3371   actual = *ap;
3372
3373   i = 0;
3374   for (; formal; formal = formal->next, actual = actual->next, i++)
3375     {
3376       gfc_typespec ts;
3377
3378       if (actual->expr == NULL)
3379         continue;
3380
3381       ts = formal->ts;
3382
3383       /* A kind of 0 means we don't check for kind.  */
3384       if (ts.kind == 0)
3385         ts.kind = actual->expr->ts.kind;
3386
3387       if (!gfc_compare_types (&ts, &actual->expr->ts))
3388         {
3389           if (error_flag)
3390             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3391                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3392                        gfc_current_intrinsic, &actual->expr->where,
3393                        gfc_typename (&formal->ts),
3394                        gfc_typename (&actual->expr->ts));
3395           return FAILURE;
3396         }
3397     }
3398
3399   return SUCCESS;
3400 }
3401
3402
3403 /* Given a pointer to an intrinsic symbol and an expression node that
3404    represent the function call to that subroutine, figure out the type
3405    of the result.  This may involve calling a resolution subroutine.  */
3406
3407 static void
3408 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3409 {
3410   gfc_expr *a1, *a2, *a3, *a4, *a5;
3411   gfc_actual_arglist *arg;
3412
3413   if (specific->resolve.f1 == NULL)
3414     {
3415       if (e->value.function.name == NULL)
3416         e->value.function.name = specific->lib_name;
3417
3418       if (e->ts.type == BT_UNKNOWN)
3419         e->ts = specific->ts;
3420       return;
3421     }
3422
3423   arg = e->value.function.actual;
3424
3425   /* Special case hacks for MIN and MAX.  */
3426   if (specific->resolve.f1m == gfc_resolve_max
3427       || specific->resolve.f1m == gfc_resolve_min)
3428     {
3429       (*specific->resolve.f1m) (e, arg);
3430       return;
3431     }
3432
3433   if (arg == NULL)
3434     {
3435       (*specific->resolve.f0) (e);
3436       return;
3437     }
3438
3439   a1 = arg->expr;
3440   arg = arg->next;
3441
3442   if (arg == NULL)
3443     {
3444       (*specific->resolve.f1) (e, a1);
3445       return;
3446     }
3447
3448   a2 = arg->expr;
3449   arg = arg->next;
3450
3451   if (arg == NULL)
3452     {
3453       (*specific->resolve.f2) (e, a1, a2);
3454       return;
3455     }
3456
3457   a3 = arg->expr;
3458   arg = arg->next;
3459
3460   if (arg == NULL)
3461     {
3462       (*specific->resolve.f3) (e, a1, a2, a3);
3463       return;
3464     }
3465
3466   a4 = arg->expr;
3467   arg = arg->next;
3468
3469   if (arg == NULL)
3470     {
3471       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3472       return;
3473     }
3474
3475   a5 = arg->expr;
3476   arg = arg->next;
3477
3478   if (arg == NULL)
3479     {
3480       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3481       return;
3482     }
3483
3484   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3485 }
3486
3487
3488 /* Given an intrinsic symbol node and an expression node, call the
3489    simplification function (if there is one), perhaps replacing the
3490    expression with something simpler.  We return FAILURE on an error
3491    of the simplification, SUCCESS if the simplification worked, even
3492    if nothing has changed in the expression itself.  */
3493
3494 static gfc_try
3495 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3496 {
3497   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3498   gfc_actual_arglist *arg;
3499
3500   /* Max and min require special handling due to the variable number
3501      of args.  */
3502   if (specific->simplify.f1 == gfc_simplify_min)
3503     {
3504       result = gfc_simplify_min (e);
3505       goto finish;
3506     }
3507
3508   if (specific->simplify.f1 == gfc_simplify_max)
3509     {
3510       result = gfc_simplify_max (e);
3511       goto finish;
3512     }
3513
3514   if (specific->simplify.f1 == NULL)
3515     {
3516       result = NULL;
3517       goto finish;
3518     }
3519
3520   arg = e->value.function.actual;
3521
3522   if (arg == NULL)
3523     {
3524       result = (*specific->simplify.f0) ();
3525       goto finish;
3526     }
3527
3528   a1 = arg->expr;
3529   arg = arg->next;
3530
3531   if (specific->simplify.cc == gfc_convert_constant
3532       || specific->simplify.cc == gfc_convert_char_constant)
3533     {
3534       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3535       goto finish;
3536     }
3537
3538   if (arg == NULL)
3539     result = (*specific->simplify.f1) (a1);
3540   else
3541     {
3542       a2 = arg->expr;
3543       arg = arg->next;
3544
3545       if (arg == NULL)
3546         result = (*specific->simplify.f2) (a1, a2);
3547       else
3548         {
3549           a3 = arg->expr;
3550           arg = arg->next;
3551
3552           if (arg == NULL)
3553             result = (*specific->simplify.f3) (a1, a2, a3);
3554           else
3555             {
3556               a4 = arg->expr;
3557               arg = arg->next;
3558
3559               if (arg == NULL)
3560                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3561               else
3562                 {
3563                   a5 = arg->expr;
3564                   arg = arg->next;
3565
3566                   if (arg == NULL)
3567                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3568                   else
3569                     gfc_internal_error
3570                       ("do_simplify(): Too many args for intrinsic");
3571                 }
3572             }
3573         }
3574     }
3575
3576 finish:
3577   if (result == &gfc_bad_expr)
3578     return FAILURE;
3579
3580   if (result == NULL)
3581     resolve_intrinsic (specific, e);    /* Must call at run-time */
3582   else
3583     {
3584       result->where = e->where;
3585       gfc_replace_expr (e, result);
3586     }
3587
3588   return SUCCESS;
3589 }
3590
3591
3592 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3593    error messages.  This subroutine returns FAILURE if a subroutine
3594    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3595    list cannot match any intrinsic.  */
3596
3597 static void
3598 init_arglist (gfc_intrinsic_sym *isym)
3599 {
3600   gfc_intrinsic_arg *formal;
3601   int i;
3602
3603   gfc_current_intrinsic = isym->name;
3604
3605   i = 0;
3606   for (formal = isym->formal; formal; formal = formal->next)
3607     {
3608       if (i >= MAX_INTRINSIC_ARGS)
3609         gfc_internal_error ("init_arglist(): too many arguments");
3610       gfc_current_intrinsic_arg[i++] = formal->name;
3611     }
3612 }
3613
3614
3615 /* Given a pointer to an intrinsic symbol and an expression consisting
3616    of a function call, see if the function call is consistent with the
3617    intrinsic's formal argument list.  Return SUCCESS if the expression
3618    and intrinsic match, FAILURE otherwise.  */
3619
3620 static gfc_try
3621 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3622 {
3623   gfc_actual_arglist *arg, **ap;
3624   gfc_try t;
3625
3626   ap = &expr->value.function.actual;
3627
3628   init_arglist (specific);
3629
3630   /* Don't attempt to sort the argument list for min or max.  */
3631   if (specific->check.f1m == gfc_check_min_max
3632       || specific->check.f1m == gfc_check_min_max_integer
3633       || specific->check.f1m == gfc_check_min_max_real
3634       || specific->check.f1m == gfc_check_min_max_double)
3635     return (*specific->check.f1m) (*ap);
3636
3637   if (sort_actual (specific->name, ap, specific->formal,
3638                    &expr->where) == FAILURE)
3639     return FAILURE;
3640
3641   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3642     /* This is special because we might have to reorder the argument list.  */
3643     t = gfc_check_minloc_maxloc (*ap);
3644   else if (specific->check.f3red == gfc_check_minval_maxval)
3645     /* This is also special because we also might have to reorder the
3646        argument list.  */
3647     t = gfc_check_minval_maxval (*ap);
3648   else if (specific->check.f3red == gfc_check_product_sum)
3649     /* Same here. The difference to the previous case is that we allow a
3650        general numeric type.  */
3651     t = gfc_check_product_sum (*ap);
3652   else
3653      {
3654        if (specific->check.f1 == NULL)
3655          {
3656            t = check_arglist (ap, specific, error_flag);
3657            if (t == SUCCESS)
3658              expr->ts = specific->ts;
3659          }
3660        else
3661          t = do_check (specific, *ap);
3662      }
3663
3664   /* Check conformance of elemental intrinsics.  */
3665   if (t == SUCCESS && specific->elemental)
3666     {
3667       int n = 0;
3668       gfc_expr *first_expr;
3669       arg = expr->value.function.actual;
3670
3671       /* There is no elemental intrinsic without arguments.  */
3672       gcc_assert(arg != NULL);
3673       first_expr = arg->expr;
3674
3675       for ( ; arg && arg->expr; arg = arg->next, n++)
3676         if (gfc_check_conformance (first_expr, arg->expr,
3677                                    "arguments '%s' and '%s' for "
3678                                    "intrinsic '%s'",
3679                                    gfc_current_intrinsic_arg[0],
3680                                    gfc_current_intrinsic_arg[n],
3681                                    gfc_current_intrinsic) == FAILURE)
3682           return FAILURE;
3683     }
3684
3685   if (t == FAILURE)
3686     remove_nullargs (ap);
3687
3688   return t;
3689 }
3690
3691
3692 /* Check whether an intrinsic belongs to whatever standard the user
3693    has chosen, taking also into account -fall-intrinsics.  Here, no
3694    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3695    textual representation of the symbols standard status (like
3696    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3697    can be used to construct a detailed warning/error message in case of
3698    a FAILURE.  */
3699
3700 gfc_try
3701 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3702                               const char** symstd, bool silent, locus where)
3703 {
3704   const char* symstd_msg;
3705
3706   /* For -fall-intrinsics, just succeed.  */
3707   if (gfc_option.flag_all_intrinsics)
3708     return SUCCESS;
3709
3710   /* Find the symbol's standard message for later usage.  */
3711   switch (isym->standard)
3712     {
3713     case GFC_STD_F77:
3714       symstd_msg = "available since Fortran 77";
3715       break;
3716
3717     case GFC_STD_F95_OBS:
3718       symstd_msg = "obsolescent in Fortran 95";
3719       break;
3720
3721     case GFC_STD_F95_DEL:
3722       symstd_msg = "deleted in Fortran 95";
3723       break;
3724
3725     case GFC_STD_F95:
3726       symstd_msg = "new in Fortran 95";
3727       break;
3728
3729     case GFC_STD_F2003:
3730       symstd_msg = "new in Fortran 2003";
3731       break;
3732
3733     case GFC_STD_F2008:
3734       symstd_msg = "new in Fortran 2008";
3735       break;
3736
3737     case GFC_STD_GNU:
3738       symstd_msg = "a GNU Fortran extension";
3739       break;
3740
3741     case GFC_STD_LEGACY:
3742       symstd_msg = "for backward compatibility";
3743       break;
3744
3745     default:
3746       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3747                           isym->name, isym->standard);
3748     }
3749
3750   /* If warning about the standard, warn and succeed.  */
3751   if (gfc_option.warn_std & isym->standard)
3752     {
3753       /* Do only print a warning if not a GNU extension.  */
3754       if (!silent && isym->standard != GFC_STD_GNU)
3755         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3756                      isym->name, _(symstd_msg), &where);
3757
3758       return SUCCESS;
3759     }
3760
3761   /* If allowing the symbol's standard, succeed, too.  */
3762   if (gfc_option.allow_std & isym->standard)
3763     return SUCCESS;
3764
3765   /* Otherwise, fail.  */
3766   if (symstd)
3767     *symstd = _(symstd_msg);
3768   return FAILURE;
3769 }
3770
3771
3772 /* See if a function call corresponds to an intrinsic function call.
3773    We return:
3774
3775     MATCH_YES    if the call corresponds to an intrinsic, simplification
3776                  is done if possible.
3777
3778     MATCH_NO     if the call does not correspond to an intrinsic
3779
3780     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3781                  error during the simplification process.
3782
3783    The error_flag parameter enables an error reporting.  */
3784
3785 match
3786 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3787 {
3788   gfc_intrinsic_sym *isym, *specific;
3789   gfc_actual_arglist *actual;
3790   const char *name;
3791   int flag;
3792
3793   if (expr->value.function.isym != NULL)
3794     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3795            ? MATCH_ERROR : MATCH_YES;
3796
3797   if (!error_flag)
3798     gfc_push_suppress_errors ();
3799   flag = 0;
3800
3801   for (actual = expr->value.function.actual; actual; actual = actual->next)
3802     if (actual->expr != NULL)
3803       flag |= (actual->expr->ts.type != BT_INTEGER
3804                && actual->expr->ts.type != BT_CHARACTER);
3805
3806   name = expr->symtree->n.sym->name;
3807
3808   isym = specific = gfc_find_function (name);
3809   if (isym == NULL)
3810     {
3811       if (!error_flag)
3812         gfc_pop_suppress_errors ();
3813       return MATCH_NO;
3814     }
3815
3816   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3817        || isym->id == GFC_ISYM_CMPLX)
3818       && gfc_init_expr_flag
3819       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3820                          "as initialization expression at %L", name,
3821                          &expr->where) == FAILURE)
3822     {
3823       if (!error_flag)
3824         gfc_pop_suppress_errors ();
3825       return MATCH_ERROR;
3826     }
3827
3828   gfc_current_intrinsic_where = &expr->where;
3829
3830   /* Bypass the generic list for min and max.  */
3831   if (isym->check.f1m == gfc_check_min_max)
3832     {
3833       init_arglist (isym);
3834
3835       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3836         goto got_specific;
3837
3838       if (!error_flag)
3839         gfc_pop_suppress_errors ();
3840       return MATCH_NO;
3841     }
3842
3843   /* If the function is generic, check all of its specific
3844      incarnations.  If the generic name is also a specific, we check
3845      that name last, so that any error message will correspond to the
3846      specific.  */
3847   gfc_push_suppress_errors ();
3848
3849   if (isym->generic)
3850     {
3851       for (specific = isym->specific_head; specific;
3852            specific = specific->next)
3853         {
3854           if (specific == isym)
3855             continue;
3856           if (check_specific (specific, expr, 0) == SUCCESS)
3857             {
3858               gfc_pop_suppress_errors ();
3859               goto got_specific;
3860             }
3861         }
3862     }
3863
3864   gfc_pop_suppress_errors ();
3865
3866   if (check_specific (isym, expr, error_flag) == FAILURE)
3867     {
3868       if (!error_flag)
3869         gfc_pop_suppress_errors ();
3870       return MATCH_NO;
3871     }
3872
3873   specific = isym;
3874
3875 got_specific:
3876   expr->value.function.isym = specific;
3877   gfc_intrinsic_symbol (expr->symtree->n.sym);
3878
3879   if (!error_flag)
3880     gfc_pop_suppress_errors ();
3881
3882   if (do_simplify (specific, expr) == FAILURE)
3883     return MATCH_ERROR;
3884
3885   /* F95, 7.1.6.1, Initialization expressions
3886      (4) An elemental intrinsic function reference of type integer or
3887          character where each argument is an initialization expression
3888          of type integer or character
3889
3890      F2003, 7.1.7 Initialization expression
3891      (4)   A reference to an elemental standard intrinsic function,
3892            where each argument is an initialization expression  */
3893
3894   if (gfc_init_expr_flag && isym->elemental && flag
3895       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3896                         "as initialization expression with non-integer/non-"
3897                         "character arguments at %L", &expr->where) == FAILURE)
3898     return MATCH_ERROR;
3899
3900   return MATCH_YES;
3901 }
3902
3903
3904 /* See if a CALL statement corresponds to an intrinsic subroutine.
3905    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3906    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3907    correspond).  */
3908
3909 match
3910 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3911 {
3912   gfc_intrinsic_sym *isym;
3913   const char *name;
3914
3915   name = c->symtree->n.sym->name;
3916
3917   isym = gfc_find_subroutine (name);
3918   if (isym == NULL)
3919     return MATCH_NO;
3920
3921   if (!error_flag)
3922     gfc_push_suppress_errors ();
3923
3924   init_arglist (isym);
3925
3926   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3927     goto fail;
3928
3929   if (isym->check.f1 != NULL)
3930     {
3931       if (do_check (isym, c->ext.actual) == FAILURE)
3932         goto fail;
3933     }
3934   else
3935     {
3936       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3937         goto fail;
3938     }
3939
3940   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3941      seen at this point.  */
3942   if (!error_flag)
3943     gfc_pop_suppress_errors ();
3944
3945   c->resolved_isym = isym;
3946   if (isym->resolve.s1 != NULL)
3947     isym->resolve.s1 (c);
3948   else
3949     {
3950       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3951       c->resolved_sym->attr.elemental = isym->elemental;
3952     }
3953
3954   if (gfc_pure (NULL) && !isym->elemental)
3955     {
3956       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3957                  &c->loc);
3958       return MATCH_ERROR;
3959     }
3960
3961   c->resolved_sym->attr.noreturn = isym->noreturn;
3962
3963   return MATCH_YES;
3964
3965 fail:
3966   if (!error_flag)
3967     gfc_pop_suppress_errors ();
3968   return MATCH_NO;
3969 }
3970
3971
3972 /* Call gfc_convert_type() with warning enabled.  */
3973
3974 gfc_try
3975 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3976 {
3977   return gfc_convert_type_warn (expr, ts, eflag, 1);
3978 }
3979
3980
3981 /* Try to convert an expression (in place) from one type to another.
3982    'eflag' controls the behavior on error.
3983
3984    The possible values are:
3985
3986      1 Generate a gfc_error()
3987      2 Generate a gfc_internal_error().
3988
3989    'wflag' controls the warning related to conversion.  */
3990
3991 gfc_try
3992 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3993 {
3994   gfc_intrinsic_sym *sym;
3995   gfc_typespec from_ts;
3996   locus old_where;
3997   gfc_expr *new_expr;
3998   int rank;
3999   mpz_t *shape;
4000
4001   from_ts = expr->ts;           /* expr->ts gets clobbered */
4002
4003   if (ts->type == BT_UNKNOWN)
4004     goto bad;
4005
4006   /* NULL and zero size arrays get their type here.  */
4007   if (expr->expr_type == EXPR_NULL
4008       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
4009     {
4010       /* Sometimes the RHS acquire the type.  */
4011       expr->ts = *ts;
4012       return SUCCESS;
4013     }
4014
4015   if (expr->ts.type == BT_UNKNOWN)
4016     goto bad;
4017
4018   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4019       && gfc_compare_types (&expr->ts, ts))
4020     return SUCCESS;
4021
4022   sym = find_conv (&expr->ts, ts);
4023   if (sym == NULL)
4024     goto bad;
4025
4026   /* At this point, a conversion is necessary. A warning may be needed.  */
4027   if ((gfc_option.warn_std & sym->standard) != 0)
4028     {
4029       gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4030                        gfc_typename (&from_ts), gfc_typename (ts),
4031                        &expr->where);
4032     }
4033   else if (wflag)
4034     {
4035       if (gfc_option.flag_range_check
4036           && expr->expr_type == EXPR_CONSTANT
4037           && from_ts.type == ts->type)
4038         {
4039           /* Do nothing. Constants of the same type are range-checked
4040              elsewhere. If a value too large for the target type is
4041              assigned, an error is generated. Not checking here avoids
4042              duplications of warnings/errors.
4043              If range checking was disabled, but -Wconversion enabled,
4044              a non range checked warning is generated below.  */
4045         }
4046       else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4047         {
4048           /* Do nothing. This block exists only to simplify the other
4049              else-if expressions.
4050                LOGICAL <> LOGICAL    no warning, independent of kind values
4051                LOGICAL <> INTEGER    extension, warned elsewhere
4052                LOGICAL <> REAL       invalid, error generated elsewhere
4053                LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
4054         }
4055       else if (from_ts.type == ts->type
4056                || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4057                || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4058                || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4059         {
4060           /* Larger kinds can hold values of smaller kinds without problems.
4061              Hence, only warn if target kind is smaller than the source
4062              kind - or if -Wconversion-extra is specified.  */
4063           if (gfc_option.warn_conversion_extra)
4064             gfc_warning_now ("Conversion from %s to %s at %L",
4065                              gfc_typename (&from_ts), gfc_typename (ts),
4066                              &expr->where);
4067           else if (gfc_option.warn_conversion
4068                    && from_ts.kind > ts->kind)
4069             gfc_warning_now ("Possible change of value in conversion "
4070                              "from %s to %s at %L", gfc_typename (&from_ts),
4071                              gfc_typename (ts), &expr->where);
4072         }
4073       else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4074                || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4075                || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4076         {
4077           /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4078              usually comes with a loss of information, regardless of kinds.  */
4079           if (gfc_option.warn_conversion_extra
4080               || gfc_option.warn_conversion)
4081             gfc_warning_now ("Possible change of value in conversion "
4082                              "from %s to %s at %L", gfc_typename (&from_ts),
4083                              gfc_typename (ts), &expr->where);
4084         }
4085       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4086         {
4087           /* If HOLLERITH is involved, all bets are off.  */
4088           if (gfc_option.warn_conversion_extra
4089               || gfc_option.warn_conversion)
4090             gfc_warning_now ("Conversion from %s to %s at %L",
4091                              gfc_typename (&from_ts), gfc_typename (ts),
4092                              &expr->where);
4093         }
4094       else
4095         gcc_unreachable ();
4096     }
4097
4098   /* Insert a pre-resolved function call to the right function.  */
4099   old_where = expr->where;
4100   rank = expr->rank;
4101   shape = expr->shape;
4102
4103   new_expr = gfc_get_expr ();
4104   *new_expr = *expr;
4105
4106   new_expr = gfc_build_conversion (new_expr);
4107   new_expr->value.function.name = sym->lib_name;
4108   new_expr->value.function.isym = sym;
4109   new_expr->where = old_where;
4110   new_expr->rank = rank;
4111   new_expr->shape = gfc_copy_shape (shape, rank);
4112
4113   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4114   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4115   new_expr->symtree->n.sym->ts = *ts;
4116   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4117   new_expr->symtree->n.sym->attr.function = 1;
4118   new_expr->symtree->n.sym->attr.elemental = 1;
4119   new_expr->symtree->n.sym->attr.pure = 1;
4120   new_expr->symtree->n.sym->attr.referenced = 1;
4121   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4122   gfc_commit_symbol (new_expr->symtree->n.sym);
4123
4124   *expr = *new_expr;
4125
4126   gfc_free (new_expr);
4127   expr->ts = *ts;
4128
4129   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4130       && do_simplify (sym, expr) == FAILURE)
4131     {
4132
4133       if (eflag == 2)
4134         goto bad;
4135       return FAILURE;           /* Error already generated in do_simplify() */
4136     }
4137
4138   return SUCCESS;
4139
4140 bad:
4141   if (eflag == 1)
4142     {
4143       gfc_error ("Can't convert %s to %s at %L",
4144                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4145       return FAILURE;
4146     }
4147
4148   gfc_internal_error ("Can't convert %s to %s at %L",
4149                       gfc_typename (&from_ts), gfc_typename (ts),
4150                       &expr->where);
4151   /* Not reached */
4152 }
4153
4154
4155 gfc_try
4156 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4157 {
4158   gfc_intrinsic_sym *sym;
4159   locus old_where;
4160   gfc_expr *new_expr;
4161   int rank;
4162   mpz_t *shape;
4163
4164   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4165
4166   sym = find_char_conv (&expr->ts, ts);
4167   gcc_assert (sym);
4168
4169   /* Insert a pre-resolved function call to the right function.  */
4170   old_where = expr->where;
4171   rank = expr->rank;
4172   shape = expr->shape;
4173
4174   new_expr = gfc_get_expr ();
4175   *new_expr = *expr;
4176
4177   new_expr = gfc_build_conversion (new_expr);
4178   new_expr->value.function.name = sym->lib_name;
4179   new_expr->value.function.isym = sym;
4180   new_expr->where = old_where;
4181   new_expr->rank = rank;
4182   new_expr->shape = gfc_copy_shape (shape, rank);
4183
4184   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4185   new_expr->symtree->n.sym->ts = *ts;
4186   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4187   new_expr->symtree->n.sym->attr.function = 1;
4188   new_expr->symtree->n.sym->attr.elemental = 1;
4189   new_expr->symtree->n.sym->attr.referenced = 1;
4190   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4191   gfc_commit_symbol (new_expr->symtree->n.sym);
4192
4193   *expr = *new_expr;
4194
4195   gfc_free (new_expr);
4196   expr->ts = *ts;
4197
4198   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4199       && do_simplify (sym, expr) == FAILURE)
4200     {
4201       /* Error already generated in do_simplify() */
4202       return FAILURE;
4203     }
4204
4205   return SUCCESS;
4206 }
4207
4208
4209 /* Check if the passed name is name of an intrinsic (taking into account the
4210    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4211    warn about this as a user-procedure having the same name as an intrinsic
4212    (-Wintrinsic-shadow enabled) and do so if we should.  */
4213
4214 void
4215 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4216 {
4217   gfc_intrinsic_sym* isym;
4218
4219   /* If the warning is disabled, do nothing at all.  */
4220   if (!gfc_option.warn_intrinsic_shadow)
4221     return;
4222
4223   /* Try to find an intrinsic of the same name.  */
4224   if (func)
4225     isym = gfc_find_function (sym->name);
4226   else
4227     isym = gfc_find_subroutine (sym->name);
4228
4229   /* If no intrinsic was found with this name or it's not included in the
4230      selected standard, everything's fine.  */
4231   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4232                                              sym->declared_at) == FAILURE)
4233     return;
4234
4235   /* Emit the warning.  */
4236   if (in_module)
4237     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4238                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4239                  " declarations may be required.",
4240                  sym->name, &sym->declared_at);
4241   else
4242     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4243                  " only be called via an explicit interface or if declared"
4244                  " EXTERNAL.", sym->name, &sym->declared_at);
4245 }