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_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1781                 gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
1782                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1783                 msk, BT_LOGICAL, dl, OPTIONAL);
1784
1785   make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
1786
1787   add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1788                 gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
1789                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1790                 msk, BT_LOGICAL, dl, OPTIONAL);
1791
1792   make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
1793
1794   add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1795              di, GFC_STD_GNU, NULL, NULL, NULL);
1796
1797   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1798
1799   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1800              gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1801              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1802
1803   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1804
1805   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1806              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1807              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1808              ln, BT_INTEGER, di, REQUIRED);
1809
1810   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1811
1812   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1813              gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1814              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1815
1816   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1817
1818   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1819              BT_INTEGER, di, GFC_STD_F77,
1820              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1821              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1822
1823   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1824
1825   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1826              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1827              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1828
1829   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1830
1831   add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1832              dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1833              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1834
1835   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1836
1837   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1838              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
1839
1840   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1841
1842   add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1843              gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
1844              ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1845
1846   /* The resolution function for INDEX is called gfc_resolve_index_func
1847      because the name gfc_resolve_index is already used in resolve.c.  */
1848   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1849              BT_INTEGER, di, GFC_STD_F77,
1850              gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1851              stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1852              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1853
1854   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1855
1856   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1857              gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1858              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1859
1860   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1861              NULL, gfc_simplify_ifix, NULL,
1862              a, BT_REAL, dr, REQUIRED);
1863
1864   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1865              NULL, gfc_simplify_idint, NULL,
1866              a, BT_REAL, dd, REQUIRED);
1867
1868   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1869
1870   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1871              gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1872              a, BT_REAL, dr, REQUIRED);
1873
1874   make_alias ("short", GFC_STD_GNU);
1875
1876   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1877
1878   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1879              gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1880              a, BT_REAL, dr, REQUIRED);
1881
1882   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1883
1884   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1885              gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1886              a, BT_REAL, dr, REQUIRED);
1887
1888   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1889
1890   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1891              gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1892              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1893
1894   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1895
1896   add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1897              dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1898              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1899
1900   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1901
1902   add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1903                 gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
1904                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1905                 msk, BT_LOGICAL, dl, OPTIONAL);
1906
1907   make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
1908
1909   /* The following function is for G77 compatibility.  */
1910   add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1911              4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
1912              i, BT_INTEGER, 4, OPTIONAL);
1913
1914   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1915
1916   add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1917              dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
1918              ut, BT_INTEGER, di, REQUIRED);
1919
1920   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1921
1922   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1923              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1924              gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1925              i, BT_INTEGER, 0, REQUIRED);
1926
1927   make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1928
1929   add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1930              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1931              gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1932              i, BT_INTEGER, 0, REQUIRED);
1933
1934   make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1935
1936   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1937              BT_LOGICAL, dl, GFC_STD_GNU,
1938              gfc_check_isnan, gfc_simplify_isnan, NULL,
1939              x, BT_REAL, 0, REQUIRED);
1940
1941   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1942
1943   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1944              gfc_check_ishft, NULL, gfc_resolve_rshift,
1945              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1946
1947   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1948
1949   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1950              gfc_check_ishft, NULL, gfc_resolve_lshift,
1951              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1952
1953   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1954
1955   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1956              gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1957              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1958
1959   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1960
1961   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1962              gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1963              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1964              sz, BT_INTEGER, di, OPTIONAL);
1965
1966   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1967
1968   add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1969              di, GFC_STD_GNU, gfc_check_kill, NULL, gfc_resolve_kill,
1970              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1971
1972   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1973
1974   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1975              gfc_check_kind, gfc_simplify_kind, NULL,
1976              x, BT_REAL, dr, REQUIRED);
1977
1978   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1979
1980   add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1981              BT_INTEGER, di, GFC_STD_F95,
1982              gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1983              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1984              kind, BT_INTEGER, di, OPTIONAL);
1985
1986   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1987
1988   add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
1989              BT_INTEGER, di, GFC_STD_F2008,
1990              gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
1991              ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1992              kind, BT_INTEGER, di, OPTIONAL);
1993
1994   make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
1995
1996   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1997              BT_INTEGER, di, GFC_STD_F2008,
1998              gfc_check_i, gfc_simplify_leadz, NULL,
1999              i, BT_INTEGER, di, REQUIRED);
2000
2001   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
2002
2003   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
2004              BT_INTEGER, di, GFC_STD_F77,
2005              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
2006              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2007
2008   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
2009
2010   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
2011              BT_INTEGER, di, GFC_STD_F95,
2012              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
2013              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2014
2015   make_alias ("lnblnk", GFC_STD_GNU);
2016
2017   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
2018
2019   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
2020              dr, GFC_STD_GNU,
2021              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2022              x, BT_REAL, dr, REQUIRED);
2023
2024   make_alias ("log_gamma", GFC_STD_F2008);
2025
2026   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2027              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2028              x, BT_REAL, dr, REQUIRED);
2029
2030   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2031              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
2032              x, BT_REAL, dr, REQUIRED);
2033
2034   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
2035
2036
2037   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2038              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
2039              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2040
2041   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
2042
2043   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2044              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
2045              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2046
2047   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
2048
2049   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2050              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
2051              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2052
2053   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
2054
2055   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2056              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
2057              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2058
2059   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
2060
2061   add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2062              GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
2063              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2064
2065   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2066
2067   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2068              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2069              x, BT_REAL, dr, REQUIRED);
2070
2071   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2072              NULL, gfc_simplify_log, gfc_resolve_log,
2073              x, BT_REAL, dr, REQUIRED);
2074
2075   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2076              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2077              x, BT_REAL, dd, REQUIRED);
2078
2079   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2080              NULL, gfc_simplify_log, gfc_resolve_log,
2081              x, BT_COMPLEX, dz, REQUIRED);
2082
2083   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
2084              NULL, gfc_simplify_log, gfc_resolve_log,
2085              x, BT_COMPLEX, dd, REQUIRED);
2086
2087   make_alias ("cdlog", GFC_STD_GNU);
2088
2089   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2090
2091   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2092              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2093              x, BT_REAL, dr, REQUIRED);
2094
2095   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2096              NULL, gfc_simplify_log10, gfc_resolve_log10,
2097              x, BT_REAL, dr, REQUIRED);
2098
2099   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2100              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2101              x, BT_REAL, dd, REQUIRED);
2102
2103   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2104
2105   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2106              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2107              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2108
2109   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2110
2111   add_sym_2 ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2112              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2113              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2114
2115   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2116
2117   add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2118              GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2119              sz, BT_INTEGER, di, REQUIRED);
2120
2121   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2122
2123   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2124              gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2125              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2126
2127   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2128
2129   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2130      int(max).  The max function must take at least two arguments.  */
2131
2132   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2133              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2134              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2135
2136   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2137              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2138              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2139
2140   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2141              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2142              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2143
2144   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2145              gfc_check_min_max_real, gfc_simplify_max, NULL,
2146              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2147
2148   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2149              gfc_check_min_max_real, gfc_simplify_max, NULL,
2150              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2151
2152   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2153              gfc_check_min_max_double, gfc_simplify_max, NULL,
2154              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2155
2156   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2157
2158   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2159              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2160              x, BT_UNKNOWN, dr, REQUIRED);
2161
2162   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2163
2164   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2165                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2166                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2167                msk, BT_LOGICAL, dl, OPTIONAL);
2168
2169   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2170
2171   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2172                 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2173                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2174                 msk, BT_LOGICAL, dl, OPTIONAL);
2175
2176   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2177
2178   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2179              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2180
2181   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2182
2183   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2184              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2185
2186   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2187
2188   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2189              gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2190              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2191              msk, BT_LOGICAL, dl, REQUIRED);
2192
2193   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2194
2195   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2196      int(min).  */
2197
2198   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2199               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2200               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2201
2202   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2203               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2204               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2205
2206   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2207               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2208               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2209
2210   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2211               gfc_check_min_max_real, gfc_simplify_min, NULL,
2212               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2213
2214   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2215               gfc_check_min_max_real, gfc_simplify_min, NULL,
2216               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2217
2218   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2219               gfc_check_min_max_double, gfc_simplify_min, NULL,
2220               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2221
2222   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2223
2224   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2225              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2226              x, BT_UNKNOWN, dr, REQUIRED);
2227
2228   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2229
2230   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2231                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2232                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2233                msk, BT_LOGICAL, dl, OPTIONAL);
2234
2235   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2236
2237   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2238                 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2239                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2240                 msk, BT_LOGICAL, dl, OPTIONAL);
2241
2242   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2243
2244   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2245              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2246              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2247
2248   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2249              NULL, gfc_simplify_mod, gfc_resolve_mod,
2250              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2251
2252   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2253              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2254              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2255
2256   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2257
2258   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2259              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2260              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2261
2262   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2263
2264   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2265              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2266              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2267
2268   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2269
2270   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2271              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2272              a, BT_CHARACTER, dc, REQUIRED);
2273
2274   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2275
2276   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2277              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2278              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2279
2280   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2281              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2282              a, BT_REAL, dd, REQUIRED);
2283
2284   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2285
2286   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2287              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2288              i, BT_INTEGER, di, REQUIRED);
2289
2290   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2291
2292   add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
2293              GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
2294              x, BT_REAL, dr, REQUIRED,
2295              dm, BT_INTEGER, ii, OPTIONAL);
2296
2297   make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
2298
2299   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2300              gfc_check_null, gfc_simplify_null, NULL,
2301              mo, BT_INTEGER, di, OPTIONAL);
2302
2303   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2304
2305   add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2306              NULL, gfc_simplify_num_images, NULL);
2307
2308   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2309              gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2310              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2311              v, BT_REAL, dr, OPTIONAL);
2312
2313   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2314
2315
2316   add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
2317              GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
2318              msk, BT_LOGICAL, dl, REQUIRED,
2319              dm, BT_INTEGER, ii, OPTIONAL);
2320
2321   make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
2322
2323   add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
2324              BT_INTEGER, di, GFC_STD_F2008,
2325              gfc_check_i, gfc_simplify_popcnt, NULL,
2326              i, BT_INTEGER, di, REQUIRED);
2327
2328   make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
2329
2330   add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
2331              BT_INTEGER, di, GFC_STD_F2008,
2332              gfc_check_i, gfc_simplify_poppar, NULL,
2333              i, BT_INTEGER, di, REQUIRED);
2334
2335   make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
2336
2337   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2338              gfc_check_precision, gfc_simplify_precision, NULL,
2339              x, BT_UNKNOWN, 0, REQUIRED);
2340
2341   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2342
2343   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2344                     BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2345                     a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2346
2347   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2348
2349   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2350                 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2351                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2352                 msk, BT_LOGICAL, dl, OPTIONAL);
2353
2354   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2355
2356   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2357              gfc_check_radix, gfc_simplify_radix, NULL,
2358              x, BT_UNKNOWN, 0, REQUIRED);
2359
2360   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2361
2362   /* The following function is for G77 compatibility.  */
2363   add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2364              4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
2365              i, BT_INTEGER, 4, OPTIONAL);
2366
2367   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2368      use slightly different shoddy multiplicative congruential PRNG.  */
2369   make_alias ("ran", GFC_STD_GNU);
2370
2371   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2372
2373   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2374              gfc_check_range, gfc_simplify_range, NULL,
2375              x, BT_REAL, dr, REQUIRED);
2376
2377   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2378
2379   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2380              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2381              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2382
2383   /* This provides compatibility with g77.  */
2384   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2385              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2386              a, BT_UNKNOWN, dr, REQUIRED);
2387
2388   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2389              gfc_check_float, gfc_simplify_float, NULL,
2390              a, BT_INTEGER, di, REQUIRED);
2391
2392   add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2393              gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2394              a, BT_REAL, dr, REQUIRED);
2395
2396   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2397              gfc_check_sngl, gfc_simplify_sngl, NULL,
2398              a, BT_REAL, dd, REQUIRED);
2399
2400   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2401
2402   add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2403              GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2404              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2405
2406   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2407
2408   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2409              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2410              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2411
2412   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2413
2414   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2415              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2416              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2417              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2418
2419   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2420
2421   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2422              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2423              x, BT_REAL, dr, REQUIRED);
2424
2425   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2426
2427   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2428              BT_LOGICAL, dl, GFC_STD_F2003,
2429              gfc_check_same_type_as, NULL, NULL,
2430              a, BT_UNKNOWN, 0, REQUIRED,
2431              b, BT_UNKNOWN, 0, REQUIRED);
2432
2433   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2434              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2435              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2436
2437   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2438
2439   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2440              BT_INTEGER, di, GFC_STD_F95,
2441              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2442              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2443              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2444
2445   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2446
2447   /* Added for G77 compatibility garbage.  */
2448   add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2449              4, GFC_STD_GNU, NULL, NULL, NULL);
2450
2451   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2452
2453   /* Added for G77 compatibility.  */
2454   add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2455              dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
2456              x, BT_REAL, dr, REQUIRED);
2457
2458   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2459
2460   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2461              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2462              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2463              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2464
2465   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2466
2467   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2468              GFC_STD_F95, gfc_check_selected_int_kind,
2469              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2470
2471   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2472
2473   add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2474              GFC_STD_F95, gfc_check_selected_real_kind,
2475              gfc_simplify_selected_real_kind, NULL,
2476              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2477              "radix", BT_INTEGER, di, OPTIONAL);
2478
2479   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2480
2481   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2482              gfc_check_set_exponent, gfc_simplify_set_exponent,
2483              gfc_resolve_set_exponent,
2484              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2485
2486   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2487
2488   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2489              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2490              src, BT_REAL, dr, REQUIRED);
2491
2492   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2493
2494   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2495              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2496              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2497
2498   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2499              NULL, gfc_simplify_sign, gfc_resolve_sign,
2500              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2501
2502   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2503              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2504              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2505
2506   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2507
2508   add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2509              di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
2510              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2511
2512   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2513
2514   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2515              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2516              x, BT_REAL, dr, REQUIRED);
2517
2518   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2519              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2520              x, BT_REAL, dd, REQUIRED);
2521
2522   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2523              NULL, gfc_simplify_sin, gfc_resolve_sin,
2524              x, BT_COMPLEX, dz, REQUIRED);
2525
2526   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2527              NULL, gfc_simplify_sin, gfc_resolve_sin,
2528              x, BT_COMPLEX, dd, REQUIRED);
2529
2530   make_alias ("cdsin", GFC_STD_GNU);
2531
2532   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2533
2534   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2535              gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2536              x, BT_REAL, dr, REQUIRED);
2537
2538   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2539              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2540              x, BT_REAL, dd, REQUIRED);
2541
2542   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2543
2544   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2545              BT_INTEGER, di, GFC_STD_F95,
2546              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2547              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2548              kind, BT_INTEGER, di, OPTIONAL);
2549
2550   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2551
2552   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2553              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2554              x, BT_UNKNOWN, 0, REQUIRED);
2555
2556   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2557
2558   add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
2559              BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
2560              x, BT_UNKNOWN, 0, REQUIRED);
2561
2562   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2563              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2564              x, BT_REAL, dr, REQUIRED);
2565
2566   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2567
2568   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2569              gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2570              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2571              ncopies, BT_INTEGER, di, REQUIRED);
2572
2573   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2574
2575   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2576              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2577              x, BT_REAL, dr, REQUIRED);
2578
2579   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2580              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2581              x, BT_REAL, dd, REQUIRED);
2582
2583   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2584              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2585              x, BT_COMPLEX, dz, REQUIRED);
2586
2587   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2588              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2589              x, BT_COMPLEX, dd, REQUIRED);
2590
2591   make_alias ("cdsqrt", GFC_STD_GNU);
2592
2593   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2594
2595   add_sym_2 ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2596              GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2597              nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2598
2599   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2600
2601   add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2602              BT_INTEGER, di, GFC_STD_F2008,
2603              gfc_check_storage_size, NULL, gfc_resolve_storage_size,
2604              a, BT_UNKNOWN, 0, REQUIRED,
2605              kind, BT_INTEGER, di, OPTIONAL);
2606
2607   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2608                 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2609                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2610                 msk, BT_LOGICAL, dl, OPTIONAL);
2611
2612   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2613
2614   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2615              GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2616              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2617
2618   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2619
2620   add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2621              GFC_STD_GNU, NULL, NULL, NULL,
2622              com, BT_CHARACTER, dc, REQUIRED);
2623
2624   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2625
2626   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2627              gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2628              x, BT_REAL, dr, REQUIRED);
2629
2630   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2631              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2632              x, BT_REAL, dd, REQUIRED);
2633
2634   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2635
2636   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2637              gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2638              x, BT_REAL, dr, REQUIRED);
2639
2640   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2641              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2642              x, BT_REAL, dd, REQUIRED);
2643
2644   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2645
2646   add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2647              gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
2648              ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2649
2650   add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2651              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
2652
2653   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2654
2655   add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2656              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
2657
2658   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2659
2660   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2661              gfc_check_x, gfc_simplify_tiny, NULL,
2662              x, BT_REAL, dr, REQUIRED);
2663
2664   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2665
2666   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2667              BT_INTEGER, di, GFC_STD_F2008,
2668              gfc_check_i, gfc_simplify_trailz, NULL,
2669              i, BT_INTEGER, di, REQUIRED);
2670
2671   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2672
2673   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2674              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2675              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2676              sz, BT_INTEGER, di, OPTIONAL);
2677
2678   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2679
2680   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2681              gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2682              m, BT_REAL, dr, REQUIRED);
2683
2684   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2685
2686   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2687              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2688              stg, BT_CHARACTER, dc, REQUIRED);
2689
2690   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2691
2692   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
2693              0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2694              ut, BT_INTEGER, di, REQUIRED);
2695
2696   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2697
2698   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2699              BT_INTEGER, di, GFC_STD_F95,
2700              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2701              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2702              kind, BT_INTEGER, di, OPTIONAL);
2703
2704   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2705
2706   add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2707             BT_INTEGER, di, GFC_STD_F2008,
2708             gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2709             ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2710             kind, BT_INTEGER, di, OPTIONAL);
2711
2712   make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
2713
2714   /* g77 compatibility for UMASK.  */
2715   add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2716              GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2717              msk, BT_INTEGER, di, REQUIRED);
2718
2719   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2720
2721   /* g77 compatibility for UNLINK.  */
2722   add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2723              di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
2724              "path", BT_CHARACTER, dc, REQUIRED);
2725
2726   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2727
2728   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2729              gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2730              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2731              f, BT_REAL, dr, REQUIRED);
2732
2733   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2734
2735   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2736              BT_INTEGER, di, GFC_STD_F95,
2737              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2738              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2739              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2740
2741   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2742
2743   add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2744              GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2745              x, BT_UNKNOWN, 0, REQUIRED);
2746
2747   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2748 }
2749
2750
2751 /* Add intrinsic subroutines.  */
2752
2753 static void
2754 add_subroutines (void)
2755 {
2756   /* Argument names as in the standard (to be used as argument keywords).  */
2757   const char
2758     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2759     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2760     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2761     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2762     *com = "command", *length = "length", *st = "status",
2763     *val = "value", *num = "number", *name = "name",
2764     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2765     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2766     *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2767     *p2 = "path2", *msk = "mask", *old = "old";
2768
2769   int di, dr, dc, dl, ii;
2770
2771   di = gfc_default_integer_kind;
2772   dr = gfc_default_real_kind;
2773   dc = gfc_default_character_kind;
2774   dl = gfc_default_logical_kind;
2775   ii = gfc_index_integer_kind;
2776
2777   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2778
2779   make_noreturn();
2780
2781   add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
2782                      GFC_STD_F95, gfc_check_cpu_time, NULL,
2783                      gfc_resolve_cpu_time,
2784                      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2785
2786   /* More G77 compatibility garbage.  */
2787   add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2788               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2789               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2790
2791   add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2792               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2793               vl, BT_INTEGER, 4, REQUIRED);
2794
2795   add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2796               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2797               vl, BT_INTEGER, 4, REQUIRED);
2798
2799   add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2800               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2801               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2802
2803   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN,
2804               0, GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2805               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2806
2807   add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
2808               GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2809               tm, BT_REAL, dr, REQUIRED);
2810
2811   add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2812               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2813               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2814
2815   add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2816               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2817               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2818               st, BT_INTEGER, di, OPTIONAL);
2819
2820   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
2821               0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2822               dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2823               tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2824               zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2825               vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2826
2827   /* More G77 compatibility garbage.  */
2828   add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2829               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2830               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2831
2832   add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2833               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2834               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2835
2836   add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
2837               CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
2838               NULL, NULL, gfc_resolve_execute_command_line,
2839               "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2840               "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
2841               "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
2842               "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2843               "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
2844
2845   add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2846               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2847               dt, BT_CHARACTER, dc, REQUIRED);
2848
2849   add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
2850               0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
2851               res, BT_CHARACTER, dc, REQUIRED);
2852
2853   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
2854               GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2855               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2856
2857   add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
2858               0, GFC_STD_GNU, NULL, NULL, NULL,
2859               name, BT_CHARACTER, dc, REQUIRED,
2860               val, BT_CHARACTER, dc, REQUIRED);
2861
2862   add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
2863               0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
2864               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2865
2866   add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
2867               0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
2868               c, BT_CHARACTER, dc, REQUIRED);
2869
2870   /* F2003 commandline routines.  */
2871
2872   add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
2873                      BT_UNKNOWN, 0, GFC_STD_F2003,
2874                      NULL, NULL, gfc_resolve_get_command,
2875                      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2876                      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2877                      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2878
2879   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
2880               CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2881               gfc_resolve_get_command_argument,
2882               num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2883               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2884               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2885               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2886
2887   /* F2003 subroutine to get environment variables.  */
2888
2889   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2890               CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
2891               NULL, NULL, gfc_resolve_get_environment_variable,
2892               name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2893               val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2894               length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2895               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2896               trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2897
2898   add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE,
2899                      BT_UNKNOWN, 0, GFC_STD_F2003,
2900                      gfc_check_move_alloc, NULL, NULL,
2901                      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2902                      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2903
2904   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2905               GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2906               gfc_resolve_mvbits,
2907               f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2908               fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2909               ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2910               t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2911               tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2912
2913   add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
2914                      BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2915                      gfc_resolve_random_number,
2916                      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2917
2918   add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
2919                      BT_UNKNOWN, 0, GFC_STD_F95,
2920                      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2921                      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2922                      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2923                      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2924
2925   /* More G77 compatibility garbage.  */
2926   add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2927               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2928               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2929               st, BT_INTEGER, di, OPTIONAL);
2930
2931   add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
2932               di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
2933               "seed", BT_INTEGER, 4, REQUIRED);
2934
2935   add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2936               gfc_check_exit, NULL, gfc_resolve_exit,
2937               st, BT_INTEGER, di, OPTIONAL);
2938
2939   make_noreturn();
2940
2941   add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2942               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2943               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2944               st, BT_INTEGER, di, OPTIONAL);
2945
2946   add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2947               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2948               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2949
2950   add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2951               gfc_check_flush, NULL, gfc_resolve_flush,
2952               ut, BT_INTEGER, di, OPTIONAL);
2953
2954   add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2955               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2956               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2957               st, BT_INTEGER, di, OPTIONAL);
2958
2959   add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2960               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2961               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2962
2963   add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2964               gfc_check_free, NULL, gfc_resolve_free,
2965               ptr, BT_INTEGER, ii, REQUIRED);
2966
2967   add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2968               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2969               ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2970               of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2971               whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2972               st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2973
2974   add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2975               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2976               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2977
2978   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
2979               GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2980               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2981
2982   add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN,
2983               0, GFC_STD_GNU, gfc_check_kill_sub,
2984               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2985               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2986
2987   add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2988               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2989               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2990               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2991
2992   add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
2993               0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
2994               "string", BT_CHARACTER, dc, REQUIRED);
2995
2996   add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
2997               GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2998               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2999               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
3000
3001   add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3002               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
3003               sec, BT_INTEGER, di, REQUIRED);
3004
3005   add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3006               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
3007               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
3008               st, BT_INTEGER, di, OPTIONAL);
3009
3010   add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3011               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
3012               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
3013               st, BT_INTEGER, di, OPTIONAL);
3014
3015   add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3016               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
3017               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
3018               st, BT_INTEGER, di, OPTIONAL);
3019
3020   add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
3021               GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
3022               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
3023               st, BT_INTEGER, di, OPTIONAL);
3024
3025   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3026               GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
3027               p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
3028               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
3029
3030   add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
3031               0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
3032               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
3033
3034   add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
3035                      BT_UNKNOWN, 0, GFC_STD_F95,
3036                      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
3037                      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3038                      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3039                      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3040
3041   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
3042               GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
3043               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
3044
3045   add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3046               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
3047               msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
3048
3049   add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3050               GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
3051               "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
3052 }
3053
3054
3055 /* Add a function to the list of conversion symbols.  */
3056
3057 static void
3058 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
3059 {
3060   gfc_typespec from, to;
3061   gfc_intrinsic_sym *sym;
3062
3063   if (sizing == SZ_CONVS)
3064     {
3065       nconv++;
3066       return;
3067     }
3068
3069   gfc_clear_ts (&from);
3070   from.type = from_type;
3071   from.kind = from_kind;
3072
3073   gfc_clear_ts (&to);
3074   to.type = to_type;
3075   to.kind = to_kind;
3076
3077   sym = conversion + nconv;
3078
3079   sym->name = conv_name (&from, &to);
3080   sym->lib_name = sym->name;
3081   sym->simplify.cc = gfc_convert_constant;
3082   sym->standard = standard;
3083   sym->elemental = 1;
3084   sym->pure = 1;
3085   sym->conversion = 1;
3086   sym->ts = to;
3087   sym->id = GFC_ISYM_CONVERSION;
3088
3089   nconv++;
3090 }
3091
3092
3093 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3094    functions by looping over the kind tables.  */
3095
3096 static void
3097 add_conversions (void)
3098 {
3099   int i, j;
3100
3101   /* Integer-Integer conversions.  */
3102   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3103     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
3104       {
3105         if (i == j)
3106           continue;
3107
3108         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3109                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
3110       }
3111
3112   /* Integer-Real/Complex conversions.  */
3113   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3114     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3115       {
3116         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3117                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3118
3119         add_conv (BT_REAL, gfc_real_kinds[j].kind,
3120                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3121
3122         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3123                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3124
3125         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3126                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3127       }
3128
3129   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3130     {
3131       /* Hollerith-Integer conversions.  */
3132       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3133         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3134                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3135       /* Hollerith-Real conversions.  */
3136       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3137         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3138                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3139       /* Hollerith-Complex conversions.  */
3140       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3141         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3142                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3143
3144       /* Hollerith-Character conversions.  */
3145       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3146                   gfc_default_character_kind, GFC_STD_LEGACY);
3147
3148       /* Hollerith-Logical conversions.  */
3149       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3150         add_conv (BT_HOLLERITH, gfc_default_character_kind,
3151                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3152     }
3153
3154   /* Real/Complex - Real/Complex conversions.  */
3155   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3156     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3157       {
3158         if (i != j)
3159           {
3160             add_conv (BT_REAL, gfc_real_kinds[i].kind,
3161                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3162
3163             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3164                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3165           }
3166
3167         add_conv (BT_REAL, gfc_real_kinds[i].kind,
3168                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3169
3170         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3171                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3172       }
3173
3174   /* Logical/Logical kind conversion.  */
3175   for (i = 0; gfc_logical_kinds[i].kind; i++)
3176     for (j = 0; gfc_logical_kinds[j].kind; j++)
3177       {
3178         if (i == j)
3179           continue;
3180
3181         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3182                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3183       }
3184
3185   /* Integer-Logical and Logical-Integer conversions.  */
3186   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3187     for (i=0; gfc_integer_kinds[i].kind; i++)
3188       for (j=0; gfc_logical_kinds[j].kind; j++)
3189         {
3190           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3191                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3192           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3193                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3194         }
3195 }
3196
3197
3198 static void
3199 add_char_conversions (void)
3200 {
3201   int n, i, j;
3202
3203   /* Count possible conversions.  */
3204   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3205     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3206       if (i != j)
3207         ncharconv++;
3208
3209   /* Allocate memory.  */
3210   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3211
3212   /* Add the conversions themselves.  */
3213   n = 0;
3214   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3215     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3216       {
3217         gfc_typespec from, to;
3218
3219         if (i == j)
3220           continue;
3221
3222         gfc_clear_ts (&from);
3223         from.type = BT_CHARACTER;
3224         from.kind = gfc_character_kinds[i].kind;
3225
3226         gfc_clear_ts (&to);
3227         to.type = BT_CHARACTER;
3228         to.kind = gfc_character_kinds[j].kind;
3229
3230         char_conversions[n].name = conv_name (&from, &to);
3231         char_conversions[n].lib_name = char_conversions[n].name;
3232         char_conversions[n].simplify.cc = gfc_convert_char_constant;
3233         char_conversions[n].standard = GFC_STD_F2003;
3234         char_conversions[n].elemental = 1;
3235         char_conversions[n].pure = 1;
3236         char_conversions[n].conversion = 0;
3237         char_conversions[n].ts = to;
3238         char_conversions[n].id = GFC_ISYM_CONVERSION;
3239
3240         n++;
3241       }
3242 }
3243
3244
3245 /* Initialize the table of intrinsics.  */
3246 void
3247 gfc_intrinsic_init_1 (void)
3248 {
3249   int i;
3250
3251   nargs = nfunc = nsub = nconv = 0;
3252
3253   /* Create a namespace to hold the resolved intrinsic symbols.  */
3254   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3255
3256   sizing = SZ_FUNCS;
3257   add_functions ();
3258   sizing = SZ_SUBS;
3259   add_subroutines ();
3260   sizing = SZ_CONVS;
3261   add_conversions ();
3262
3263   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3264                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3265                         + sizeof (gfc_intrinsic_arg) * nargs);
3266
3267   next_sym = functions;
3268   subroutines = functions + nfunc;
3269
3270   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3271
3272   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3273
3274   sizing = SZ_NOTHING;
3275   nconv = 0;
3276
3277   add_functions ();
3278   add_subroutines ();
3279   add_conversions ();
3280
3281   /* Character conversion intrinsics need to be treated separately.  */
3282   add_char_conversions ();
3283
3284   /* Set the pure flag.  All intrinsic functions are pure, and
3285      intrinsic subroutines are pure if they are elemental.  */
3286
3287   for (i = 0; i < nfunc; i++)
3288     functions[i].pure = 1;
3289
3290   for (i = 0; i < nsub; i++)
3291     subroutines[i].pure = subroutines[i].elemental;
3292 }
3293
3294
3295 void
3296 gfc_intrinsic_done_1 (void)
3297 {
3298   gfc_free (functions);
3299   gfc_free (conversion);
3300   gfc_free (char_conversions);
3301   gfc_free_namespace (gfc_intrinsic_namespace);
3302 }
3303
3304
3305 /******** Subroutines to check intrinsic interfaces ***********/
3306
3307 /* Given a formal argument list, remove any NULL arguments that may
3308    have been left behind by a sort against some formal argument list.  */
3309
3310 static void
3311 remove_nullargs (gfc_actual_arglist **ap)
3312 {
3313   gfc_actual_arglist *head, *tail, *next;
3314
3315   tail = NULL;
3316
3317   for (head = *ap; head; head = next)
3318     {
3319       next = head->next;
3320
3321       if (head->expr == NULL && !head->label)
3322         {
3323           head->next = NULL;
3324           gfc_free_actual_arglist (head);
3325         }
3326       else
3327         {
3328           if (tail == NULL)
3329             *ap = head;
3330           else
3331             tail->next = head;
3332
3333           tail = head;
3334           tail->next = NULL;
3335         }
3336     }
3337
3338   if (tail == NULL)
3339     *ap = NULL;
3340 }
3341
3342
3343 /* Given an actual arglist and a formal arglist, sort the actual
3344    arglist so that its arguments are in a one-to-one correspondence
3345    with the format arglist.  Arguments that are not present are given
3346    a blank gfc_actual_arglist structure.  If something is obviously
3347    wrong (say, a missing required argument) we abort sorting and
3348    return FAILURE.  */
3349
3350 static gfc_try
3351 sort_actual (const char *name, gfc_actual_arglist **ap,
3352              gfc_intrinsic_arg *formal, locus *where)
3353 {
3354   gfc_actual_arglist *actual, *a;
3355   gfc_intrinsic_arg *f;
3356
3357   remove_nullargs (ap);
3358   actual = *ap;
3359
3360   for (f = formal; f; f = f->next)
3361     f->actual = NULL;
3362
3363   f = formal;
3364   a = actual;
3365
3366   if (f == NULL && a == NULL)   /* No arguments */
3367     return SUCCESS;
3368
3369   for (;;)
3370     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3371       if (f == NULL)
3372         break;
3373       if (a == NULL)
3374         goto optional;
3375
3376       if (a->name != NULL)
3377         goto keywords;
3378
3379       f->actual = a;
3380
3381       f = f->next;
3382       a = a->next;
3383     }
3384
3385   if (a == NULL)
3386     goto do_sort;
3387
3388   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3389   return FAILURE;
3390
3391 keywords:
3392   /* Associate the remaining actual arguments, all of which have
3393      to be keyword arguments.  */
3394   for (; a; a = a->next)
3395     {
3396       for (f = formal; f; f = f->next)
3397         if (strcmp (a->name, f->name) == 0)
3398           break;
3399
3400       if (f == NULL)
3401         {
3402           if (a->name[0] == '%')
3403             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3404                        "are not allowed in this context at %L", where);
3405           else
3406             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3407                        a->name, name, where);
3408           return FAILURE;
3409         }
3410
3411       if (f->actual != NULL)
3412         {
3413           gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3414                      f->name, name, where);
3415           return FAILURE;
3416         }
3417
3418       f->actual = a;
3419     }
3420
3421 optional:
3422   /* At this point, all unmatched formal args must be optional.  */
3423   for (f = formal; f; f = f->next)
3424     {
3425       if (f->actual == NULL && f->optional == 0)
3426         {
3427           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3428                      f->name, name, where);
3429           return FAILURE;
3430         }
3431     }
3432
3433 do_sort:
3434   /* Using the formal argument list, string the actual argument list
3435      together in a way that corresponds with the formal list.  */
3436   actual = NULL;
3437
3438   for (f = formal; f; f = f->next)
3439     {
3440       if (f->actual && f->actual->label != NULL && f->ts.type)
3441         {
3442           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3443           return FAILURE;
3444         }
3445
3446       if (f->actual == NULL)
3447         {
3448           a = gfc_get_actual_arglist ();
3449           a->missing_arg_type = f->ts.type;
3450         }
3451       else
3452         a = f->actual;
3453
3454       if (actual == NULL)
3455         *ap = a;
3456       else
3457         actual->next = a;
3458
3459       actual = a;
3460     }
3461   actual->next = NULL;          /* End the sorted argument list.  */
3462
3463   return SUCCESS;
3464 }
3465
3466
3467 /* Compare an actual argument list with an intrinsic's formal argument
3468    list.  The lists are checked for agreement of type.  We don't check
3469    for arrayness here.  */
3470
3471 static gfc_try
3472 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3473                int error_flag)
3474 {
3475   gfc_actual_arglist *actual;
3476   gfc_intrinsic_arg *formal;
3477   int i;
3478
3479   formal = sym->formal;
3480   actual = *ap;
3481
3482   i = 0;
3483   for (; formal; formal = formal->next, actual = actual->next, i++)
3484     {
3485       gfc_typespec ts;
3486
3487       if (actual->expr == NULL)
3488         continue;
3489
3490       ts = formal->ts;
3491
3492       /* A kind of 0 means we don't check for kind.  */
3493       if (ts.kind == 0)
3494         ts.kind = actual->expr->ts.kind;
3495
3496       if (!gfc_compare_types (&ts, &actual->expr->ts))
3497         {
3498           if (error_flag)
3499             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3500                        "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
3501                        gfc_current_intrinsic, &actual->expr->where,
3502                        gfc_typename (&formal->ts),
3503                        gfc_typename (&actual->expr->ts));
3504           return FAILURE;
3505         }
3506     }
3507
3508   return SUCCESS;
3509 }
3510
3511
3512 /* Given a pointer to an intrinsic symbol and an expression node that
3513    represent the function call to that subroutine, figure out the type
3514    of the result.  This may involve calling a resolution subroutine.  */
3515
3516 static void
3517 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3518 {
3519   gfc_expr *a1, *a2, *a3, *a4, *a5;
3520   gfc_actual_arglist *arg;
3521
3522   if (specific->resolve.f1 == NULL)
3523     {
3524       if (e->value.function.name == NULL)
3525         e->value.function.name = specific->lib_name;
3526
3527       if (e->ts.type == BT_UNKNOWN)
3528         e->ts = specific->ts;
3529       return;
3530     }
3531
3532   arg = e->value.function.actual;
3533
3534   /* Special case hacks for MIN and MAX.  */
3535   if (specific->resolve.f1m == gfc_resolve_max
3536       || specific->resolve.f1m == gfc_resolve_min)
3537     {
3538       (*specific->resolve.f1m) (e, arg);
3539       return;
3540     }
3541
3542   if (arg == NULL)
3543     {
3544       (*specific->resolve.f0) (e);
3545       return;
3546     }
3547
3548   a1 = arg->expr;
3549   arg = arg->next;
3550
3551   if (arg == NULL)
3552     {
3553       (*specific->resolve.f1) (e, a1);
3554       return;
3555     }
3556
3557   a2 = arg->expr;
3558   arg = arg->next;
3559
3560   if (arg == NULL)
3561     {
3562       (*specific->resolve.f2) (e, a1, a2);
3563       return;
3564     }
3565
3566   a3 = arg->expr;
3567   arg = arg->next;
3568
3569   if (arg == NULL)
3570     {
3571       (*specific->resolve.f3) (e, a1, a2, a3);
3572       return;
3573     }
3574
3575   a4 = arg->expr;
3576   arg = arg->next;
3577
3578   if (arg == NULL)
3579     {
3580       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3581       return;
3582     }
3583
3584   a5 = arg->expr;
3585   arg = arg->next;
3586
3587   if (arg == NULL)
3588     {
3589       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3590       return;
3591     }
3592
3593   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3594 }
3595
3596
3597 /* Given an intrinsic symbol node and an expression node, call the
3598    simplification function (if there is one), perhaps replacing the
3599    expression with something simpler.  We return FAILURE on an error
3600    of the simplification, SUCCESS if the simplification worked, even
3601    if nothing has changed in the expression itself.  */
3602
3603 static gfc_try
3604 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3605 {
3606   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3607   gfc_actual_arglist *arg;
3608
3609   /* Max and min require special handling due to the variable number
3610      of args.  */
3611   if (specific->simplify.f1 == gfc_simplify_min)
3612     {
3613       result = gfc_simplify_min (e);
3614       goto finish;
3615     }
3616
3617   if (specific->simplify.f1 == gfc_simplify_max)
3618     {
3619       result = gfc_simplify_max (e);
3620       goto finish;
3621     }
3622
3623   if (specific->simplify.f1 == NULL)
3624     {
3625       result = NULL;
3626       goto finish;
3627     }
3628
3629   arg = e->value.function.actual;
3630
3631   if (arg == NULL)
3632     {
3633       result = (*specific->simplify.f0) ();
3634       goto finish;
3635     }
3636
3637   a1 = arg->expr;
3638   arg = arg->next;
3639
3640   if (specific->simplify.cc == gfc_convert_constant
3641       || specific->simplify.cc == gfc_convert_char_constant)
3642     {
3643       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3644       goto finish;
3645     }
3646
3647   if (arg == NULL)
3648     result = (*specific->simplify.f1) (a1);
3649   else
3650     {
3651       a2 = arg->expr;
3652       arg = arg->next;
3653
3654       if (arg == NULL)
3655         result = (*specific->simplify.f2) (a1, a2);
3656       else
3657         {
3658           a3 = arg->expr;
3659           arg = arg->next;
3660
3661           if (arg == NULL)
3662             result = (*specific->simplify.f3) (a1, a2, a3);
3663           else
3664             {
3665               a4 = arg->expr;
3666               arg = arg->next;
3667
3668               if (arg == NULL)
3669                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3670               else
3671                 {
3672                   a5 = arg->expr;
3673                   arg = arg->next;
3674
3675                   if (arg == NULL)
3676                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3677                   else
3678                     gfc_internal_error
3679                       ("do_simplify(): Too many args for intrinsic");
3680                 }
3681             }
3682         }
3683     }
3684
3685 finish:
3686   if (result == &gfc_bad_expr)
3687     return FAILURE;
3688
3689   if (result == NULL)
3690     resolve_intrinsic (specific, e);    /* Must call at run-time */
3691   else
3692     {
3693       result->where = e->where;
3694       gfc_replace_expr (e, result);
3695     }
3696
3697   return SUCCESS;
3698 }
3699
3700
3701 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3702    error messages.  This subroutine returns FAILURE if a subroutine
3703    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3704    list cannot match any intrinsic.  */
3705
3706 static void
3707 init_arglist (gfc_intrinsic_sym *isym)
3708 {
3709   gfc_intrinsic_arg *formal;
3710   int i;
3711
3712   gfc_current_intrinsic = isym->name;
3713
3714   i = 0;
3715   for (formal = isym->formal; formal; formal = formal->next)
3716     {
3717       if (i >= MAX_INTRINSIC_ARGS)
3718         gfc_internal_error ("init_arglist(): too many arguments");
3719       gfc_current_intrinsic_arg[i++] = formal;
3720     }
3721 }
3722
3723
3724 /* Given a pointer to an intrinsic symbol and an expression consisting
3725    of a function call, see if the function call is consistent with the
3726    intrinsic's formal argument list.  Return SUCCESS if the expression
3727    and intrinsic match, FAILURE otherwise.  */
3728
3729 static gfc_try
3730 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3731 {
3732   gfc_actual_arglist *arg, **ap;
3733   gfc_try t;
3734
3735   ap = &expr->value.function.actual;
3736
3737   init_arglist (specific);
3738
3739   /* Don't attempt to sort the argument list for min or max.  */
3740   if (specific->check.f1m == gfc_check_min_max
3741       || specific->check.f1m == gfc_check_min_max_integer
3742       || specific->check.f1m == gfc_check_min_max_real
3743       || specific->check.f1m == gfc_check_min_max_double)
3744     return (*specific->check.f1m) (*ap);
3745
3746   if (sort_actual (specific->name, ap, specific->formal,
3747                    &expr->where) == FAILURE)
3748     return FAILURE;
3749
3750   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3751     /* This is special because we might have to reorder the argument list.  */
3752     t = gfc_check_minloc_maxloc (*ap);
3753   else if (specific->check.f3red == gfc_check_minval_maxval)
3754     /* This is also special because we also might have to reorder the
3755        argument list.  */
3756     t = gfc_check_minval_maxval (*ap);
3757   else if (specific->check.f3red == gfc_check_product_sum)
3758     /* Same here. The difference to the previous case is that we allow a
3759        general numeric type.  */
3760     t = gfc_check_product_sum (*ap);
3761   else if (specific->check.f3red == gfc_check_transf_bit_intrins)
3762     /* Same as for PRODUCT and SUM, but different checks.  */
3763     t = gfc_check_transf_bit_intrins (*ap);
3764   else
3765      {
3766        if (specific->check.f1 == NULL)
3767          {
3768            t = check_arglist (ap, specific, error_flag);
3769            if (t == SUCCESS)
3770              expr->ts = specific->ts;
3771          }
3772        else
3773          t = do_check (specific, *ap);
3774      }
3775
3776   /* Check conformance of elemental intrinsics.  */
3777   if (t == SUCCESS && specific->elemental)
3778     {
3779       int n = 0;
3780       gfc_expr *first_expr;
3781       arg = expr->value.function.actual;
3782
3783       /* There is no elemental intrinsic without arguments.  */
3784       gcc_assert(arg != NULL);
3785       first_expr = arg->expr;
3786
3787       for ( ; arg && arg->expr; arg = arg->next, n++)
3788         if (gfc_check_conformance (first_expr, arg->expr,
3789                                    "arguments '%s' and '%s' for "
3790                                    "intrinsic '%s'",
3791                                    gfc_current_intrinsic_arg[0]->name,
3792                                    gfc_current_intrinsic_arg[n]->name,
3793                                    gfc_current_intrinsic) == FAILURE)
3794           return FAILURE;
3795     }
3796
3797   if (t == FAILURE)
3798     remove_nullargs (ap);
3799
3800   return t;
3801 }
3802
3803
3804 /* Check whether an intrinsic belongs to whatever standard the user
3805    has chosen, taking also into account -fall-intrinsics.  Here, no
3806    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3807    textual representation of the symbols standard status (like
3808    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3809    can be used to construct a detailed warning/error message in case of
3810    a FAILURE.  */
3811
3812 gfc_try
3813 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3814                               const char** symstd, bool silent, locus where)
3815 {
3816   const char* symstd_msg;
3817
3818   /* For -fall-intrinsics, just succeed.  */
3819   if (gfc_option.flag_all_intrinsics)
3820     return SUCCESS;
3821
3822   /* Find the symbol's standard message for later usage.  */
3823   switch (isym->standard)
3824     {
3825     case GFC_STD_F77:
3826       symstd_msg = "available since Fortran 77";
3827       break;
3828
3829     case GFC_STD_F95_OBS:
3830       symstd_msg = "obsolescent in Fortran 95";
3831       break;
3832
3833     case GFC_STD_F95_DEL:
3834       symstd_msg = "deleted in Fortran 95";
3835       break;
3836
3837     case GFC_STD_F95:
3838       symstd_msg = "new in Fortran 95";
3839       break;
3840
3841     case GFC_STD_F2003:
3842       symstd_msg = "new in Fortran 2003";
3843       break;
3844
3845     case GFC_STD_F2008:
3846       symstd_msg = "new in Fortran 2008";
3847       break;
3848
3849     case GFC_STD_GNU:
3850       symstd_msg = "a GNU Fortran extension";
3851       break;
3852
3853     case GFC_STD_LEGACY:
3854       symstd_msg = "for backward compatibility";
3855       break;
3856
3857     default:
3858       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3859                           isym->name, isym->standard);
3860     }
3861
3862   /* If warning about the standard, warn and succeed.  */
3863   if (gfc_option.warn_std & isym->standard)
3864     {
3865       /* Do only print a warning if not a GNU extension.  */
3866       if (!silent && isym->standard != GFC_STD_GNU)
3867         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3868                      isym->name, _(symstd_msg), &where);
3869
3870       return SUCCESS;
3871     }
3872
3873   /* If allowing the symbol's standard, succeed, too.  */
3874   if (gfc_option.allow_std & isym->standard)
3875     return SUCCESS;
3876
3877   /* Otherwise, fail.  */
3878   if (symstd)
3879     *symstd = _(symstd_msg);
3880   return FAILURE;
3881 }
3882
3883
3884 /* See if a function call corresponds to an intrinsic function call.
3885    We return:
3886
3887     MATCH_YES    if the call corresponds to an intrinsic, simplification
3888                  is done if possible.
3889
3890     MATCH_NO     if the call does not correspond to an intrinsic
3891
3892     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3893                  error during the simplification process.
3894
3895    The error_flag parameter enables an error reporting.  */
3896
3897 match
3898 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3899 {
3900   gfc_intrinsic_sym *isym, *specific;
3901   gfc_actual_arglist *actual;
3902   const char *name;
3903   int flag;
3904
3905   if (expr->value.function.isym != NULL)
3906     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3907            ? MATCH_ERROR : MATCH_YES;
3908
3909   if (!error_flag)
3910     gfc_push_suppress_errors ();
3911   flag = 0;
3912
3913   for (actual = expr->value.function.actual; actual; actual = actual->next)
3914     if (actual->expr != NULL)
3915       flag |= (actual->expr->ts.type != BT_INTEGER
3916                && actual->expr->ts.type != BT_CHARACTER);
3917
3918   name = expr->symtree->n.sym->name;
3919
3920   isym = specific = gfc_find_function (name);
3921   if (isym == NULL)
3922     {
3923       if (!error_flag)
3924         gfc_pop_suppress_errors ();
3925       return MATCH_NO;
3926     }
3927
3928   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3929        || isym->id == GFC_ISYM_CMPLX)
3930       && gfc_init_expr_flag
3931       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3932                          "as initialization expression at %L", name,
3933                          &expr->where) == FAILURE)
3934     {
3935       if (!error_flag)
3936         gfc_pop_suppress_errors ();
3937       return MATCH_ERROR;
3938     }
3939
3940   gfc_current_intrinsic_where = &expr->where;
3941
3942   /* Bypass the generic list for min and max.  */
3943   if (isym->check.f1m == gfc_check_min_max)
3944     {
3945       init_arglist (isym);
3946
3947       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3948         goto got_specific;
3949
3950       if (!error_flag)
3951         gfc_pop_suppress_errors ();
3952       return MATCH_NO;
3953     }
3954
3955   /* If the function is generic, check all of its specific
3956      incarnations.  If the generic name is also a specific, we check
3957      that name last, so that any error message will correspond to the
3958      specific.  */
3959   gfc_push_suppress_errors ();
3960
3961   if (isym->generic)
3962     {
3963       for (specific = isym->specific_head; specific;
3964            specific = specific->next)
3965         {
3966           if (specific == isym)
3967             continue;
3968           if (check_specific (specific, expr, 0) == SUCCESS)
3969             {
3970               gfc_pop_suppress_errors ();
3971               goto got_specific;
3972             }
3973         }
3974     }
3975
3976   gfc_pop_suppress_errors ();
3977
3978   if (check_specific (isym, expr, error_flag) == FAILURE)
3979     {
3980       if (!error_flag)
3981         gfc_pop_suppress_errors ();
3982       return MATCH_NO;
3983     }
3984
3985   specific = isym;
3986
3987 got_specific:
3988   expr->value.function.isym = specific;
3989   gfc_intrinsic_symbol (expr->symtree->n.sym);
3990
3991   if (!error_flag)
3992     gfc_pop_suppress_errors ();
3993
3994   if (do_simplify (specific, expr) == FAILURE)
3995     return MATCH_ERROR;
3996
3997   /* F95, 7.1.6.1, Initialization expressions
3998      (4) An elemental intrinsic function reference of type integer or
3999          character where each argument is an initialization expression
4000          of type integer or character
4001
4002      F2003, 7.1.7 Initialization expression
4003      (4)   A reference to an elemental standard intrinsic function,
4004            where each argument is an initialization expression  */
4005
4006   if (gfc_init_expr_flag && isym->elemental && flag
4007       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
4008                         "as initialization expression with non-integer/non-"
4009                         "character arguments at %L", &expr->where) == FAILURE)
4010     return MATCH_ERROR;
4011
4012   return MATCH_YES;
4013 }
4014
4015
4016 /* See if a CALL statement corresponds to an intrinsic subroutine.
4017    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4018    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4019    correspond).  */
4020
4021 match
4022 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
4023 {
4024   gfc_intrinsic_sym *isym;
4025   const char *name;
4026
4027   name = c->symtree->n.sym->name;
4028
4029   isym = gfc_find_subroutine (name);
4030   if (isym == NULL)
4031     return MATCH_NO;
4032
4033   if (!error_flag)
4034     gfc_push_suppress_errors ();
4035
4036   init_arglist (isym);
4037
4038   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
4039     goto fail;
4040
4041   if (isym->check.f1 != NULL)
4042     {
4043       if (do_check (isym, c->ext.actual) == FAILURE)
4044         goto fail;
4045     }
4046   else
4047     {
4048       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
4049         goto fail;
4050     }
4051
4052   /* The subroutine corresponds to an intrinsic.  Allow errors to be
4053      seen at this point.  */
4054   if (!error_flag)
4055     gfc_pop_suppress_errors ();
4056
4057   c->resolved_isym = isym;
4058   if (isym->resolve.s1 != NULL)
4059     isym->resolve.s1 (c);
4060   else
4061     {
4062       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
4063       c->resolved_sym->attr.elemental = isym->elemental;
4064     }
4065
4066   if (gfc_pure (NULL) && !isym->elemental)
4067     {
4068       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
4069                  &c->loc);
4070       return MATCH_ERROR;
4071     }
4072
4073   c->resolved_sym->attr.noreturn = isym->noreturn;
4074
4075   return MATCH_YES;
4076
4077 fail:
4078   if (!error_flag)
4079     gfc_pop_suppress_errors ();
4080   return MATCH_NO;
4081 }
4082
4083
4084 /* Call gfc_convert_type() with warning enabled.  */
4085
4086 gfc_try
4087 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
4088 {
4089   return gfc_convert_type_warn (expr, ts, eflag, 1);
4090 }
4091
4092
4093 /* Try to convert an expression (in place) from one type to another.
4094    'eflag' controls the behavior on error.
4095
4096    The possible values are:
4097
4098      1 Generate a gfc_error()
4099      2 Generate a gfc_internal_error().
4100
4101    'wflag' controls the warning related to conversion.  */
4102
4103 gfc_try
4104 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
4105 {
4106   gfc_intrinsic_sym *sym;
4107   gfc_typespec from_ts;
4108   locus old_where;
4109   gfc_expr *new_expr;
4110   int rank;
4111   mpz_t *shape;
4112
4113   from_ts = expr->ts;           /* expr->ts gets clobbered */
4114
4115   if (ts->type == BT_UNKNOWN)
4116     goto bad;
4117
4118   /* NULL and zero size arrays get their type here.  */
4119   if (expr->expr_type == EXPR_NULL
4120       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
4121     {
4122       /* Sometimes the RHS acquire the type.  */
4123       expr->ts = *ts;
4124       return SUCCESS;
4125     }
4126
4127   if (expr->ts.type == BT_UNKNOWN)
4128     goto bad;
4129
4130   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4131       && gfc_compare_types (&expr->ts, ts))
4132     return SUCCESS;
4133
4134   sym = find_conv (&expr->ts, ts);
4135   if (sym == NULL)
4136     goto bad;
4137
4138   /* At this point, a conversion is necessary. A warning may be needed.  */
4139   if ((gfc_option.warn_std & sym->standard) != 0)
4140     {
4141       gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4142                        gfc_typename (&from_ts), gfc_typename (ts),
4143                        &expr->where);
4144     }
4145   else if (wflag)
4146     {
4147       if (gfc_option.flag_range_check
4148           && expr->expr_type == EXPR_CONSTANT
4149           && from_ts.type == ts->type)
4150         {
4151           /* Do nothing. Constants of the same type are range-checked
4152              elsewhere. If a value too large for the target type is
4153              assigned, an error is generated. Not checking here avoids
4154              duplications of warnings/errors.
4155              If range checking was disabled, but -Wconversion enabled,
4156              a non range checked warning is generated below.  */
4157         }
4158       else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4159         {
4160           /* Do nothing. This block exists only to simplify the other
4161              else-if expressions.
4162                LOGICAL <> LOGICAL    no warning, independent of kind values
4163                LOGICAL <> INTEGER    extension, warned elsewhere
4164                LOGICAL <> REAL       invalid, error generated elsewhere
4165                LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
4166         }
4167       else if (from_ts.type == ts->type
4168                || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4169                || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4170                || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4171         {
4172           /* Larger kinds can hold values of smaller kinds without problems.
4173              Hence, only warn if target kind is smaller than the source
4174              kind - or if -Wconversion-extra is specified.  */
4175           if (gfc_option.warn_conversion_extra)
4176             gfc_warning_now ("Conversion from %s to %s at %L",
4177                              gfc_typename (&from_ts), gfc_typename (ts),
4178                              &expr->where);
4179           else if (gfc_option.warn_conversion
4180                    && from_ts.kind > ts->kind)
4181             gfc_warning_now ("Possible change of value in conversion "
4182                              "from %s to %s at %L", gfc_typename (&from_ts),
4183                              gfc_typename (ts), &expr->where);
4184         }
4185       else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4186                || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4187                || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4188         {
4189           /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4190              usually comes with a loss of information, regardless of kinds.  */
4191           if (gfc_option.warn_conversion_extra
4192               || gfc_option.warn_conversion)
4193             gfc_warning_now ("Possible change of value in conversion "
4194                              "from %s to %s at %L", gfc_typename (&from_ts),
4195                              gfc_typename (ts), &expr->where);
4196         }
4197       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4198         {
4199           /* If HOLLERITH is involved, all bets are off.  */
4200           if (gfc_option.warn_conversion_extra
4201               || gfc_option.warn_conversion)
4202             gfc_warning_now ("Conversion from %s to %s at %L",
4203                              gfc_typename (&from_ts), gfc_typename (ts),
4204                              &expr->where);
4205         }
4206       else
4207         gcc_unreachable ();
4208     }
4209
4210   /* Insert a pre-resolved function call to the right function.  */
4211   old_where = expr->where;
4212   rank = expr->rank;
4213   shape = expr->shape;
4214
4215   new_expr = gfc_get_expr ();
4216   *new_expr = *expr;
4217
4218   new_expr = gfc_build_conversion (new_expr);
4219   new_expr->value.function.name = sym->lib_name;
4220   new_expr->value.function.isym = sym;
4221   new_expr->where = old_where;
4222   new_expr->rank = rank;
4223   new_expr->shape = gfc_copy_shape (shape, rank);
4224
4225   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4226   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4227   new_expr->symtree->n.sym->ts = *ts;
4228   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4229   new_expr->symtree->n.sym->attr.function = 1;
4230   new_expr->symtree->n.sym->attr.elemental = 1;
4231   new_expr->symtree->n.sym->attr.pure = 1;
4232   new_expr->symtree->n.sym->attr.referenced = 1;
4233   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4234   gfc_commit_symbol (new_expr->symtree->n.sym);
4235
4236   *expr = *new_expr;
4237
4238   gfc_free (new_expr);
4239   expr->ts = *ts;
4240
4241   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4242       && do_simplify (sym, expr) == FAILURE)
4243     {
4244
4245       if (eflag == 2)
4246         goto bad;
4247       return FAILURE;           /* Error already generated in do_simplify() */
4248     }
4249
4250   return SUCCESS;
4251
4252 bad:
4253   if (eflag == 1)
4254     {
4255       gfc_error ("Can't convert %s to %s at %L",
4256                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4257       return FAILURE;
4258     }
4259
4260   gfc_internal_error ("Can't convert %s to %s at %L",
4261                       gfc_typename (&from_ts), gfc_typename (ts),
4262                       &expr->where);
4263   /* Not reached */
4264 }
4265
4266
4267 gfc_try
4268 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4269 {
4270   gfc_intrinsic_sym *sym;
4271   locus old_where;
4272   gfc_expr *new_expr;
4273   int rank;
4274   mpz_t *shape;
4275
4276   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4277
4278   sym = find_char_conv (&expr->ts, ts);
4279   gcc_assert (sym);
4280
4281   /* Insert a pre-resolved function call to the right function.  */
4282   old_where = expr->where;
4283   rank = expr->rank;
4284   shape = expr->shape;
4285
4286   new_expr = gfc_get_expr ();
4287   *new_expr = *expr;
4288
4289   new_expr = gfc_build_conversion (new_expr);
4290   new_expr->value.function.name = sym->lib_name;
4291   new_expr->value.function.isym = sym;
4292   new_expr->where = old_where;
4293   new_expr->rank = rank;
4294   new_expr->shape = gfc_copy_shape (shape, rank);
4295
4296   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4297   new_expr->symtree->n.sym->ts = *ts;
4298   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4299   new_expr->symtree->n.sym->attr.function = 1;
4300   new_expr->symtree->n.sym->attr.elemental = 1;
4301   new_expr->symtree->n.sym->attr.referenced = 1;
4302   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4303   gfc_commit_symbol (new_expr->symtree->n.sym);
4304
4305   *expr = *new_expr;
4306
4307   gfc_free (new_expr);
4308   expr->ts = *ts;
4309
4310   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4311       && do_simplify (sym, expr) == FAILURE)
4312     {
4313       /* Error already generated in do_simplify() */
4314       return FAILURE;
4315     }
4316
4317   return SUCCESS;
4318 }
4319
4320
4321 /* Check if the passed name is name of an intrinsic (taking into account the
4322    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4323    warn about this as a user-procedure having the same name as an intrinsic
4324    (-Wintrinsic-shadow enabled) and do so if we should.  */
4325
4326 void
4327 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4328 {
4329   gfc_intrinsic_sym* isym;
4330
4331   /* If the warning is disabled, do nothing at all.  */
4332   if (!gfc_option.warn_intrinsic_shadow)
4333     return;
4334
4335   /* Try to find an intrinsic of the same name.  */
4336   if (func)
4337     isym = gfc_find_function (sym->name);
4338   else
4339     isym = gfc_find_subroutine (sym->name);
4340
4341   /* If no intrinsic was found with this name or it's not included in the
4342      selected standard, everything's fine.  */
4343   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4344                                              sym->declared_at) == FAILURE)
4345     return;
4346
4347   /* Emit the warning.  */
4348   if (in_module)
4349     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4350                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4351                  " declarations may be required.",
4352                  sym->name, &sym->declared_at);
4353   else
4354     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4355                  " only be called via an explicit interface or if declared"
4356                  " EXTERNAL.", sym->name, &sym->declared_at);
4357 }