gcc/fortran/intrinsic.c

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