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