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 int gfc_init_expr = 0;
  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         {
 961           if (gfc_option.warn_intrinsics_std)
 962             gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
 963                              " selected standard but %s and '%s' will be"
 964                              " treated as if declared EXTERNAL.  Use an"
 965                              " appropriate -std=* option or define"
 966                              " -fall-intrinsics to allow this intrinsic.",
 967                              sym->name, &loc, symstd, sym->name);
 968           gfc_add_external (&sym->attr, &loc);
 969         }
 970
 971       return false;
 972     }
 973
 974   return true;
 975 }
 976
 977
 978 /* Collect a set of intrinsic functions into a generic collection.
 979    The first argument is the name of the generic function, which is
 980    also the name of a specific function.  The rest of the specifics
 981    currently in the table are placed into the list of specific
 982    functions associated with that generic.
 983
 984    PR fortran/32778
 985    FIXME: Remove the argument STANDARD if no regressions are
 986           encountered. Change all callers (approx. 360).
 987 */
 988
 989 static void
 990 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 991 {
 992   gfc_intrinsic_sym *g;
 993
 994   if (sizing != SZ_NOTHING)
 995     return;
 996
 997   g = gfc_find_function (name);
 998   if (g == NULL)
 999     gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
1000                         name);
1001
1002   gcc_assert (g->id == id);
1003
1004   g->generic = 1;
1005   g->specific = 1;
1006   if ((g + 1)->name != NULL)
1007     g->specific_head = g + 1;
1008   g++;
1009
1010   while (g->name != NULL)
1011     {
1012       g->next = g + 1;
1013       g->specific = 1;
1014       g++;
1015     }
1016
1017   g--;
1018   g->next = NULL;
1019 }
1020
1021
1022 /* Create a duplicate intrinsic function entry for the current
1023    function, the only differences being the alternate name and
1024    a different standard if necessary. Note that we use argument
1025    lists more than once, but all argument lists are freed as a
1026    single block.  */
1027
1028 static void
1029 make_alias (const char *name, int standard)
1030 {
1031   switch (sizing)
1032     {
1033     case SZ_FUNCS:
1034       nfunc++;
1035       break;
1036
1037     case SZ_SUBS:
1038       nsub++;
1039       break;
1040
1041     case SZ_NOTHING:
1042       next_sym[0] = next_sym[-1];
1043       next_sym->name = gfc_get_string (name);
1044       next_sym->standard = standard;
1045       next_sym++;
1046       break;
1047
1048     default:
1049       break;
1050     }
1051 }
1052
1053
1054 /* Make the current subroutine noreturn.  */
1055
1056 static void
1057 make_noreturn (void)
1058 {
1059   if (sizing == SZ_NOTHING)
1060     next_sym[-1].noreturn = 1;
1061 }
1062
1063
1064 /* Add intrinsic functions.  */
1065
1066 static void
1067 add_functions (void)
1068 {
1069   /* Argument names as in the standard (to be used as argument keywords).  */
1070   const char
1071     *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1072     *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1073     *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1074     *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1075     *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1076     *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1077     *p = "p", *ar = "array", *shp = "shape", *src = "source",
1078     *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1079     *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1080     *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1081     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1082     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1083     *num = "number", *tm = "time", *nm = "name", *md = "mode",
1084     *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command";
1085
1086   int di, dr, dd, dl, dc, dz, ii;
1087
1088   di = gfc_default_integer_kind;
1089   dr = gfc_default_real_kind;
1090   dd = gfc_default_double_kind;
1091   dl = gfc_default_logical_kind;
1092   dc = gfc_default_character_kind;
1093   dz = gfc_default_complex_kind;
1094   ii = gfc_index_integer_kind;
1095
1096   add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1097              gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1098              a, BT_REAL, dr, REQUIRED);
1099
1100   add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1101              NULL, gfc_simplify_abs, gfc_resolve_abs,
1102              a, BT_INTEGER, di, REQUIRED);
1103
1104   add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1105              gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1106              a, BT_REAL, dd, REQUIRED);
1107
1108   add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1109              NULL, gfc_simplify_abs, gfc_resolve_abs,
1110              a, BT_COMPLEX, dz, REQUIRED);
1111
1112   add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1113              NULL, gfc_simplify_abs, gfc_resolve_abs,
1114              a, BT_COMPLEX, dd, REQUIRED);
1115
1116   make_alias ("cdabs", GFC_STD_GNU);
1117
1118   make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1119
1120   /* The checking function for ACCESS is called gfc_check_access_func
1121      because the name gfc_check_access is already used in module.c.  */
1122   add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1123              gfc_check_access_func, NULL, gfc_resolve_access,
1124              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1125
1126   make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1127
1128   add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1129              BT_CHARACTER, dc, GFC_STD_F95,
1130              gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1131              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1132
1133   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1134
1135   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1136              gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1137              x, BT_REAL, dr, REQUIRED);
1138
1139   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1140              gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1141              x, BT_REAL, dd, REQUIRED);
1142
1143   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1144
1145   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1146              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1147              gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1148
1149   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1150              gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1151              x, BT_REAL, dd, REQUIRED);
1152
1153   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1154
1155   add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1156              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1157              gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1158
1159   make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1160
1161   add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1162              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1163              gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1164
1165   make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1166
1167   add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1168              gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1169              z, BT_COMPLEX, dz, REQUIRED);
1170
1171   make_alias ("imag", GFC_STD_GNU);
1172   make_alias ("imagpart", GFC_STD_GNU);
1173
1174   add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1175              NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1176              z, BT_COMPLEX, dd, REQUIRED);
1177
1178   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1179
1180   add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1181              gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1182              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1183
1184   add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1185              NULL, gfc_simplify_dint, gfc_resolve_dint,
1186              a, BT_REAL, dd, REQUIRED);
1187
1188   make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1189
1190   add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1191              gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1192              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1193
1194   make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1195
1196   add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1197              gfc_check_allocated, NULL, NULL,
1198              ar, BT_UNKNOWN, 0, REQUIRED);
1199
1200   make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1201
1202   add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1203              gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1204              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1205
1206   add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1207              NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1208              a, BT_REAL, dd, REQUIRED);
1209
1210   make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1211
1212   add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1213              gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1214              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1215
1216   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1217
1218   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1219              gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1220              x, BT_REAL, dr, REQUIRED);
1221
1222   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1223              gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1224              x, BT_REAL, dd, REQUIRED);
1225
1226   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1227
1228   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1229              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1230              gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1231
1232   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1233              gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1234              x, BT_REAL, dd, REQUIRED);
1235
1236   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1237
1238   add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1239              GFC_STD_F95, gfc_check_associated, NULL, NULL,
1240              pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1241
1242   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1243
1244   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1245              gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1246              x, BT_REAL, dr, REQUIRED);
1247
1248   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1249              gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1250              x, BT_REAL, dd, REQUIRED);
1251
1252   /* Two-argument version of atan, equivalent to atan2.  */
1253   add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1254              gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1255              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1256
1257   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1258
1259   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1260              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1261              gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1262
1263   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1264              gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1265              x, BT_REAL, dd, REQUIRED);
1266
1267   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1268
1269   add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1270              gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1271              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1272
1273   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1274              gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1275              y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1276
1277   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1278
1279   /* Bessel and Neumann functions for G77 compatibility.  */
1280   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1281              gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1282              x, BT_REAL, dr, REQUIRED);
1283
1284   make_alias ("bessel_j0", GFC_STD_F2008);
1285
1286   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1287              gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1288              x, BT_REAL, dd, REQUIRED);
1289
1290   make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1291
1292   add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1293              gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1294              x, BT_REAL, dr, REQUIRED);
1295
1296   make_alias ("bessel_j1", GFC_STD_F2008);
1297
1298   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1299              gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1300              x, BT_REAL, dd, REQUIRED);
1301
1302   make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1303
1304   add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1305              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1306              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1307
1308   make_alias ("bessel_jn", GFC_STD_F2008);
1309
1310   add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1311              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1312              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1313
1314   make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1315
1316   add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1317              gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1318              x, BT_REAL, dr, REQUIRED);
1319
1320   make_alias ("bessel_y0", GFC_STD_F2008);
1321
1322   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1323              gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1324              x, BT_REAL, dd, REQUIRED);
1325
1326   make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1327
1328   add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1329              gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1330              x, BT_REAL, dr, REQUIRED);
1331
1332   make_alias ("bessel_y1", GFC_STD_F2008);
1333
1334   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1335              gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1336              x, BT_REAL, dd, REQUIRED);
1337
1338   make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1339
1340   add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1341              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1342              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1343
1344   make_alias ("bessel_yn", GFC_STD_F2008);
1345
1346   add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1347              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1348              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1349
1350   make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1351
1352   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1353              gfc_check_i, gfc_simplify_bit_size, NULL,
1354              i, BT_INTEGER, di, REQUIRED);
1355
1356   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1357
1358   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1359              gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1360              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1361
1362   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1363
1364   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1365              gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1366              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1367
1368   make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1369
1370   add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1371              gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1372              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1373
1374   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1375
1376   add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1377              GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1378              nm, BT_CHARACTER, dc, REQUIRED);
1379
1380   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1381
1382   add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1383              gfc_check_chmod, NULL, gfc_resolve_chmod,
1384              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1385
1386   make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1387
1388   add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1389              gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1390              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1391              kind, BT_INTEGER, di, OPTIONAL);
1392
1393   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1394
1395   add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1396              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1397
1398   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1399                 GFC_STD_F2003);
1400
1401   add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1402              gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1403              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1404
1405   make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1406
1407   /* Making dcmplx a specific of cmplx causes cmplx to return a double
1408      complex instead of the default complex.  */
1409
1410   add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1411              gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1412              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1413
1414   make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1415
1416   add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1417              gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1418              z, BT_COMPLEX, dz, REQUIRED);
1419
1420   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1421              NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1422              z, BT_COMPLEX, dd, REQUIRED);
1423
1424   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1425
1426   add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1427              gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1428              x, BT_REAL, dr, REQUIRED);
1429
1430   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1431              gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1432              x, BT_REAL, dd, REQUIRED);
1433
1434   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1435              NULL, gfc_simplify_cos, gfc_resolve_cos,
1436              x, BT_COMPLEX, dz, REQUIRED);
1437
1438   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1439              NULL, gfc_simplify_cos, gfc_resolve_cos,
1440              x, BT_COMPLEX, dd, REQUIRED);
1441
1442   make_alias ("cdcos", GFC_STD_GNU);
1443
1444   make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1445
1446   add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1447              gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1448              x, BT_REAL, dr, REQUIRED);
1449
1450   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1451              gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1452              x, BT_REAL, dd, REQUIRED);
1453
1454   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1455
1456   add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1457              BT_INTEGER, di, GFC_STD_F95,
1458              gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1459              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1460              kind, BT_INTEGER, di, OPTIONAL);
1461
1462   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1463
1464   add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1465              gfc_check_cshift, NULL, gfc_resolve_cshift,
1466              ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1467              dm, BT_INTEGER, ii, OPTIONAL);
1468
1469   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1470
1471   add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1472               gfc_check_ctime, NULL, gfc_resolve_ctime,
1473               tm, BT_INTEGER, di, REQUIRED);
1474
1475   make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1476
1477   add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1478              gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1479              a, BT_REAL, dr, REQUIRED);
1480
1481   make_alias ("dfloat", GFC_STD_GNU);
1482
1483   make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1484
1485   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1486              gfc_check_digits, gfc_simplify_digits, NULL,
1487              x, BT_UNKNOWN, dr, REQUIRED);
1488
1489   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1490
1491   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1492              gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1493              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1494
1495   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1496              NULL, gfc_simplify_dim, gfc_resolve_dim,
1497              x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1498
1499   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1500              gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1501              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1502
1503   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1504
1505   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1506              GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1507              va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1508
1509   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1510
1511   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1512              gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1513              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1514
1515   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1516
1517   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1518              NULL, NULL, NULL,
1519              a, BT_COMPLEX, dd, REQUIRED);
1520
1521   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1522
1523   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1524              gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1525              ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1526              bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1527
1528   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1529
1530   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1531              gfc_check_x, gfc_simplify_epsilon, NULL,
1532              x, BT_REAL, dr, REQUIRED);
1533
1534   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1535
1536   /* G77 compatibility for the ERF() and ERFC() functions.  */
1537   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1538              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1539              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1540
1541   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1542              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1543              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1544
1545   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1546
1547   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1548              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1549              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1550
1551   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1552              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1553              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1554
1555   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1556
1557   add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1558              BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1559              gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1560              dr, REQUIRED);
1561
1562   make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1563
1564   /* G77 compatibility */
1565   add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1566              gfc_check_dtime_etime, NULL, NULL,
1567              x, BT_REAL, 4, REQUIRED);
1568
1569   make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1570
1571   add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1572              gfc_check_dtime_etime, NULL, NULL,
1573              x, BT_REAL, 4, REQUIRED);
1574
1575   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1576
1577   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
1578              gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1579              x, BT_REAL, dr, REQUIRED);
1580
1581   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1582              gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1583              x, BT_REAL, dd, REQUIRED);
1584
1585   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1586              NULL, gfc_simplify_exp, gfc_resolve_exp,
1587              x, BT_COMPLEX, dz, REQUIRED);
1588
1589   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1590              NULL, gfc_simplify_exp, gfc_resolve_exp,
1591              x, BT_COMPLEX, dd, REQUIRED);
1592
1593   make_alias ("cdexp", GFC_STD_GNU);
1594
1595   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1596
1597   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1598              gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1599              x, BT_REAL, dr, REQUIRED);
1600
1601   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1602
1603   add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1604              ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1605              gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1606              a, BT_UNKNOWN, 0, REQUIRED,
1607              mo, BT_UNKNOWN, 0, REQUIRED);
1608
1609   add_sym_0 ("fdate",  GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1610              NULL, NULL, gfc_resolve_fdate);
1611
1612   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1613
1614   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1615              gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1616              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1617
1618   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1619
1620   /* G77 compatible fnum */
1621   add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1622              gfc_check_fnum, NULL, gfc_resolve_fnum,
1623              ut, BT_INTEGER, di, REQUIRED);
1624
1625   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1626
1627   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1628              gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1629              x, BT_REAL, dr, REQUIRED);
1630
1631   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1632
1633   add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1634              GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1635              ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1636
1637   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1638
1639   add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1640              gfc_check_ftell, NULL, gfc_resolve_ftell,
1641              ut, BT_INTEGER, di, REQUIRED);
1642
1643   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1644
1645   add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1646              gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1647              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1648
1649   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1650
1651   add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1652              gfc_check_fgetput, NULL, gfc_resolve_fget,
1653              c, BT_CHARACTER, dc, REQUIRED);
1654
1655   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1656
1657   add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1658              gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1659              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1660
1661   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1662
1663   add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1664              gfc_check_fgetput, NULL, gfc_resolve_fput,
1665              c, BT_CHARACTER, dc, REQUIRED);
1666
1667   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1668
1669   add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1670              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1671              gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1672
1673   add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1674              gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1675              x, BT_REAL, dr, REQUIRED);
1676
1677   make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1678
1679   /* Unix IDs (g77 compatibility)  */
1680   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,  GFC_STD_GNU,
1681              NULL, NULL, gfc_resolve_getcwd,
1682              c, BT_CHARACTER, dc, REQUIRED);
1683
1684   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1685
1686   add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1687              NULL, NULL, gfc_resolve_getgid);
1688
1689   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1690
1691   add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1692              NULL, NULL, gfc_resolve_getpid);
1693
1694   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1695
1696   add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1697              NULL, NULL, gfc_resolve_getuid);
1698
1699   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1700
1701   add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1702              gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1703              a, BT_CHARACTER, dc, REQUIRED);
1704
1705   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1706
1707   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1708              gfc_check_huge, gfc_simplify_huge, NULL,
1709              x, BT_UNKNOWN, dr, REQUIRED);
1710
1711   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1712
1713   add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1714              BT_REAL, dr, GFC_STD_F2008,
1715              gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1716              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1717
1718   make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1719
1720   add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1721              BT_INTEGER, di, GFC_STD_F95,
1722              gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1723              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1724
1725   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1726
1727   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1728              gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1729              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1730
1731   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1732
1733   add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1734              gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1735              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1736
1737   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1738
1739   add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1740              NULL, NULL, NULL);
1741
1742   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1743
1744   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1745              gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1746              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1747
1748   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1749
1750   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1751              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1752              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1753              ln, BT_INTEGER, di, REQUIRED);
1754
1755   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1756
1757   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1758              gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1759              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1760
1761   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1762
1763   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1764              BT_INTEGER, di, GFC_STD_F77,
1765              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1766              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1767
1768   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1769
1770   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1771              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1772              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1773
1774   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1775
1776   add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1777              gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1778              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1779
1780   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1781
1782   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1783              NULL, NULL, gfc_resolve_ierrno);
1784
1785   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
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_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1923              BT_INTEGER, di, GFC_STD_F2008,
1924              gfc_check_i, gfc_simplify_leadz, NULL,
1925              i, BT_INTEGER, di, REQUIRED);
1926
1927   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1928
1929   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1930              BT_INTEGER, di, GFC_STD_F77,
1931              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1932              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1933
1934   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1935
1936   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1937              BT_INTEGER, di, GFC_STD_F95,
1938              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1939              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1940
1941   make_alias ("lnblnk", GFC_STD_GNU);
1942
1943   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1944
1945   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1946              dr, GFC_STD_GNU,
1947              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1948              x, BT_REAL, dr, REQUIRED);
1949
1950   make_alias ("log_gamma", GFC_STD_F2008);
1951
1952   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1953              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1954              x, BT_REAL, dr, REQUIRED);
1955
1956   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1957              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1958              x, BT_REAL, dr, REQUIRED);
1959
1960   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1961
1962
1963   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1964              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1965              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1966
1967   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1968
1969   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1970              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1971              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1972
1973   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1974
1975   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1976              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1977              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1978
1979   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1980
1981   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1982              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1983              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1984
1985   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1986
1987   add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1988              GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1989              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
1990
1991   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1992
1993   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1994              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1995              x, BT_REAL, dr, REQUIRED);
1996
1997   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1998              NULL, gfc_simplify_log, gfc_resolve_log,
1999              x, BT_REAL, dr, REQUIRED);
2000
2001   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2002              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2003              x, BT_REAL, dd, REQUIRED);
2004
2005   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2006              NULL, gfc_simplify_log, gfc_resolve_log,
2007              x, BT_COMPLEX, dz, REQUIRED);
2008
2009   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
2010              NULL, gfc_simplify_log, gfc_resolve_log,
2011              x, BT_COMPLEX, dd, REQUIRED);
2012
2013   make_alias ("cdlog", GFC_STD_GNU);
2014
2015   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2016
2017   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2018              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2019              x, BT_REAL, dr, REQUIRED);
2020
2021   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2022              NULL, gfc_simplify_log10, gfc_resolve_log10,
2023              x, BT_REAL, dr, REQUIRED);
2024
2025   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2026              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2027              x, BT_REAL, dd, REQUIRED);
2028
2029   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2030
2031   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2032              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2033              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2034
2035   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2036
2037   add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2038              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2039              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2040
2041   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2042
2043   add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2044              GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2045              sz, BT_INTEGER, di, REQUIRED);
2046
2047   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2048
2049   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2050              gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2051              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2052
2053   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2054
2055   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2056      int(max).  The max function must take at least two arguments.  */
2057
2058   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2059              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2060              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2061
2062   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2063              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2064              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2065
2066   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2067              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2068              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2069
2070   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2071              gfc_check_min_max_real, gfc_simplify_max, NULL,
2072              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2073
2074   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2075              gfc_check_min_max_real, gfc_simplify_max, NULL,
2076              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2077
2078   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2079              gfc_check_min_max_double, gfc_simplify_max, NULL,
2080              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2081
2082   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2083
2084   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2085              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2086              x, BT_UNKNOWN, dr, REQUIRED);
2087
2088   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2089
2090   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2091                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2092                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2093                msk, BT_LOGICAL, dl, OPTIONAL);
2094
2095   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2096
2097   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2098                 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2099                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2100                 msk, BT_LOGICAL, dl, OPTIONAL);
2101
2102   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2103
2104   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2105              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2106
2107   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2108
2109   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2110              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2111
2112   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2113
2114   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2115              gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2116              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2117              msk, BT_LOGICAL, dl, REQUIRED);
2118
2119   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2120
2121   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2122      int(min).  */
2123
2124   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2125               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2126               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2127
2128   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2129               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2130               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2131
2132   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2133               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2134               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2135
2136   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2137               gfc_check_min_max_real, gfc_simplify_min, NULL,
2138               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2139
2140   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2141               gfc_check_min_max_real, gfc_simplify_min, NULL,
2142               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2143
2144   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2145               gfc_check_min_max_double, gfc_simplify_min, NULL,
2146               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2147
2148   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2149
2150   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2151              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2152              x, BT_UNKNOWN, dr, REQUIRED);
2153
2154   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2155
2156   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2157                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2158                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2159                msk, BT_LOGICAL, dl, OPTIONAL);
2160
2161   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2162
2163   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2164                 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2165                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2166                 msk, BT_LOGICAL, dl, OPTIONAL);
2167
2168   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2169
2170   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2171              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2172              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2173
2174   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2175              NULL, gfc_simplify_mod, gfc_resolve_mod,
2176              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2177
2178   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2179              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2180              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2181
2182   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2183
2184   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2185              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2186              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2187
2188   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2189
2190   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2191              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2192              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2193
2194   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2195
2196   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2197              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2198              a, BT_CHARACTER, dc, REQUIRED);
2199
2200   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2201
2202   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2203              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2204              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2205
2206   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2207              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2208              a, BT_REAL, dd, REQUIRED);
2209
2210   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2211
2212   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2213              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2214              i, BT_INTEGER, di, REQUIRED);
2215
2216   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2217
2218   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2219              gfc_check_null, gfc_simplify_null, NULL,
2220              mo, BT_INTEGER, di, OPTIONAL);
2221
2222   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2223
2224   add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2225              NULL, gfc_simplify_num_images, NULL);
2226
2227   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2228              gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2229              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2230              v, BT_REAL, dr, OPTIONAL);
2231
2232   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2233
2234   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2235              gfc_check_precision, gfc_simplify_precision, NULL,
2236              x, BT_UNKNOWN, 0, REQUIRED);
2237
2238   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2239
2240   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2241                     BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2242                     a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2243
2244   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2245
2246   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2247                 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2248                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2249                 msk, BT_LOGICAL, dl, OPTIONAL);
2250
2251   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2252
2253   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2254              gfc_check_radix, gfc_simplify_radix, NULL,
2255              x, BT_UNKNOWN, 0, REQUIRED);
2256
2257   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2258
2259   /* The following function is for G77 compatibility.  */
2260   add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2261              gfc_check_rand, NULL, NULL,
2262              i, BT_INTEGER, 4, OPTIONAL);
2263
2264   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2265      use slightly different shoddy multiplicative congruential PRNG.  */
2266   make_alias ("ran", GFC_STD_GNU);
2267
2268   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2269
2270   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2271              gfc_check_range, gfc_simplify_range, NULL,
2272              x, BT_REAL, dr, REQUIRED);
2273
2274   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2275
2276   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2277              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2278              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2279
2280   /* This provides compatibility with g77.  */
2281   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2282              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2283              a, BT_UNKNOWN, dr, REQUIRED);
2284
2285   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2286              gfc_check_i, gfc_simplify_float, NULL,
2287              a, BT_INTEGER, di, REQUIRED);
2288
2289   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2290              NULL, gfc_simplify_sngl, NULL,
2291              a, BT_REAL, dd, REQUIRED);
2292
2293   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2294
2295   add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2296              GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2297              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2298
2299   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2300
2301   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2302              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2303              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2304
2305   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2306
2307   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2308              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2309              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2310              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2311
2312   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2313
2314   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2315              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2316              x, BT_REAL, dr, REQUIRED);
2317
2318   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2319
2320   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2321              BT_LOGICAL, dl, GFC_STD_F2003,
2322              gfc_check_same_type_as, NULL, NULL,
2323              a, BT_UNKNOWN, 0, REQUIRED,
2324              b, BT_UNKNOWN, 0, REQUIRED);
2325
2326   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2327              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2328              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2329
2330   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2331
2332   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2333              BT_INTEGER, di, GFC_STD_F95,
2334              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2335              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2336              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2337
2338   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2339
2340   /* Added for G77 compatibility garbage.  */
2341   add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2342              NULL, NULL, NULL);
2343
2344   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2345
2346   /* Added for G77 compatibility.  */
2347   add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2348              gfc_check_secnds, NULL, gfc_resolve_secnds,
2349              x, BT_REAL, dr, REQUIRED);
2350
2351   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2352
2353   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2354              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2355              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2356              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2357
2358   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2359
2360   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2361              GFC_STD_F95, gfc_check_selected_int_kind,
2362              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2363
2364   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2365
2366   add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2367              GFC_STD_F95, gfc_check_selected_real_kind,
2368              gfc_simplify_selected_real_kind, NULL,
2369              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2370
2371   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2372
2373   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2374              gfc_check_set_exponent, gfc_simplify_set_exponent,
2375              gfc_resolve_set_exponent,
2376              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2377
2378   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2379
2380   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2381              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2382              src, BT_REAL, dr, REQUIRED);
2383
2384   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2385
2386   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2387              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2388              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2389
2390   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2391              NULL, gfc_simplify_sign, gfc_resolve_sign,
2392              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2393
2394   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2395              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2396              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2397
2398   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2399
2400   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2401              gfc_check_signal, NULL, gfc_resolve_signal,
2402              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2403
2404   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2405
2406   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2407              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2408              x, BT_REAL, dr, REQUIRED);
2409
2410   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2411              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2412              x, BT_REAL, dd, REQUIRED);
2413
2414   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2415              NULL, gfc_simplify_sin, gfc_resolve_sin,
2416              x, BT_COMPLEX, dz, REQUIRED);
2417
2418   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2419              NULL, gfc_simplify_sin, gfc_resolve_sin,
2420              x, BT_COMPLEX, dd, REQUIRED);
2421
2422   make_alias ("cdsin", GFC_STD_GNU);
2423
2424   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2425
2426   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2427              gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2428              x, BT_REAL, dr, REQUIRED);
2429
2430   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2431              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2432              x, BT_REAL, dd, REQUIRED);
2433
2434   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2435
2436   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2437              BT_INTEGER, di, GFC_STD_F95,
2438              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2439              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2440              kind, BT_INTEGER, di, OPTIONAL);
2441
2442   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2443
2444   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2445              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2446              x, BT_UNKNOWN, 0, REQUIRED);
2447
2448   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2449   make_alias ("c_sizeof", GFC_STD_F2008);
2450
2451   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2452              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2453              x, BT_REAL, dr, REQUIRED);
2454
2455   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2456
2457   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2458              gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2459              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2460              ncopies, BT_INTEGER, di, REQUIRED);
2461
2462   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2463
2464   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2465              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2466              x, BT_REAL, dr, REQUIRED);
2467
2468   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2469              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2470              x, BT_REAL, dd, REQUIRED);
2471
2472   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2473              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2474              x, BT_COMPLEX, dz, REQUIRED);
2475
2476   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2477              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2478              x, BT_COMPLEX, dd, REQUIRED);
2479
2480   make_alias ("cdsqrt", GFC_STD_GNU);
2481
2482   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2483
2484   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2485              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2486              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2487
2488   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2489
2490   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2491                 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2492                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2493                 msk, BT_LOGICAL, dl, OPTIONAL);
2494
2495   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2496
2497   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2498              GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2499              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2500
2501   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2502
2503   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2504              GFC_STD_GNU, NULL, NULL, NULL,
2505              com, BT_CHARACTER, dc, REQUIRED);
2506
2507   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2508
2509   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2510              gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2511              x, BT_REAL, dr, REQUIRED);
2512
2513   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2514              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2515              x, BT_REAL, dd, REQUIRED);
2516
2517   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2518
2519   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2520              gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2521              x, BT_REAL, dr, REQUIRED);
2522
2523   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2524              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2525              x, BT_REAL, dd, REQUIRED);
2526
2527   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2528
2529   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2530              NULL, NULL, gfc_resolve_time);
2531
2532   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2533
2534   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2535              NULL, NULL, gfc_resolve_time8);
2536
2537   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2538
2539   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2540              gfc_check_x, gfc_simplify_tiny, NULL,
2541              x, BT_REAL, dr, REQUIRED);
2542
2543   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2544
2545   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2546              BT_INTEGER, di, GFC_STD_F2008,
2547              gfc_check_i, gfc_simplify_trailz, NULL,
2548              i, BT_INTEGER, di, REQUIRED);
2549
2550   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2551
2552   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2553              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2554              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2555              sz, BT_INTEGER, di, OPTIONAL);
2556
2557   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2558
2559   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2560              gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2561              m, BT_REAL, dr, REQUIRED);
2562
2563   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2564
2565   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2566              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2567              stg, BT_CHARACTER, dc, REQUIRED);
2568
2569   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2570
2571   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2572              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2573              ut, BT_INTEGER, di, REQUIRED);
2574
2575   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2576
2577   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2578              BT_INTEGER, di, GFC_STD_F95,
2579              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2580              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2581              kind, BT_INTEGER, di, OPTIONAL);
2582
2583   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2584
2585   /* g77 compatibility for UMASK.  */
2586   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2587              GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2588              msk, BT_INTEGER, di, REQUIRED);
2589
2590   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2591
2592   /* g77 compatibility for UNLINK.  */
2593   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2594              gfc_check_unlink, NULL, gfc_resolve_unlink,
2595              "path", BT_CHARACTER, dc, REQUIRED);
2596
2597   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2598
2599   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2600              gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2601              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2602              f, BT_REAL, dr, REQUIRED);
2603
2604   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2605
2606   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2607              BT_INTEGER, di, GFC_STD_F95,
2608              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2609              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2610              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2611
2612   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2613
2614   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2615              GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2616              x, BT_UNKNOWN, 0, REQUIRED);
2617
2618   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2619 }
2620
2621
2622 /* Add intrinsic subroutines.  */
2623
2624 static void
2625 add_subroutines (void)
2626 {
2627   /* Argument names as in the standard (to be used as argument keywords).  */
2628   const char
2629     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2630     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2631     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2632     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2633     *com = "command", *length = "length", *st = "status",
2634     *val = "value", *num = "number", *name = "name",
2635     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2636     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2637     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2638     *p2 = "path2", *msk = "mask", *old = "old";
2639
2640   int di, dr, dc, dl, ii;
2641
2642   di = gfc_default_integer_kind;
2643   dr = gfc_default_real_kind;
2644   dc = gfc_default_character_kind;
2645   dl = gfc_default_logical_kind;
2646   ii = gfc_index_integer_kind;
2647
2648   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2649
2650   make_noreturn();
2651
2652   add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2653                      GFC_STD_F95, gfc_check_cpu_time, NULL,
2654                      gfc_resolve_cpu_time,
2655                      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2656
2657   /* More G77 compatibility garbage.  */
2658   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2659               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2660               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2661
2662   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2663               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2664               vl, BT_INTEGER, 4, REQUIRED);
2665
2666   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2667               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2668               vl, BT_INTEGER, 4, REQUIRED);
2669
2670   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2671               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2672               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2673
2674   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2675               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2676               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2677
2678   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2679               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2680               tm, BT_REAL, dr, REQUIRED);
2681
2682   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2684               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2685
2686   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2687               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2688               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2689               st, BT_INTEGER, di, OPTIONAL);
2690
2691   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2692               GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2693               dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2694               tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2695               zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2696               vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2697
2698   /* More G77 compatibility garbage.  */
2699   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2700               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2701               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2702
2703   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2704               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2705               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2706
2707   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2708               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2709               dt, BT_CHARACTER, dc, REQUIRED);
2710
2711   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2712               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2713               dc, REQUIRED);
2714
2715   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2716               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2717               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2718
2719   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2720               NULL, NULL, NULL,
2721               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2722               REQUIRED);
2723
2724   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2725               gfc_check_getarg, NULL, gfc_resolve_getarg,
2726               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2727
2728   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2729               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2730               dc, REQUIRED);
2731
2732   /* F2003 commandline routines.  */
2733
2734   add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2735                      0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2736                      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2737                      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2738                      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2739
2740   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2741               BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2742               gfc_resolve_get_command_argument,
2743               num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2744               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2745               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2746               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2747
2748   /* F2003 subroutine to get environment variables.  */
2749
2750   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2751               NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2752               NULL, NULL, gfc_resolve_get_environment_variable,
2753               name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2754               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2755               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2756               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2757               trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2758
2759   add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2760                      GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2761                      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2762                      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2763
2764   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2765               GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2766               gfc_resolve_mvbits,
2767               f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2768               fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2769               ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2770               t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2771               tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2772
2773   add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2774                      BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2775                      gfc_resolve_random_number,
2776                      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2777
2778   add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2779                      BT_UNKNOWN, 0, GFC_STD_F95,
2780                      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2781                      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2782                      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2783                      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2784
2785   /* More G77 compatibility garbage.  */
2786   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2787               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2788               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2789               st, BT_INTEGER, di, OPTIONAL);
2790
2791   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2792               gfc_check_srand, NULL, gfc_resolve_srand,
2793               "seed", BT_INTEGER, 4, REQUIRED);
2794
2795   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2796               gfc_check_exit, NULL, gfc_resolve_exit,
2797               st, BT_INTEGER, di, OPTIONAL);
2798
2799   make_noreturn();
2800
2801   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2802               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2803               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2804               st, BT_INTEGER, di, OPTIONAL);
2805
2806   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2807               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2808               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2809
2810   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2811               gfc_check_flush, NULL, gfc_resolve_flush,
2812               ut, BT_INTEGER, di, OPTIONAL);
2813
2814   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2815               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2816               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2817               st, BT_INTEGER, di, OPTIONAL);
2818
2819   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2820               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2821               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2822
2823   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2824               gfc_check_free, NULL, gfc_resolve_free,
2825               ptr, BT_INTEGER, ii, REQUIRED);
2826
2827   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2828               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2829               ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2830               of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2831               whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2832               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2833
2834   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2835               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2836               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2837
2838   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2839               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2840               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2841
2842   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2843               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2844               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2845
2846   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2847               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2848               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2849               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2850
2851   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2852               gfc_check_perror, NULL, gfc_resolve_perror,
2853               "string", BT_CHARACTER, dc, REQUIRED);
2854
2855   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2856               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2857               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2858               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2859
2860   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2861               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2862               sec, BT_INTEGER, di, REQUIRED);
2863
2864   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2865               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2866               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2867               st, BT_INTEGER, di, OPTIONAL);
2868
2869   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2870               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2871               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2872               st, BT_INTEGER, di, OPTIONAL);
2873
2874   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2875               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2876               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2877               st, BT_INTEGER, di, OPTIONAL);
2878
2879   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2880               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2881               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2882               st, BT_INTEGER, di, OPTIONAL);
2883
2884   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2885               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2886               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2887               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2888
2889   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2890               NULL, NULL, gfc_resolve_system_sub,
2891               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2892
2893   add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2894                      BT_UNKNOWN, 0, GFC_STD_F95,
2895                      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2896                      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2897                      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2898                      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2899
2900   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2901               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2902               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2903
2904   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2905               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2906               msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2907
2908   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2909               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2910               "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2911 }
2912
2913
2914 /* Add a function to the list of conversion symbols.  */
2915
2916 static void
2917 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2918 {
2919   gfc_typespec from, to;
2920   gfc_intrinsic_sym *sym;
2921
2922   if (sizing == SZ_CONVS)
2923     {
2924       nconv++;
2925       return;
2926     }
2927
2928   gfc_clear_ts (&from);
2929   from.type = from_type;
2930   from.kind = from_kind;
2931
2932   gfc_clear_ts (&to);
2933   to.type = to_type;
2934   to.kind = to_kind;
2935
2936   sym = conversion + nconv;
2937
2938   sym->name = conv_name (&from, &to);
2939   sym->lib_name = sym->name;
2940   sym->simplify.cc = gfc_convert_constant;
2941   sym->standard = standard;
2942   sym->elemental = 1;
2943   sym->conversion = 1;
2944   sym->ts = to;
2945   sym->id = GFC_ISYM_CONVERSION;
2946
2947   nconv++;
2948 }
2949
2950
2951 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2952    functions by looping over the kind tables.  */
2953
2954 static void
2955 add_conversions (void)
2956 {
2957   int i, j;
2958
2959   /* Integer-Integer conversions.  */
2960   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2961     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2962       {
2963         if (i == j)
2964           continue;
2965
2966         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2967                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2968       }
2969
2970   /* Integer-Real/Complex conversions.  */
2971   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2972     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2973       {
2974         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2975                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2976
2977         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2978                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2979
2980         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2981                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2982
2983         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2984                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2985       }
2986
2987   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2988     {
2989       /* Hollerith-Integer conversions.  */
2990       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2991         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2992                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2993       /* Hollerith-Real conversions.  */
2994       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2995         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2996                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2997       /* Hollerith-Complex conversions.  */
2998       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2999         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3000                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3001
3002       /* Hollerith-Character conversions.  */
3003       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3004                   gfc_default_character_kind, GFC_STD_LEGACY);
3005
3006       /* Hollerith-Logical conversions.  */
3007       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3008         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3009                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3010     }
3011
3012   /* Real/Complex - Real/Complex conversions.  */
3013   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3014     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3015       {
3016         if (i != j)
3017           {
3018             add_conv (BT_REAL, gfc_real_kinds[i].kind,
3019                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3020
3021             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3022                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3023           }
3024
3025         add_conv (BT_REAL, gfc_real_kinds[i].kind,
3026                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3027
3028         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3029                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3030       }
3031
3032   /* Logical/Logical kind conversion.  */
3033   for (i = 0; gfc_logical_kinds[i].kind; i++)
3034     for (j = 0; gfc_logical_kinds[j].kind; j++)
3035       {
3036         if (i == j)
3037           continue;
3038
3039         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3040                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3041       }
3042
3043   /* Integer-Logical and Logical-Integer conversions.  */
3044   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3045     for (i=0; gfc_integer_kinds[i].kind; i++)
3046       for (j=0; gfc_logical_kinds[j].kind; j++)
3047         {
3048           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3049                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3050           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3051                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3052         }
3053 }
3054
3055
3056 static void
3057 add_char_conversions (void)
3058 {
3059   int n, i, j;
3060
3061   /* Count possible conversions.  */
3062   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3063     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3064       if (i != j)
3065         ncharconv++;
3066
3067   /* Allocate memory.  */
3068   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3069
3070   /* Add the conversions themselves.  */
3071   n = 0;
3072   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3073     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3074       {
3075         gfc_typespec from, to;
3076
3077         if (i == j)
3078           continue;
3079
3080         gfc_clear_ts (&from);
3081         from.type = BT_CHARACTER;
3082         from.kind = gfc_character_kinds[i].kind;
3083
3084         gfc_clear_ts (&to);
3085         to.type = BT_CHARACTER;
3086         to.kind = gfc_character_kinds[j].kind;
3087
3088         char_conversions[n].name = conv_name (&from, &to);
3089         char_conversions[n].lib_name = char_conversions[n].name;
3090         char_conversions[n].simplify.cc = gfc_convert_char_constant;
3091         char_conversions[n].standard = GFC_STD_F2003;
3092         char_conversions[n].elemental = 1;
3093         char_conversions[n].conversion = 0;
3094         char_conversions[n].ts = to;
3095         char_conversions[n].id = GFC_ISYM_CONVERSION;
3096
3097         n++;
3098       }
3099 }
3100
3101
3102 /* Initialize the table of intrinsics.  */
3103 void
3104 gfc_intrinsic_init_1 (void)
3105 {
3106   int i;
3107
3108   nargs = nfunc = nsub = nconv = 0;
3109
3110   /* Create a namespace to hold the resolved intrinsic symbols.  */
3111   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3112
3113   sizing = SZ_FUNCS;
3114   add_functions ();
3115   sizing = SZ_SUBS;
3116   add_subroutines ();
3117   sizing = SZ_CONVS;
3118   add_conversions ();
3119
3120   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3121                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3122                         + sizeof (gfc_intrinsic_arg) * nargs);
3123
3124   next_sym = functions;
3125   subroutines = functions + nfunc;
3126
3127   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3128
3129   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3130
3131   sizing = SZ_NOTHING;
3132   nconv = 0;
3133
3134   add_functions ();
3135   add_subroutines ();
3136   add_conversions ();
3137
3138   /* Character conversion intrinsics need to be treated separately.  */
3139   add_char_conversions ();
3140
3141   /* Set the pure flag.  All intrinsic functions are pure, and
3142      intrinsic subroutines are pure if they are elemental.  */
3143
3144   for (i = 0; i < nfunc; i++)
3145     functions[i].pure = 1;
3146
3147   for (i = 0; i < nsub; i++)
3148     subroutines[i].pure = subroutines[i].elemental;
3149 }
3150
3151
3152 void
3153 gfc_intrinsic_done_1 (void)
3154 {
3155   gfc_free (functions);
3156   gfc_free (conversion);
3157   gfc_free (char_conversions);
3158   gfc_free_namespace (gfc_intrinsic_namespace);
3159 }
3160
3161
3162 /******** Subroutines to check intrinsic interfaces ***********/
3163
3164 /* Given a formal argument list, remove any NULL arguments that may
3165    have been left behind by a sort against some formal argument list.  */
3166
3167 static void
3168 remove_nullargs (gfc_actual_arglist **ap)
3169 {
3170   gfc_actual_arglist *head, *tail, *next;
3171
3172   tail = NULL;
3173
3174   for (head = *ap; head; head = next)
3175     {
3176       next = head->next;
3177
3178       if (head->expr == NULL && !head->label)
3179         {
3180           head->next = NULL;
3181           gfc_free_actual_arglist (head);
3182         }
3183       else
3184         {
3185           if (tail == NULL)
3186             *ap = head;
3187           else
3188             tail->next = head;
3189
3190           tail = head;
3191           tail->next = NULL;
3192         }
3193     }
3194
3195   if (tail == NULL)
3196     *ap = NULL;
3197 }
3198
3199
3200 /* Given an actual arglist and a formal arglist, sort the actual
3201    arglist so that its arguments are in a one-to-one correspondence
3202    with the format arglist.  Arguments that are not present are given
3203    a blank gfc_actual_arglist structure.  If something is obviously
3204    wrong (say, a missing required argument) we abort sorting and
3205    return FAILURE.  */
3206
3207 static gfc_try
3208 sort_actual (const char *name, gfc_actual_arglist **ap,
3209              gfc_intrinsic_arg *formal, locus *where)
3210 {
3211   gfc_actual_arglist *actual, *a;
3212   gfc_intrinsic_arg *f;
3213
3214   remove_nullargs (ap);
3215   actual = *ap;
3216
3217   for (f = formal; f; f = f->next)
3218     f->actual = NULL;
3219
3220   f = formal;
3221   a = actual;
3222
3223   if (f == NULL && a == NULL)   /* No arguments */
3224     return SUCCESS;
3225
3226   for (;;)
3227     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3228       if (f == NULL)
3229         break;
3230       if (a == NULL)
3231         goto optional;
3232
3233       if (a->name != NULL)
3234         goto keywords;
3235
3236       f->actual = a;
3237
3238       f = f->next;
3239       a = a->next;
3240     }
3241
3242   if (a == NULL)
3243     goto do_sort;
3244
3245   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3246   return FAILURE;
3247
3248 keywords:
3249   /* Associate the remaining actual arguments, all of which have
3250      to be keyword arguments.  */
3251   for (; a; a = a->next)
3252     {
3253       for (f = formal; f; f = f->next)
3254         if (strcmp (a->name, f->name) == 0)
3255           break;
3256
3257       if (f == NULL)
3258         {
3259           if (a->name[0] == '%')
3260             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3261                        "are not allowed in this context at %L", where);
3262           else
3263             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3264                        a->name, name, where);
3265           return FAILURE;
3266         }
3267
3268       if (f->actual != NULL)
3269         {
3270           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3271                      f->name, name, where);
3272           return FAILURE;
3273         }
3274
3275       f->actual = a;
3276     }
3277
3278 optional:
3279   /* At this point, all unmatched formal args must be optional.  */
3280   for (f = formal; f; f = f->next)
3281     {
3282       if (f->actual == NULL && f->optional == 0)
3283         {
3284           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3285                      f->name, name, where);
3286           return FAILURE;
3287         }
3288     }
3289
3290 do_sort:
3291   /* Using the formal argument list, string the actual argument list
3292      together in a way that corresponds with the formal list.  */
3293   actual = NULL;
3294
3295   for (f = formal; f; f = f->next)
3296     {
3297       if (f->actual && f->actual->label != NULL && f->ts.type)
3298         {
3299           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3300           return FAILURE;
3301         }
3302
3303       if (f->actual == NULL)
3304         {
3305           a = gfc_get_actual_arglist ();
3306           a->missing_arg_type = f->ts.type;
3307         }
3308       else
3309         a = f->actual;
3310
3311       if (actual == NULL)
3312         *ap = a;
3313       else
3314         actual->next = a;
3315
3316       actual = a;
3317     }
3318   actual->next = NULL;          /* End the sorted argument list.  */
3319
3320   return SUCCESS;
3321 }
3322
3323
3324 /* Compare an actual argument list with an intrinsic's formal argument
3325    list.  The lists are checked for agreement of type.  We don't check
3326    for arrayness here.  */
3327
3328 static gfc_try
3329 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3330                int error_flag)
3331 {
3332   gfc_actual_arglist *actual;
3333   gfc_intrinsic_arg *formal;
3334   int i;
3335
3336   formal = sym->formal;
3337   actual = *ap;
3338
3339   i = 0;
3340   for (; formal; formal = formal->next, actual = actual->next, i++)
3341     {
3342       gfc_typespec ts;
3343
3344       if (actual->expr == NULL)
3345         continue;
3346
3347       ts = formal->ts;
3348
3349       /* A kind of 0 means we don't check for kind.  */
3350       if (ts.kind == 0)
3351         ts.kind = actual->expr->ts.kind;
3352
3353       if (!gfc_compare_types (&ts, &actual->expr->ts))
3354         {
3355           if (error_flag)
3356             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3357                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3358                        gfc_current_intrinsic, &actual->expr->where,
3359                        gfc_typename (&formal->ts),
3360                        gfc_typename (&actual->expr->ts));
3361           return FAILURE;
3362         }
3363     }
3364
3365   return SUCCESS;
3366 }
3367
3368
3369 /* Given a pointer to an intrinsic symbol and an expression node that
3370    represent the function call to that subroutine, figure out the type
3371    of the result.  This may involve calling a resolution subroutine.  */
3372
3373 static void
3374 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3375 {
3376   gfc_expr *a1, *a2, *a3, *a4, *a5;
3377   gfc_actual_arglist *arg;
3378
3379   if (specific->resolve.f1 == NULL)
3380     {
3381       if (e->value.function.name == NULL)
3382         e->value.function.name = specific->lib_name;
3383
3384       if (e->ts.type == BT_UNKNOWN)
3385         e->ts = specific->ts;
3386       return;
3387     }
3388
3389   arg = e->value.function.actual;
3390
3391   /* Special case hacks for MIN and MAX.  */
3392   if (specific->resolve.f1m == gfc_resolve_max
3393       || specific->resolve.f1m == gfc_resolve_min)
3394     {
3395       (*specific->resolve.f1m) (e, arg);
3396       return;
3397     }
3398
3399   if (arg == NULL)
3400     {
3401       (*specific->resolve.f0) (e);
3402       return;
3403     }
3404
3405   a1 = arg->expr;
3406   arg = arg->next;
3407
3408   if (arg == NULL)
3409     {
3410       (*specific->resolve.f1) (e, a1);
3411       return;
3412     }
3413
3414   a2 = arg->expr;
3415   arg = arg->next;
3416
3417   if (arg == NULL)
3418     {
3419       (*specific->resolve.f2) (e, a1, a2);
3420       return;
3421     }
3422
3423   a3 = arg->expr;
3424   arg = arg->next;
3425
3426   if (arg == NULL)
3427     {
3428       (*specific->resolve.f3) (e, a1, a2, a3);
3429       return;
3430     }
3431
3432   a4 = arg->expr;
3433   arg = arg->next;
3434
3435   if (arg == NULL)
3436     {
3437       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3438       return;
3439     }
3440
3441   a5 = arg->expr;
3442   arg = arg->next;
3443
3444   if (arg == NULL)
3445     {
3446       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3447       return;
3448     }
3449
3450   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3451 }
3452
3453
3454 /* Given an intrinsic symbol node and an expression node, call the
3455    simplification function (if there is one), perhaps replacing the
3456    expression with something simpler.  We return FAILURE on an error
3457    of the simplification, SUCCESS if the simplification worked, even
3458    if nothing has changed in the expression itself.  */
3459
3460 static gfc_try
3461 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3462 {
3463   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3464   gfc_actual_arglist *arg;
3465
3466   /* Max and min require special handling due to the variable number
3467      of args.  */
3468   if (specific->simplify.f1 == gfc_simplify_min)
3469     {
3470       result = gfc_simplify_min (e);
3471       goto finish;
3472     }
3473
3474   if (specific->simplify.f1 == gfc_simplify_max)
3475     {
3476       result = gfc_simplify_max (e);
3477       goto finish;
3478     }
3479
3480   if (specific->simplify.f1 == NULL)
3481     {
3482       result = NULL;
3483       goto finish;
3484     }
3485
3486   arg = e->value.function.actual;
3487
3488   if (arg == NULL)
3489     {
3490       result = (*specific->simplify.f0) ();
3491       goto finish;
3492     }
3493
3494   a1 = arg->expr;
3495   arg = arg->next;
3496
3497   if (specific->simplify.cc == gfc_convert_constant
3498       || specific->simplify.cc == gfc_convert_char_constant)
3499     {
3500       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3501       goto finish;
3502     }
3503
3504   if (arg == NULL)
3505     result = (*specific->simplify.f1) (a1);
3506   else
3507     {
3508       a2 = arg->expr;
3509       arg = arg->next;
3510
3511       if (arg == NULL)
3512         result = (*specific->simplify.f2) (a1, a2);
3513       else
3514         {
3515           a3 = arg->expr;
3516           arg = arg->next;
3517
3518           if (arg == NULL)
3519             result = (*specific->simplify.f3) (a1, a2, a3);
3520           else
3521             {
3522               a4 = arg->expr;
3523               arg = arg->next;
3524
3525               if (arg == NULL)
3526                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3527               else
3528                 {
3529                   a5 = arg->expr;
3530                   arg = arg->next;
3531
3532                   if (arg == NULL)
3533                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3534                   else
3535                     gfc_internal_error
3536                       ("do_simplify(): Too many args for intrinsic");
3537                 }
3538             }
3539         }
3540     }
3541
3542 finish:
3543   if (result == &gfc_bad_expr)
3544     return FAILURE;
3545
3546   if (result == NULL)
3547     resolve_intrinsic (specific, e);    /* Must call at run-time */
3548   else
3549     {
3550       result->where = e->where;
3551       gfc_replace_expr (e, result);
3552     }
3553
3554   return SUCCESS;
3555 }
3556
3557
3558 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3559    error messages.  This subroutine returns FAILURE if a subroutine
3560    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3561    list cannot match any intrinsic.  */
3562
3563 static void
3564 init_arglist (gfc_intrinsic_sym *isym)
3565 {
3566   gfc_intrinsic_arg *formal;
3567   int i;
3568
3569   gfc_current_intrinsic = isym->name;
3570
3571   i = 0;
3572   for (formal = isym->formal; formal; formal = formal->next)
3573     {
3574       if (i >= MAX_INTRINSIC_ARGS)
3575         gfc_internal_error ("init_arglist(): too many arguments");
3576       gfc_current_intrinsic_arg[i++] = formal->name;
3577     }
3578 }
3579
3580
3581 /* Given a pointer to an intrinsic symbol and an expression consisting
3582    of a function call, see if the function call is consistent with the
3583    intrinsic's formal argument list.  Return SUCCESS if the expression
3584    and intrinsic match, FAILURE otherwise.  */
3585
3586 static gfc_try
3587 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3588 {
3589   gfc_actual_arglist *arg, **ap;
3590   gfc_try t;
3591
3592   ap = &expr->value.function.actual;
3593
3594   init_arglist (specific);
3595
3596   /* Don't attempt to sort the argument list for min or max.  */
3597   if (specific->check.f1m == gfc_check_min_max
3598       || specific->check.f1m == gfc_check_min_max_integer
3599       || specific->check.f1m == gfc_check_min_max_real
3600       || specific->check.f1m == gfc_check_min_max_double)
3601     return (*specific->check.f1m) (*ap);
3602
3603   if (sort_actual (specific->name, ap, specific->formal,
3604                    &expr->where) == FAILURE)
3605     return FAILURE;
3606
3607   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3608     /* This is special because we might have to reorder the argument list.  */
3609     t = gfc_check_minloc_maxloc (*ap);
3610   else if (specific->check.f3red == gfc_check_minval_maxval)
3611     /* This is also special because we also might have to reorder the
3612        argument list.  */
3613     t = gfc_check_minval_maxval (*ap);
3614   else if (specific->check.f3red == gfc_check_product_sum)
3615     /* Same here. The difference to the previous case is that we allow a
3616        general numeric type.  */
3617     t = gfc_check_product_sum (*ap);
3618   else
3619      {
3620        if (specific->check.f1 == NULL)
3621          {
3622            t = check_arglist (ap, specific, error_flag);
3623            if (t == SUCCESS)
3624              expr->ts = specific->ts;
3625          }
3626        else
3627          t = do_check (specific, *ap);
3628      }
3629
3630   /* Check conformance of elemental intrinsics.  */
3631   if (t == SUCCESS && specific->elemental)
3632     {
3633       int n = 0;
3634       gfc_expr *first_expr;
3635       arg = expr->value.function.actual;
3636
3637       /* There is no elemental intrinsic without arguments.  */
3638       gcc_assert(arg != NULL);
3639       first_expr = arg->expr;
3640
3641       for ( ; arg && arg->expr; arg = arg->next, n++)
3642         if (gfc_check_conformance (first_expr, arg->expr,
3643                                    "arguments '%s' and '%s' for "
3644                                    "intrinsic '%s'",
3645                                    gfc_current_intrinsic_arg[0],
3646                                    gfc_current_intrinsic_arg[n],
3647                                    gfc_current_intrinsic) == FAILURE)
3648           return FAILURE;
3649     }
3650
3651   if (t == FAILURE)
3652     remove_nullargs (ap);
3653
3654   return t;
3655 }
3656
3657
3658 /* Check whether an intrinsic belongs to whatever standard the user
3659    has chosen, taking also into account -fall-intrinsics.  Here, no
3660    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3661    textual representation of the symbols standard status (like
3662    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3663    can be used to construct a detailed warning/error message in case of
3664    a FAILURE.  */
3665
3666 gfc_try
3667 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3668                               const char** symstd, bool silent, locus where)
3669 {
3670   const char* symstd_msg;
3671
3672   /* For -fall-intrinsics, just succeed.  */
3673   if (gfc_option.flag_all_intrinsics)
3674     return SUCCESS;
3675
3676   /* Find the symbol's standard message for later usage.  */
3677   switch (isym->standard)
3678     {
3679     case GFC_STD_F77:
3680       symstd_msg = "available since Fortran 77";
3681       break;
3682
3683     case GFC_STD_F95_OBS:
3684       symstd_msg = "obsolescent in Fortran 95";
3685       break;
3686
3687     case GFC_STD_F95_DEL:
3688       symstd_msg = "deleted in Fortran 95";
3689       break;
3690
3691     case GFC_STD_F95:
3692       symstd_msg = "new in Fortran 95";
3693       break;
3694
3695     case GFC_STD_F2003:
3696       symstd_msg = "new in Fortran 2003";
3697       break;
3698
3699     case GFC_STD_F2008:
3700       symstd_msg = "new in Fortran 2008";
3701       break;
3702
3703     case GFC_STD_GNU:
3704       symstd_msg = "a GNU Fortran extension";
3705       break;
3706
3707     case GFC_STD_LEGACY:
3708       symstd_msg = "for backward compatibility";
3709       break;
3710
3711     default:
3712       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3713                           isym->name, isym->standard);
3714     }
3715
3716   /* If warning about the standard, warn and succeed.  */
3717   if (gfc_option.warn_std & isym->standard)
3718     {
3719       /* Do only print a warning if not a GNU extension.  */
3720       if (!silent && isym->standard != GFC_STD_GNU)
3721         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3722                      isym->name, _(symstd_msg), &where);
3723
3724       return SUCCESS;
3725     }
3726
3727   /* If allowing the symbol's standard, succeed, too.  */
3728   if (gfc_option.allow_std & isym->standard)
3729     return SUCCESS;
3730
3731   /* Otherwise, fail.  */
3732   if (symstd)
3733     *symstd = _(symstd_msg);
3734   return FAILURE;
3735 }
3736
3737
3738 /* See if a function call corresponds to an intrinsic function call.
3739    We return:
3740
3741     MATCH_YES    if the call corresponds to an intrinsic, simplification
3742                  is done if possible.
3743
3744     MATCH_NO     if the call does not correspond to an intrinsic
3745
3746     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3747                  error during the simplification process.
3748
3749    The error_flag parameter enables an error reporting.  */
3750
3751 match
3752 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3753 {
3754   gfc_intrinsic_sym *isym, *specific;
3755   gfc_actual_arglist *actual;
3756   const char *name;
3757   int flag;
3758
3759   if (expr->value.function.isym != NULL)
3760     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3761            ? MATCH_ERROR : MATCH_YES;
3762
3763   if (!error_flag)
3764     gfc_push_suppress_errors ();
3765   flag = 0;
3766
3767   for (actual = expr->value.function.actual; actual; actual = actual->next)
3768     if (actual->expr != NULL)
3769       flag |= (actual->expr->ts.type != BT_INTEGER
3770                && actual->expr->ts.type != BT_CHARACTER);
3771
3772   name = expr->symtree->n.sym->name;
3773
3774   isym = specific = gfc_find_function (name);
3775   if (isym == NULL)
3776     {
3777       if (!error_flag)
3778         gfc_pop_suppress_errors ();
3779       return MATCH_NO;
3780     }
3781
3782   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3783        || isym->id == GFC_ISYM_CMPLX)
3784       && gfc_init_expr
3785       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3786                          "as initialization expression at %L", name,
3787                          &expr->where) == FAILURE)
3788     {
3789       if (!error_flag)
3790         gfc_pop_suppress_errors ();
3791       return MATCH_ERROR;
3792     }
3793
3794   gfc_current_intrinsic_where = &expr->where;
3795
3796   /* Bypass the generic list for min and max.  */
3797   if (isym->check.f1m == gfc_check_min_max)
3798     {
3799       init_arglist (isym);
3800
3801       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3802         goto got_specific;
3803
3804       if (!error_flag)
3805         gfc_pop_suppress_errors ();
3806       return MATCH_NO;
3807     }
3808
3809   /* If the function is generic, check all of its specific
3810      incarnations.  If the generic name is also a specific, we check
3811      that name last, so that any error message will correspond to the
3812      specific.  */
3813   gfc_push_suppress_errors ();
3814
3815   if (isym->generic)
3816     {
3817       for (specific = isym->specific_head; specific;
3818            specific = specific->next)
3819         {
3820           if (specific == isym)
3821             continue;
3822           if (check_specific (specific, expr, 0) == SUCCESS)
3823             {
3824               gfc_pop_suppress_errors ();
3825               goto got_specific;
3826             }
3827         }
3828     }
3829
3830   gfc_pop_suppress_errors ();
3831
3832   if (check_specific (isym, expr, error_flag) == FAILURE)
3833     {
3834       if (!error_flag)
3835         gfc_pop_suppress_errors ();
3836       return MATCH_NO;
3837     }
3838
3839   specific = isym;
3840
3841 got_specific:
3842   expr->value.function.isym = specific;
3843   gfc_intrinsic_symbol (expr->symtree->n.sym);
3844
3845   if (!error_flag)
3846     gfc_pop_suppress_errors ();
3847
3848   if (do_simplify (specific, expr) == FAILURE)
3849     return MATCH_ERROR;
3850
3851   /* F95, 7.1.6.1, Initialization expressions
3852      (4) An elemental intrinsic function reference of type integer or
3853          character where each argument is an initialization expression
3854          of type integer or character
3855
3856      F2003, 7.1.7 Initialization expression
3857      (4)   A reference to an elemental standard intrinsic function,
3858            where each argument is an initialization expression  */
3859
3860   if (gfc_init_expr && isym->elemental && flag
3861       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3862                         "as initialization expression with non-integer/non-"
3863                         "character arguments at %L", &expr->where) == FAILURE)
3864     return MATCH_ERROR;
3865
3866   return MATCH_YES;
3867 }
3868
3869
3870 /* See if a CALL statement corresponds to an intrinsic subroutine.
3871    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3872    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3873    correspond).  */
3874
3875 match
3876 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3877 {
3878   gfc_intrinsic_sym *isym;
3879   const char *name;
3880
3881   name = c->symtree->n.sym->name;
3882
3883   isym = gfc_find_subroutine (name);
3884   if (isym == NULL)
3885     return MATCH_NO;
3886
3887   if (!error_flag)
3888     gfc_push_suppress_errors ();
3889
3890   init_arglist (isym);
3891
3892   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3893     goto fail;
3894
3895   if (isym->check.f1 != NULL)
3896     {
3897       if (do_check (isym, c->ext.actual) == FAILURE)
3898         goto fail;
3899     }
3900   else
3901     {
3902       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3903         goto fail;
3904     }
3905
3906   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3907      seen at this point.  */
3908   if (!error_flag)
3909     gfc_pop_suppress_errors ();
3910
3911   c->resolved_isym = isym;
3912   if (isym->resolve.s1 != NULL)
3913     isym->resolve.s1 (c);
3914   else
3915     {
3916       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3917       c->resolved_sym->attr.elemental = isym->elemental;
3918     }
3919
3920   if (gfc_pure (NULL) && !isym->elemental)
3921     {
3922       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3923                  &c->loc);
3924       return MATCH_ERROR;
3925     }
3926
3927   c->resolved_sym->attr.noreturn = isym->noreturn;
3928
3929   return MATCH_YES;
3930
3931 fail:
3932   if (!error_flag)
3933     gfc_pop_suppress_errors ();
3934   return MATCH_NO;
3935 }
3936
3937
3938 /* Call gfc_convert_type() with warning enabled.  */
3939
3940 gfc_try
3941 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3942 {
3943   return gfc_convert_type_warn (expr, ts, eflag, 1);
3944 }
3945
3946
3947 /* Try to convert an expression (in place) from one type to another.
3948    'eflag' controls the behavior on error.
3949
3950    The possible values are:
3951
3952      1 Generate a gfc_error()
3953      2 Generate a gfc_internal_error().
3954
3955    'wflag' controls the warning related to conversion.  */
3956
3957 gfc_try
3958 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3959 {
3960   gfc_intrinsic_sym *sym;
3961   gfc_typespec from_ts;
3962   locus old_where;
3963   gfc_expr *new_expr;
3964   int rank;
3965   mpz_t *shape;
3966
3967   from_ts = expr->ts;           /* expr->ts gets clobbered */
3968
3969   if (ts->type == BT_UNKNOWN)
3970     goto bad;
3971
3972   /* NULL and zero size arrays get their type here.  */
3973   if (expr->expr_type == EXPR_NULL
3974       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3975     {
3976       /* Sometimes the RHS acquire the type.  */
3977       expr->ts = *ts;
3978       return SUCCESS;
3979     }
3980
3981   if (expr->ts.type == BT_UNKNOWN)
3982     goto bad;
3983
3984   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3985       && gfc_compare_types (&expr->ts, ts))
3986     return SUCCESS;
3987
3988   sym = find_conv (&expr->ts, ts);
3989   if (sym == NULL)
3990     goto bad;
3991
3992   /* At this point, a conversion is necessary. A warning may be needed.  */
3993   if ((gfc_option.warn_std & sym->standard) != 0)
3994     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3995                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3996   else if (wflag && gfc_option.warn_conversion)
3997     gfc_warning_now ("Conversion from %s to %s at %L",
3998                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3999
4000   /* Insert a pre-resolved function call to the right function.  */
4001   old_where = expr->where;
4002   rank = expr->rank;
4003   shape = expr->shape;
4004
4005   new_expr = gfc_get_expr ();
4006   *new_expr = *expr;
4007
4008   new_expr = gfc_build_conversion (new_expr);
4009   new_expr->value.function.name = sym->lib_name;
4010   new_expr->value.function.isym = sym;
4011   new_expr->where = old_where;
4012   new_expr->rank = rank;
4013   new_expr->shape = gfc_copy_shape (shape, rank);
4014
4015   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4016   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4017   new_expr->symtree->n.sym->ts = *ts;
4018   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4019   new_expr->symtree->n.sym->attr.function = 1;
4020   new_expr->symtree->n.sym->attr.elemental = 1;
4021   new_expr->symtree->n.sym->attr.pure = 1;
4022   new_expr->symtree->n.sym->attr.referenced = 1;
4023   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4024   gfc_commit_symbol (new_expr->symtree->n.sym);
4025
4026   *expr = *new_expr;
4027
4028   gfc_free (new_expr);
4029   expr->ts = *ts;
4030
4031   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4032       && do_simplify (sym, expr) == FAILURE)
4033     {
4034
4035       if (eflag == 2)
4036         goto bad;
4037       return FAILURE;           /* Error already generated in do_simplify() */
4038     }
4039
4040   return SUCCESS;
4041
4042 bad:
4043   if (eflag == 1)
4044     {
4045       gfc_error ("Can't convert %s to %s at %L",
4046                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4047       return FAILURE;
4048     }
4049
4050   gfc_internal_error ("Can't convert %s to %s at %L",
4051                       gfc_typename (&from_ts), gfc_typename (ts),
4052                       &expr->where);
4053   /* Not reached */
4054 }
4055
4056
4057 gfc_try
4058 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4059 {
4060   gfc_intrinsic_sym *sym;
4061   locus old_where;
4062   gfc_expr *new_expr;
4063   int rank;
4064   mpz_t *shape;
4065
4066   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4067
4068   sym = find_char_conv (&expr->ts, ts);
4069   gcc_assert (sym);
4070
4071   /* Insert a pre-resolved function call to the right function.  */
4072   old_where = expr->where;
4073   rank = expr->rank;
4074   shape = expr->shape;
4075
4076   new_expr = gfc_get_expr ();
4077   *new_expr = *expr;
4078
4079   new_expr = gfc_build_conversion (new_expr);
4080   new_expr->value.function.name = sym->lib_name;
4081   new_expr->value.function.isym = sym;
4082   new_expr->where = old_where;
4083   new_expr->rank = rank;
4084   new_expr->shape = gfc_copy_shape (shape, rank);
4085
4086   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4087   new_expr->symtree->n.sym->ts = *ts;
4088   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4089   new_expr->symtree->n.sym->attr.function = 1;
4090   new_expr->symtree->n.sym->attr.elemental = 1;
4091   new_expr->symtree->n.sym->attr.referenced = 1;
4092   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4093   gfc_commit_symbol (new_expr->symtree->n.sym);
4094
4095   *expr = *new_expr;
4096
4097   gfc_free (new_expr);
4098   expr->ts = *ts;
4099
4100   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4101       && do_simplify (sym, expr) == FAILURE)
4102     {
4103       /* Error already generated in do_simplify() */
4104       return FAILURE;
4105     }
4106
4107   return SUCCESS;
4108 }
4109
4110
4111 /* Check if the passed name is name of an intrinsic (taking into account the
4112    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4113    warn about this as a user-procedure having the same name as an intrinsic
4114    (-Wintrinsic-shadow enabled) and do so if we should.  */
4115
4116 void
4117 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4118 {
4119   gfc_intrinsic_sym* isym;
4120
4121   /* If the warning is disabled, do nothing at all.  */
4122   if (!gfc_option.warn_intrinsic_shadow)
4123     return;
4124
4125   /* Try to find an intrinsic of the same name.  */
4126   if (func)
4127     isym = gfc_find_function (sym->name);
4128   else
4129     isym = gfc_find_subroutine (sym->name);
4130
4131   /* If no intrinsic was found with this name or it's not included in the
4132      selected standard, everything's fine.  */
4133   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4134                                              sym->declared_at) == FAILURE)
4135     return;
4136
4137   /* Emit the warning.  */
4138   if (in_module)
4139     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4140                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4141                  " declarations may be required.",
4142                  sym->name, &sym->declared_at);
4143   else
4144     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4145                  " only be called via an explicit interface or if declared"
4146                  " EXTERNAL.", sym->name, &sym->declared_at);
4147 }