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