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