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