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, 2011
   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       next_sym->pure = (cl != CLASS_IMPURE);
 278       next_sym->elemental = (cl == CLASS_ELEMENTAL);
 279       next_sym->inquiry = (cl == CLASS_INQUIRY);
 280       next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
 281       next_sym->actual_ok = actual_ok;
 282       next_sym->ts.type = type;
 283       next_sym->ts.kind = kind;
 284       next_sym->standard = standard;
 285       next_sym->simplify = simplify;
 286       next_sym->check = check;
 287       next_sym->resolve = resolve;
 288       next_sym->specific = 0;
 289       next_sym->generic = 0;
 290       next_sym->conversion = 0;
 291       next_sym->id = id;
 292       break;
 293
 294     default:
 295       gfc_internal_error ("add_sym(): Bad sizing mode");
 296     }
 297
 298   va_start (argp, resolve);
 299
 300   first_flag = 1;
 301
 302   for (;;)
 303     {
 304       name = va_arg (argp, char *);
 305       if (name == NULL)
 306         break;
 307
 308       type = (bt) va_arg (argp, int);
 309       kind = va_arg (argp, int);
 310       optional = va_arg (argp, int);
 311       intent = (sym_intent) va_arg (argp, int);
 312
 313       if (sizing != SZ_NOTHING)
 314         nargs++;
 315       else
 316         {
 317           next_arg++;
 318
 319           if (first_flag)
 320             next_sym->formal = next_arg;
 321           else
 322             (next_arg - 1)->next = next_arg;
 323
 324           first_flag = 0;
 325
 326           strcpy (next_arg->name, name);
 327           next_arg->ts.type = type;
 328           next_arg->ts.kind = kind;
 329           next_arg->optional = optional;
 330           next_arg->value = 0;
 331           next_arg->intent = intent;
 332         }
 333     }
 334
 335   va_end (argp);
 336
 337   next_sym++;
 338 }
 339
 340
 341 /* Add a symbol to the function list where the function takes
 342    0 arguments.  */
 343
 344 static void
 345 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 346            int kind, int standard,
 347            gfc_try (*check) (void),
 348            gfc_expr *(*simplify) (void),
 349            void (*resolve) (gfc_expr *))
 350 {
 351   gfc_simplify_f sf;
 352   gfc_check_f cf;
 353   gfc_resolve_f rf;
 354
 355   cf.f0 = check;
 356   sf.f0 = simplify;
 357   rf.f0 = resolve;
 358
 359   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 360            (void *) 0);
 361 }
 362
 363
 364 /* Add a symbol to the subroutine list where the subroutine takes
 365    0 arguments.  */
 366
 367 static void
 368 add_sym_0s (const char *name, gfc_isym_id id, int standard,
 369             void (*resolve) (gfc_code *))
 370 {
 371   gfc_check_f cf;
 372   gfc_simplify_f sf;
 373   gfc_resolve_f rf;
 374
 375   cf.f1 = NULL;
 376   sf.f1 = NULL;
 377   rf.s1 = resolve;
 378
 379   add_sym (name, id, CLASS_IMPURE, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf,
 380            rf, (void *) 0);
 381 }
 382
 383
 384 /* Add a symbol to the function list where the function takes
 385    1 arguments.  */
 386
 387 static void
 388 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 389            int kind, int standard,
 390            gfc_try (*check) (gfc_expr *),
 391            gfc_expr *(*simplify) (gfc_expr *),
 392            void (*resolve) (gfc_expr *, gfc_expr *),
 393            const char *a1, bt type1, int kind1, int optional1)
 394 {
 395   gfc_check_f cf;
 396   gfc_simplify_f sf;
 397   gfc_resolve_f rf;
 398
 399   cf.f1 = check;
 400   sf.f1 = simplify;
 401   rf.f1 = resolve;
 402
 403   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 404            a1, type1, kind1, optional1, INTENT_IN,
 405            (void *) 0);
 406 }
 407
 408
 409 /* Add a symbol to the function list where the function takes
 410    1 arguments, specifying the intent of the argument.  */
 411
 412 static void
 413 add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
 414                   int actual_ok, bt type, int kind, int standard,
 415                   gfc_try (*check) (gfc_expr *),
 416                   gfc_expr *(*simplify) (gfc_expr *),
 417                   void (*resolve) (gfc_expr *, gfc_expr *),
 418                   const char *a1, bt type1, int kind1, int optional1,
 419                   sym_intent intent1)
 420 {
 421   gfc_check_f cf;
 422   gfc_simplify_f sf;
 423   gfc_resolve_f rf;
 424
 425   cf.f1 = check;
 426   sf.f1 = simplify;
 427   rf.f1 = resolve;
 428
 429   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 430            a1, type1, kind1, optional1, intent1,
 431            (void *) 0);
 432 }
 433
 434
 435 /* Add a symbol to the subroutine list where the subroutine takes
 436    1 arguments, specifying the intent of the argument.  */
 437
 438 static void
 439 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 440             int standard, gfc_try (*check) (gfc_expr *),
 441             gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *),
 442             const char *a1, bt type1, int kind1, int optional1,
 443             sym_intent intent1)
 444 {
 445   gfc_check_f cf;
 446   gfc_simplify_f sf;
 447   gfc_resolve_f rf;
 448
 449   cf.f1 = check;
 450   sf.f1 = simplify;
 451   rf.s1 = resolve;
 452
 453   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 454            a1, type1, kind1, optional1, intent1,
 455            (void *) 0);
 456 }
 457
 458
 459 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
 460    function.  MAX et al take 2 or more arguments.  */
 461
 462 static void
 463 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 464             int kind, int standard,
 465             gfc_try (*check) (gfc_actual_arglist *),
 466             gfc_expr *(*simplify) (gfc_expr *),
 467             void (*resolve) (gfc_expr *, gfc_actual_arglist *),
 468             const char *a1, bt type1, int kind1, int optional1,
 469             const char *a2, bt type2, int kind2, int optional2)
 470 {
 471   gfc_check_f cf;
 472   gfc_simplify_f sf;
 473   gfc_resolve_f rf;
 474
 475   cf.f1m = check;
 476   sf.f1 = simplify;
 477   rf.f1m = resolve;
 478
 479   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 480            a1, type1, kind1, optional1, INTENT_IN,
 481            a2, type2, kind2, optional2, INTENT_IN,
 482            (void *) 0);
 483 }
 484
 485
 486 /* Add a symbol to the function list where the function takes
 487    2 arguments.  */
 488
 489 static void
 490 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 491            int kind, int standard,
 492            gfc_try (*check) (gfc_expr *, gfc_expr *),
 493            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 494            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
 495            const char *a1, bt type1, int kind1, int optional1,
 496            const char *a2, bt type2, int kind2, int optional2)
 497 {
 498   gfc_check_f cf;
 499   gfc_simplify_f sf;
 500   gfc_resolve_f rf;
 501
 502   cf.f2 = check;
 503   sf.f2 = simplify;
 504   rf.f2 = resolve;
 505
 506   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 507            a1, type1, kind1, optional1, INTENT_IN,
 508            a2, type2, kind2, optional2, INTENT_IN,
 509            (void *) 0);
 510 }
 511
 512
 513 /* Add a symbol to the function list where the function takes
 514    2 arguments; same as add_sym_2 - but allows to specify the intent.  */
 515
 516 static void
 517 add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
 518                   int actual_ok, bt type, int kind, int standard,
 519                   gfc_try (*check) (gfc_expr *, gfc_expr *),
 520                   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 521                   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
 522                   const char *a1, bt type1, int kind1, int optional1,
 523                   sym_intent intent1, const char *a2, bt type2, int kind2,
 524                   int optional2, sym_intent intent2)
 525 {
 526   gfc_check_f cf;
 527   gfc_simplify_f sf;
 528   gfc_resolve_f rf;
 529
 530   cf.f2 = check;
 531   sf.f2 = simplify;
 532   rf.f2 = resolve;
 533
 534   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 535            a1, type1, kind1, optional1, intent1,
 536            a2, type2, kind2, optional2, intent2,
 537            (void *) 0);
 538 }
 539
 540
 541 /* Add a symbol to the subroutine list where the subroutine takes
 542    2 arguments, specifying the intent of the arguments.  */
 543
 544 static void
 545 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
 546             int kind, int standard,
 547             gfc_try (*check) (gfc_expr *, gfc_expr *),
 548             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
 549             void (*resolve) (gfc_code *),
 550             const char *a1, bt type1, int kind1, int optional1,
 551             sym_intent intent1, const char *a2, bt type2, int kind2,
 552             int optional2, sym_intent intent2)
 553 {
 554   gfc_check_f cf;
 555   gfc_simplify_f sf;
 556   gfc_resolve_f rf;
 557
 558   cf.f2 = check;
 559   sf.f2 = simplify;
 560   rf.s1 = resolve;
 561
 562   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 563            a1, type1, kind1, optional1, intent1,
 564            a2, type2, kind2, optional2, intent2,
 565            (void *) 0);
 566 }
 567
 568
 569 /* Add a symbol to the function list where the function takes
 570    3 arguments.  */
 571
 572 static void
 573 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 574            int kind, int standard,
 575            gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
 576            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 577            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 578            const char *a1, bt type1, int kind1, int optional1,
 579            const char *a2, bt type2, int kind2, int optional2,
 580            const char *a3, bt type3, int kind3, int optional3)
 581 {
 582   gfc_check_f cf;
 583   gfc_simplify_f sf;
 584   gfc_resolve_f rf;
 585
 586   cf.f3 = check;
 587   sf.f3 = simplify;
 588   rf.f3 = resolve;
 589
 590   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 591            a1, type1, kind1, optional1, INTENT_IN,
 592            a2, type2, kind2, optional2, INTENT_IN,
 593            a3, type3, kind3, optional3, INTENT_IN,
 594            (void *) 0);
 595 }
 596
 597
 598 /* MINLOC and MAXLOC get special treatment because their argument
 599    might have to be reordered.  */
 600
 601 static void
 602 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 603              int kind, int standard,
 604              gfc_try (*check) (gfc_actual_arglist *),
 605              gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 606              void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 607              const char *a1, bt type1, int kind1, int optional1,
 608              const char *a2, bt type2, int kind2, int optional2,
 609              const char *a3, bt type3, int kind3, int optional3)
 610 {
 611   gfc_check_f cf;
 612   gfc_simplify_f sf;
 613   gfc_resolve_f rf;
 614
 615   cf.f3ml = check;
 616   sf.f3 = simplify;
 617   rf.f3 = resolve;
 618
 619   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 620            a1, type1, kind1, optional1, INTENT_IN,
 621            a2, type2, kind2, optional2, INTENT_IN,
 622            a3, type3, kind3, optional3, INTENT_IN,
 623            (void *) 0);
 624 }
 625
 626
 627 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
 628    their argument also might have to be reordered.  */
 629
 630 static void
 631 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 632               int kind, int standard,
 633               gfc_try (*check) (gfc_actual_arglist *),
 634               gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 635               void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 636               const char *a1, bt type1, int kind1, int optional1,
 637               const char *a2, bt type2, int kind2, int optional2,
 638               const char *a3, bt type3, int kind3, int optional3)
 639 {
 640   gfc_check_f cf;
 641   gfc_simplify_f sf;
 642   gfc_resolve_f rf;
 643
 644   cf.f3red = check;
 645   sf.f3 = simplify;
 646   rf.f3 = resolve;
 647
 648   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 649            a1, type1, kind1, optional1, INTENT_IN,
 650            a2, type2, kind2, optional2, INTENT_IN,
 651            a3, type3, kind3, optional3, INTENT_IN,
 652            (void *) 0);
 653 }
 654
 655
 656 /* Add a symbol to the subroutine list where the subroutine takes
 657    3 arguments, specifying the intent of the arguments.  */
 658
 659 static void
 660 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
 661             int kind, int standard,
 662             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
 663             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
 664             void (*resolve) (gfc_code *),
 665             const char *a1, bt type1, int kind1, int optional1,
 666             sym_intent intent1, const char *a2, bt type2, int kind2,
 667             int optional2, sym_intent intent2, const char *a3, bt type3,
 668             int kind3, int optional3, sym_intent intent3)
 669 {
 670   gfc_check_f cf;
 671   gfc_simplify_f sf;
 672   gfc_resolve_f rf;
 673
 674   cf.f3 = check;
 675   sf.f3 = simplify;
 676   rf.s1 = resolve;
 677
 678   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 679            a1, type1, kind1, optional1, intent1,
 680            a2, type2, kind2, optional2, intent2,
 681            a3, type3, kind3, optional3, intent3,
 682            (void *) 0);
 683 }
 684
 685
 686 /* Add a symbol to the function list where the function takes
 687    4 arguments.  */
 688
 689 static void
 690 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
 691            int kind, int standard,
 692            gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 693            gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 694                                   gfc_expr *),
 695            void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 696                             gfc_expr *),
 697            const char *a1, bt type1, int kind1, int optional1,
 698            const char *a2, bt type2, int kind2, int optional2,
 699            const char *a3, bt type3, int kind3, int optional3,
 700            const char *a4, bt type4, int kind4, int optional4 )
 701 {
 702   gfc_check_f cf;
 703   gfc_simplify_f sf;
 704   gfc_resolve_f rf;
 705
 706   cf.f4 = check;
 707   sf.f4 = simplify;
 708   rf.f4 = resolve;
 709
 710   add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
 711            a1, type1, kind1, optional1, INTENT_IN,
 712            a2, type2, kind2, optional2, INTENT_IN,
 713            a3, type3, kind3, optional3, INTENT_IN,
 714            a4, type4, kind4, optional4, INTENT_IN,
 715            (void *) 0);
 716 }
 717
 718
 719 /* Add a symbol to the subroutine list where the subroutine takes
 720    4 arguments.  */
 721
 722 static void
 723 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 724             int standard,
 725             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
 726             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 727                                    gfc_expr *),
 728             void (*resolve) (gfc_code *),
 729             const char *a1, bt type1, int kind1, int optional1,
 730             sym_intent intent1, const char *a2, bt type2, int kind2,
 731             int optional2, sym_intent intent2, const char *a3, bt type3,
 732             int kind3, int optional3, sym_intent intent3, const char *a4,
 733             bt type4, int kind4, int optional4, sym_intent intent4)
 734 {
 735   gfc_check_f cf;
 736   gfc_simplify_f sf;
 737   gfc_resolve_f rf;
 738
 739   cf.f4 = check;
 740   sf.f4 = simplify;
 741   rf.s1 = resolve;
 742
 743   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 744            a1, type1, kind1, optional1, intent1,
 745            a2, type2, kind2, optional2, intent2,
 746            a3, type3, kind3, optional3, intent3,
 747            a4, type4, kind4, optional4, intent4,
 748            (void *) 0);
 749 }
 750
 751
 752 /* Add a symbol to the subroutine list where the subroutine takes
 753    5 arguments.  */
 754
 755 static void
 756 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
 757             int standard,
 758             gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 759                           gfc_expr *),
 760             gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
 761                                    gfc_expr *, gfc_expr *),
 762             void (*resolve) (gfc_code *),
 763             const char *a1, bt type1, int kind1, int optional1,
 764             sym_intent intent1, const char *a2, bt type2, int kind2,
 765             int optional2, sym_intent intent2, const char *a3, bt type3,
 766             int kind3, int optional3, sym_intent intent3, const char *a4,
 767             bt type4, int kind4, int optional4, sym_intent intent4,
 768             const char *a5, bt type5, int kind5, int optional5,
 769             sym_intent intent5)
 770 {
 771   gfc_check_f cf;
 772   gfc_simplify_f sf;
 773   gfc_resolve_f rf;
 774
 775   cf.f5 = check;
 776   sf.f5 = simplify;
 777   rf.s1 = resolve;
 778
 779   add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
 780            a1, type1, kind1, optional1, intent1,
 781            a2, type2, kind2, optional2, intent2,
 782            a3, type3, kind3, optional3, intent3,
 783            a4, type4, kind4, optional4, intent4,
 784            a5, type5, kind5, optional5, intent5,
 785            (void *) 0);
 786 }
 787
 788
 789 /* Locate an intrinsic symbol given a base pointer, number of elements
 790    in the table and a pointer to a name.  Returns the NULL pointer if
 791    a name is not found.  */
 792
 793 static gfc_intrinsic_sym *
 794 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
 795 {
 796   /* name may be a user-supplied string, so we must first make sure
 797      that we're comparing against a pointer into the global string
 798      table.  */
 799   const char *p = gfc_get_string (name);
 800
 801   while (n > 0)
 802     {
 803       if (p == start->name)
 804         return start;
 805
 806       start++;
 807       n--;
 808     }
 809
 810   return NULL;
 811 }
 812
 813
 814 gfc_intrinsic_sym *
 815 gfc_intrinsic_function_by_id (gfc_isym_id id)
 816 {
 817   gfc_intrinsic_sym *start = functions;
 818   int n = nfunc;
 819
 820   while (true)
 821     {
 822       gcc_assert (n > 0);
 823       if (id == start->id)
 824         return start;
 825
 826       start++;
 827       n--;
 828     }
 829 }
 830
 831
 832 /* Given a name, find a function in the intrinsic function table.
 833    Returns NULL if not found.  */
 834
 835 gfc_intrinsic_sym *
 836 gfc_find_function (const char *name)
 837 {
 838   gfc_intrinsic_sym *sym;
 839
 840   sym = find_sym (functions, nfunc, name);
 841   if (!sym || sym->from_module)
 842     sym = find_sym (conversion, nconv, name);
 843
 844   return (!sym || sym->from_module) ? NULL : sym;
 845 }
 846
 847
 848 /* Given a name, find a function in the intrinsic subroutine table.
 849    Returns NULL if not found.  */
 850
 851 gfc_intrinsic_sym *
 852 gfc_find_subroutine (const char *name)
 853 {
 854   gfc_intrinsic_sym *sym;
 855   sym = find_sym (subroutines, nsub, name);
 856   return (!sym || sym->from_module) ? NULL : sym;
 857 }
 858
 859
 860 /* Given a string, figure out if it is the name of a generic intrinsic
 861    function or not.  */
 862
 863 int
 864 gfc_generic_intrinsic (const char *name)
 865 {
 866   gfc_intrinsic_sym *sym;
 867
 868   sym = gfc_find_function (name);
 869   return (!sym || sym->from_module) ? 0 : sym->generic;
 870 }
 871
 872
 873 /* Given a string, figure out if it is the name of a specific
 874    intrinsic function or not.  */
 875
 876 int
 877 gfc_specific_intrinsic (const char *name)
 878 {
 879   gfc_intrinsic_sym *sym;
 880
 881   sym = gfc_find_function (name);
 882   return (!sym || sym->from_module) ? 0 : sym->specific;
 883 }
 884
 885
 886 /* Given a string, figure out if it is the name of an intrinsic function
 887    or subroutine allowed as an actual argument or not.  */
 888 int
 889 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
 890 {
 891   gfc_intrinsic_sym *sym;
 892
 893   /* Intrinsic subroutines are not allowed as actual arguments.  */
 894   if (subroutine_flag)
 895     return 0;
 896   else
 897     {
 898       sym = gfc_find_function (name);
 899       return (sym == NULL) ? 0 : sym->actual_ok;
 900     }
 901 }
 902
 903
 904 /* Given a symbol, find out if it is (and is to be treated) an intrinsic.  If
 905    it's name refers to an intrinsic but this intrinsic is not included in the
 906    selected standard, this returns FALSE and sets the symbol's external
 907    attribute.  */
 908
 909 bool
 910 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
 911 {
 912   gfc_intrinsic_sym* isym;
 913   const char* symstd;
 914
 915   /* If INTRINSIC/EXTERNAL state is already known, return.  */
 916   if (sym->attr.intrinsic)
 917     return true;
 918   if (sym->attr.external)
 919     return false;
 920
 921   if (subroutine_flag)
 922     isym = gfc_find_subroutine (sym->name);
 923   else
 924     isym = gfc_find_function (sym->name);
 925
 926   /* No such intrinsic available at all?  */
 927   if (!isym)
 928     return false;
 929
 930   /* See if this intrinsic is allowed in the current standard.  */
 931   if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
 932     {
 933       if (sym->attr.proc == PROC_UNKNOWN
 934           && gfc_option.warn_intrinsics_std)
 935         gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
 936                          " selected standard but %s and '%s' will be"
 937                          " treated as if declared EXTERNAL.  Use an"
 938                          " appropriate -std=* option or define"
 939                          " -fall-intrinsics to allow this intrinsic.",
 940                          sym->name, &loc, symstd, sym->name);
 941
 942       return false;
 943     }
 944
 945   return true;
 946 }
 947
 948
 949 /* Collect a set of intrinsic functions into a generic collection.
 950    The first argument is the name of the generic function, which is
 951    also the name of a specific function.  The rest of the specifics
 952    currently in the table are placed into the list of specific
 953    functions associated with that generic.
 954
 955    PR fortran/32778
 956    FIXME: Remove the argument STANDARD if no regressions are
 957           encountered. Change all callers (approx. 360).
 958 */
 959
 960 static void
 961 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 962 {
 963   gfc_intrinsic_sym *g;
 964
 965   if (sizing != SZ_NOTHING)
 966     return;
 967
 968   g = gfc_find_function (name);
 969   if (g == NULL)
 970     gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
 971                         name);
 972
 973   gcc_assert (g->id == id);
 974
 975   g->generic = 1;
 976   g->specific = 1;
 977   if ((g + 1)->name != NULL)
 978     g->specific_head = g + 1;
 979   g++;
 980
 981   while (g->name != NULL)
 982     {
 983       g->next = g + 1;
 984       g->specific = 1;
 985       g++;
 986     }
 987
 988   g--;
 989   g->next = NULL;
 990 }
 991
 992
 993 /* Create a duplicate intrinsic function entry for the current
 994    function, the only differences being the alternate name and
 995    a different standard if necessary. Note that we use argument
 996    lists more than once, but all argument lists are freed as a
 997    single block.  */
 998
 999 static void
1000 make_alias (const char *name, int standard)
1001 {
1002   switch (sizing)
1003     {
1004     case SZ_FUNCS:
1005       nfunc++;
1006       break;
1007
1008     case SZ_SUBS:
1009       nsub++;
1010       break;
1011
1012     case SZ_NOTHING:
1013       next_sym[0] = next_sym[-1];
1014       next_sym->name = gfc_get_string (name);
1015       next_sym->standard = standard;
1016       next_sym++;
1017       break;
1018
1019     default:
1020       break;
1021     }
1022 }
1023
1024
1025 /* Make the current subroutine noreturn.  */
1026
1027 static void
1028 make_noreturn (void)
1029 {
1030   if (sizing == SZ_NOTHING)
1031     next_sym[-1].noreturn = 1;
1032 }
1033
1034
1035 /* Mark current intrinsic as module intrinsic.  */
1036 static void
1037 make_from_module (void)
1038 {
1039   if (sizing == SZ_NOTHING)
1040     next_sym[-1].from_module = 1;
1041 }
1042
1043 /* Set the attr.value of the current procedure.  */
1044
1045 static void
1046 set_attr_value (int n, ...)
1047 {
1048   gfc_intrinsic_arg *arg;
1049   va_list argp;
1050   int i;
1051
1052   if (sizing != SZ_NOTHING)
1053     return;
1054
1055   va_start (argp, n);
1056   arg = next_sym[-1].formal;
1057
1058   for (i = 0; i < n; i++)
1059     {
1060       gcc_assert (arg != NULL);
1061       arg->value = va_arg (argp, int);
1062       arg = arg->next;
1063     }
1064   va_end (argp);
1065 }
1066
1067
1068 /* Add intrinsic functions.  */
1069
1070 static void
1071 add_functions (void)
1072 {
1073   /* Argument names as in the standard (to be used as argument keywords).  */
1074   const char
1075     *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1076     *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1077     *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1078     *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1079     *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1080     *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1081     *p = "p", *ar = "array", *shp = "shape", *src = "source",
1082     *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1083     *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1084     *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1085     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1086     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1087     *num = "number", *tm = "time", *nm = "name", *md = "mode",
1088     *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
1089     *ca = "coarray", *sub = "sub";
1090
1091   int di, dr, dd, dl, dc, dz, ii;
1092
1093   di = gfc_default_integer_kind;
1094   dr = gfc_default_real_kind;
1095   dd = gfc_default_double_kind;
1096   dl = gfc_default_logical_kind;
1097   dc = gfc_default_character_kind;
1098   dz = gfc_default_complex_kind;
1099   ii = gfc_index_integer_kind;
1100
1101   add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1102              gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1103              a, BT_REAL, dr, REQUIRED);
1104
1105   add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1106              NULL, gfc_simplify_abs, gfc_resolve_abs,
1107              a, BT_INTEGER, di, REQUIRED);
1108
1109   add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1110              gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1111              a, BT_REAL, dd, REQUIRED);
1112
1113   add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1114              NULL, gfc_simplify_abs, gfc_resolve_abs,
1115              a, BT_COMPLEX, dz, REQUIRED);
1116
1117   add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1118              NULL, gfc_simplify_abs, gfc_resolve_abs,
1119              a, BT_COMPLEX, dd, REQUIRED);
1120
1121   make_alias ("cdabs", GFC_STD_GNU);
1122
1123   make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1124
1125   /* The checking function for ACCESS is called gfc_check_access_func
1126      because the name gfc_check_access is already used in module.c.  */
1127   add_sym_2 ("access", GFC_ISYM_ACCESS, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1128              di, GFC_STD_GNU, gfc_check_access_func, NULL, gfc_resolve_access,
1129              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1130
1131   make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1132
1133   add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1134              BT_CHARACTER, dc, GFC_STD_F95,
1135              gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1136              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1137
1138   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1139
1140   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1141              gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1142              x, BT_REAL, dr, REQUIRED);
1143
1144   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1145              gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1146              x, BT_REAL, dd, REQUIRED);
1147
1148   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1149
1150   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1151              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1152              gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1153
1154   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1155              gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1156              x, BT_REAL, dd, REQUIRED);
1157
1158   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1159
1160   add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1161              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1162              gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1163
1164   make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1165
1166   add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1167              BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1168              gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1169
1170   make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1171
1172   add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1173              gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1174              z, BT_COMPLEX, dz, REQUIRED);
1175
1176   make_alias ("imag", GFC_STD_GNU);
1177   make_alias ("imagpart", GFC_STD_GNU);
1178
1179   add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1180              NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1181              z, BT_COMPLEX, dd, REQUIRED);
1182
1183   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1184
1185   add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1186              gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1187              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1188
1189   add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1190              NULL, gfc_simplify_dint, gfc_resolve_dint,
1191              a, BT_REAL, dd, REQUIRED);
1192
1193   make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1194
1195   add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1196              gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1197              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1198
1199   make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1200
1201   add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1202              gfc_check_allocated, NULL, NULL,
1203              ar, BT_UNKNOWN, 0, REQUIRED);
1204
1205   make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1206
1207   add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1208              gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1209              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1210
1211   add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1212              NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1213              a, BT_REAL, dd, REQUIRED);
1214
1215   make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1216
1217   add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1218              gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1219              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1220
1221   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1222
1223   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1224              gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1225              x, BT_REAL, dr, REQUIRED);
1226
1227   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1228              gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1229              x, BT_REAL, dd, REQUIRED);
1230
1231   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1232
1233   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1234              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1235              gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1236
1237   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1238              gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1239              x, BT_REAL, dd, REQUIRED);
1240
1241   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1242
1243   add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1244              GFC_STD_F95, gfc_check_associated, NULL, NULL,
1245              pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1246
1247   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1248
1249   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1250              gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1251              x, BT_REAL, dr, REQUIRED);
1252
1253   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1254              gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1255              x, BT_REAL, dd, REQUIRED);
1256
1257   /* Two-argument version of atan, equivalent to atan2.  */
1258   add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1259              gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1260              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1261
1262   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1263
1264   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1265              GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1266              gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1267
1268   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1269              gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1270              x, BT_REAL, dd, REQUIRED);
1271
1272   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1273
1274   add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1275              gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1276              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1277
1278   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1279              gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1280              y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1281
1282   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1283
1284   /* Bessel and Neumann functions for G77 compatibility.  */
1285   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1286              gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1287              x, BT_REAL, dr, REQUIRED);
1288
1289   make_alias ("bessel_j0", GFC_STD_F2008);
1290
1291   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1292              gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1293              x, BT_REAL, dd, REQUIRED);
1294
1295   make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1296
1297   add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1298              gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1299              x, BT_REAL, dr, REQUIRED);
1300
1301   make_alias ("bessel_j1", GFC_STD_F2008);
1302
1303   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1304              gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1305              x, BT_REAL, dd, REQUIRED);
1306
1307   make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1308
1309   add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1310              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1311              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1312
1313   make_alias ("bessel_jn", GFC_STD_F2008);
1314
1315   add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1316              gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1317              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1318
1319   add_sym_3 ("bessel_jn", GFC_ISYM_JN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1320              gfc_check_bessel_n2, gfc_simplify_bessel_jn2, gfc_resolve_bessel_n2,
1321              "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
1322              x, BT_REAL, dr, REQUIRED);
1323   set_attr_value (3, true, true, true);
1324
1325   make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1326
1327   add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1328              gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1329              x, BT_REAL, dr, REQUIRED);
1330
1331   make_alias ("bessel_y0", GFC_STD_F2008);
1332
1333   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1334              gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1335              x, BT_REAL, dd, REQUIRED);
1336
1337   make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1338
1339   add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1340              gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1341              x, BT_REAL, dr, REQUIRED);
1342
1343   make_alias ("bessel_y1", GFC_STD_F2008);
1344
1345   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1346              gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1347              x, BT_REAL, dd, REQUIRED);
1348
1349   make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1350
1351   add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1352              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1353              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1354
1355   make_alias ("bessel_yn", GFC_STD_F2008);
1356
1357   add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1358              gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1359              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1360
1361   add_sym_3 ("bessel_yn", GFC_ISYM_YN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1362              gfc_check_bessel_n2, gfc_simplify_bessel_yn2, gfc_resolve_bessel_n2,
1363              "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
1364               x, BT_REAL, dr, REQUIRED);
1365   set_attr_value (3, true, true, true);
1366
1367   make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1368
1369   add_sym_2 ("bge", GFC_ISYM_BGE, CLASS_ELEMENTAL, ACTUAL_NO,
1370              BT_LOGICAL, dl, GFC_STD_F2008,
1371              gfc_check_bge_bgt_ble_blt, gfc_simplify_bge, NULL,
1372              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1373
1374   make_generic ("bge", GFC_ISYM_BGE, GFC_STD_F2008);
1375
1376   add_sym_2 ("bgt", GFC_ISYM_BGT, CLASS_ELEMENTAL, ACTUAL_NO,
1377              BT_LOGICAL, dl, GFC_STD_F2008,
1378              gfc_check_bge_bgt_ble_blt, gfc_simplify_bgt, NULL,
1379              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1380
1381   make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
1382
1383   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1384              gfc_check_i, gfc_simplify_bit_size, NULL,
1385              i, BT_INTEGER, di, REQUIRED);
1386
1387   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1388
1389   add_sym_2 ("ble", GFC_ISYM_BLE, CLASS_ELEMENTAL, ACTUAL_NO,
1390              BT_LOGICAL, dl, GFC_STD_F2008,
1391              gfc_check_bge_bgt_ble_blt, gfc_simplify_ble, NULL,
1392              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1393
1394   make_generic ("ble", GFC_ISYM_BLE, GFC_STD_F2008);
1395
1396   add_sym_2 ("blt", GFC_ISYM_BLT, CLASS_ELEMENTAL, ACTUAL_NO,
1397              BT_LOGICAL, dl, GFC_STD_F2008,
1398              gfc_check_bge_bgt_ble_blt, gfc_simplify_blt, NULL,
1399              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1400
1401   make_generic ("blt", GFC_ISYM_BLT, GFC_STD_F2008);
1402
1403   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1404              gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
1405              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1406
1407   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1408
1409   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1410              gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1411              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1412
1413   make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1414
1415   add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1416              gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1417              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1418
1419   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1420
1421   add_sym_1 ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
1422              GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1423              nm, BT_CHARACTER, dc, REQUIRED);
1424
1425   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1426
1427   add_sym_2 ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1428              di, GFC_STD_GNU, gfc_check_chmod, NULL, gfc_resolve_chmod,
1429              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1430
1431   make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1432
1433   add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1434              gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1435              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1436              kind, BT_INTEGER, di, OPTIONAL);
1437
1438   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1439
1440   add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1441              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1442
1443   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1444                 GFC_STD_F2003);
1445
1446   add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1447              gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1448              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1449
1450   make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1451
1452   /* Making dcmplx a specific of cmplx causes cmplx to return a double
1453      complex instead of the default complex.  */
1454
1455   add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1456              gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1457              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1458
1459   make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1460
1461   add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1462              gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1463              z, BT_COMPLEX, dz, REQUIRED);
1464
1465   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1466              NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1467              z, BT_COMPLEX, dd, REQUIRED);
1468
1469   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1470
1471   add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1472              gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1473              x, BT_REAL, dr, REQUIRED);
1474
1475   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1476              gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1477              x, BT_REAL, dd, REQUIRED);
1478
1479   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1480              NULL, gfc_simplify_cos, gfc_resolve_cos,
1481              x, BT_COMPLEX, dz, REQUIRED);
1482
1483   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1484              NULL, gfc_simplify_cos, gfc_resolve_cos,
1485              x, BT_COMPLEX, dd, REQUIRED);
1486
1487   make_alias ("cdcos", GFC_STD_GNU);
1488
1489   make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1490
1491   add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1492              gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1493              x, BT_REAL, dr, REQUIRED);
1494
1495   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1496              gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1497              x, BT_REAL, dd, REQUIRED);
1498
1499   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1500
1501   add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1502              BT_INTEGER, di, GFC_STD_F95,
1503              gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1504              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1505              kind, BT_INTEGER, di, OPTIONAL);
1506
1507   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1508
1509   add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1510              gfc_check_cshift, NULL, gfc_resolve_cshift,
1511              ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1512              dm, BT_INTEGER, ii, OPTIONAL);
1513
1514   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1515
1516   add_sym_1 ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
1517              0, GFC_STD_GNU, gfc_check_ctime, NULL, gfc_resolve_ctime,
1518              tm, BT_INTEGER, di, REQUIRED);
1519
1520   make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1521
1522   add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1523              gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1524              a, BT_REAL, dr, REQUIRED);
1525
1526   make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1527
1528   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1529              gfc_check_digits, gfc_simplify_digits, NULL,
1530              x, BT_UNKNOWN, dr, REQUIRED);
1531
1532   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1533
1534   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1535              gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1536              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1537
1538   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1539              NULL, gfc_simplify_dim, gfc_resolve_dim,
1540              x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1541
1542   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1543              gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1544              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1545
1546   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1547
1548   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1549              GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1550              va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1551
1552   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1553
1554   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1555              gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1556              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1557
1558   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1559
1560   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1561              NULL, NULL, NULL,
1562              a, BT_COMPLEX, dd, REQUIRED);
1563
1564   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1565
1566   add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
1567              BT_INTEGER, di, GFC_STD_F2008,
1568              gfc_check_dshift, gfc_simplify_dshiftl, gfc_resolve_dshift,
1569              i, BT_INTEGER, di, REQUIRED,
1570              j, BT_INTEGER, di, REQUIRED,
1571              sh, BT_INTEGER, di, REQUIRED);
1572
1573   make_generic ("dshiftl", GFC_ISYM_DSHIFTL, GFC_STD_F2008);
1574
1575   add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
1576              BT_INTEGER, di, GFC_STD_F2008,
1577              gfc_check_dshift, gfc_simplify_dshiftr, gfc_resolve_dshift,
1578              i, BT_INTEGER, di, REQUIRED,
1579              j, BT_INTEGER, di, REQUIRED,
1580              sh, BT_INTEGER, di, REQUIRED);
1581
1582   make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
1583
1584   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1585              gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1586              ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
1587              bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
1588
1589   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1590
1591   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1592              gfc_check_x, gfc_simplify_epsilon, NULL,
1593              x, BT_REAL, dr, REQUIRED);
1594
1595   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1596
1597   /* G77 compatibility for the ERF() and ERFC() functions.  */
1598   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1599              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1600              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1601
1602   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1603              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1604              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1605
1606   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1607
1608   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1609              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1610              gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1611
1612   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1613              GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1614              gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1615
1616   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1617
1618   add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1619              BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1620              gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1621              dr, REQUIRED);
1622
1623   make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1624
1625   /* G77 compatibility */
1626   add_sym_1 ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
1627              4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
1628              x, BT_REAL, 4, REQUIRED);
1629
1630   make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1631
1632   add_sym_1 ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
1633              4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
1634              x, BT_REAL, 4, REQUIRED);
1635
1636   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1637
1638   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
1639              gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1640              x, BT_REAL, dr, REQUIRED);
1641
1642   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1643              gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1644              x, BT_REAL, dd, REQUIRED);
1645
1646   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1647              NULL, gfc_simplify_exp, gfc_resolve_exp,
1648              x, BT_COMPLEX, dz, REQUIRED);
1649
1650   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1651              NULL, gfc_simplify_exp, gfc_resolve_exp,
1652              x, BT_COMPLEX, dd, REQUIRED);
1653
1654   make_alias ("cdexp", GFC_STD_GNU);
1655
1656   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1657
1658   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1659              gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1660              x, BT_REAL, dr, REQUIRED);
1661
1662   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1663
1664   add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1665              ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1666              gfc_check_same_type_as, gfc_simplify_extends_type_of,
1667              gfc_resolve_extends_type_of,
1668              a, BT_UNKNOWN, 0, REQUIRED,
1669              mo, BT_UNKNOWN, 0, REQUIRED);
1670
1671   add_sym_0 ("fdate",  GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
1672              dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
1673
1674   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1675
1676   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1677              gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1678              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1679
1680   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1681
1682   /* G77 compatible fnum */
1683   add_sym_1 ("fnum", GFC_ISYM_FNUM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1684              di, GFC_STD_GNU, gfc_check_fnum, NULL, gfc_resolve_fnum,
1685              ut, BT_INTEGER, di, REQUIRED);
1686
1687   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1688
1689   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1690              gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1691              x, BT_REAL, dr, REQUIRED);
1692
1693   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1694
1695   add_sym_2_intent ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, ACTUAL_NO,
1696                     BT_INTEGER, di, GFC_STD_GNU,
1697                     gfc_check_fstat, NULL, gfc_resolve_fstat,
1698                     ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
1699                     vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
1700
1701   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1702
1703   add_sym_1 ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1704              ii, GFC_STD_GNU, gfc_check_ftell, NULL, gfc_resolve_ftell,
1705              ut, BT_INTEGER, di, REQUIRED);
1706
1707   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1708
1709   add_sym_2_intent ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, ACTUAL_NO,
1710                     BT_INTEGER, di, GFC_STD_GNU,
1711                     gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1712                     ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
1713                     c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
1714
1715   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1716
1717   add_sym_1_intent ("fget", GFC_ISYM_FGET, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1718              di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fget,
1719              c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
1720
1721   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1722
1723   add_sym_2 ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1724              di, GFC_STD_GNU, gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1725              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1726
1727   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1728
1729   add_sym_1 ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1730              di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fput,
1731              c, BT_CHARACTER, dc, REQUIRED);
1732
1733   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1734
1735   add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1736              GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1737              gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1738
1739   add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1740              gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1741              x, BT_REAL, dr, REQUIRED);
1742
1743   make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1744
1745   /* Unix IDs (g77 compatibility)  */
1746   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1747              di,  GFC_STD_GNU, NULL, NULL, gfc_resolve_getcwd,
1748              c, BT_CHARACTER, dc, REQUIRED);
1749
1750   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1751
1752   add_sym_0 ("getgid", GFC_ISYM_GETGID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1753              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getgid);
1754
1755   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1756
1757   add_sym_0 ("getpid", GFC_ISYM_GETPID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1758              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getpid);
1759
1760   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1761
1762   add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1763              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
1764
1765   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1766
1767   add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, ACTUAL_NO,
1768                     BT_INTEGER, di, GFC_STD_GNU,
1769                     gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1770                     c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
1771
1772   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1773
1774   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1775              gfc_check_huge, gfc_simplify_huge, NULL,
1776              x, BT_UNKNOWN, dr, REQUIRED);
1777
1778   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1779
1780   add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1781              BT_REAL, dr, GFC_STD_F2008,
1782              gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1783              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1784
1785   make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1786
1787   add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1788              BT_INTEGER, di, GFC_STD_F95,
1789              gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1790              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1791
1792   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1793
1794   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1795              gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1796              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1797
1798   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1799
1800   add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1801              dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1802              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1803
1804   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1805
1806   add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1807                 gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
1808                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1809                 msk, BT_LOGICAL, dl, OPTIONAL);
1810
1811   make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
1812
1813   add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1814                 gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
1815                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1816                 msk, BT_LOGICAL, dl, OPTIONAL);
1817
1818   make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
1819
1820   add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1821              di, GFC_STD_GNU, NULL, NULL, NULL);
1822
1823   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1824
1825   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1826              gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1827              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1828
1829   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1830
1831   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1832              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1833              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1834              ln, BT_INTEGER, di, REQUIRED);
1835
1836   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1837
1838   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1839              gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1840              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1841
1842   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1843
1844   add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1845              BT_INTEGER, di, GFC_STD_F77,
1846              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1847              c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1848
1849   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1850
1851   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1852              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1853              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1854
1855   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1856
1857   add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1858              dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1859              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1860
1861   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1862
1863   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1864              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
1865
1866   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1867
1868   add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1869              gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
1870              ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1871
1872   /* The resolution function for INDEX is called gfc_resolve_index_func
1873      because the name gfc_resolve_index is already used in resolve.c.  */
1874   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1875              BT_INTEGER, di, GFC_STD_F77,
1876              gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1877              stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1878              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1879
1880   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1881
1882   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1883              gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1884              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1885
1886   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1887              NULL, gfc_simplify_ifix, NULL,
1888              a, BT_REAL, dr, REQUIRED);
1889
1890   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1891              NULL, gfc_simplify_idint, NULL,
1892              a, BT_REAL, dd, REQUIRED);
1893
1894   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1895
1896   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1897              gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1898              a, BT_REAL, dr, REQUIRED);
1899
1900   make_alias ("short", GFC_STD_GNU);
1901
1902   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1903
1904   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1905              gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1906              a, BT_REAL, dr, REQUIRED);
1907
1908   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1909
1910   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1911              gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1912              a, BT_REAL, dr, REQUIRED);
1913
1914   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1915
1916   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1917              gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1918              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1919
1920   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1921
1922   add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1923              dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1924              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1925
1926   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1927
1928   add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
1929                 gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
1930                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1931                 msk, BT_LOGICAL, dl, OPTIONAL);
1932
1933   make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
1934
1935   /* The following function is for G77 compatibility.  */
1936   add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1937              4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
1938              i, BT_INTEGER, 4, OPTIONAL);
1939
1940   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1941
1942   add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
1943              dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
1944              ut, BT_INTEGER, di, REQUIRED);
1945
1946   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1947
1948   add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1949              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1950              gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1951              i, BT_INTEGER, 0, REQUIRED);
1952
1953   make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1954
1955   add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1956              CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1957              gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1958              i, BT_INTEGER, 0, REQUIRED);
1959
1960   make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1961
1962   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1963              BT_LOGICAL, dl, GFC_STD_GNU,
1964              gfc_check_isnan, gfc_simplify_isnan, NULL,
1965              x, BT_REAL, 0, REQUIRED);
1966
1967   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1968
1969   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
1970              BT_INTEGER, di, GFC_STD_GNU,
1971              gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
1972              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1973
1974   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1975
1976   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
1977              BT_INTEGER, di, GFC_STD_GNU,
1978              gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
1979              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1980
1981   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1982
1983   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1984              gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1985              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1986
1987   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1988
1989   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1990              gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1991              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1992              sz, BT_INTEGER, di, OPTIONAL);
1993
1994   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1995
1996   add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1997              di, GFC_STD_GNU, gfc_check_kill, NULL, gfc_resolve_kill,
1998              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1999
2000   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
2001
2002   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2003              gfc_check_kind, gfc_simplify_kind, NULL,
2004              x, BT_REAL, dr, REQUIRED);
2005
2006   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
2007
2008   add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
2009              BT_INTEGER, di, GFC_STD_F95,
2010              gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
2011              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
2012              kind, BT_INTEGER, di, OPTIONAL);
2013
2014   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
2015
2016   add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2017              BT_INTEGER, di, GFC_STD_F2008,
2018              gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
2019              ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2020              kind, BT_INTEGER, di, OPTIONAL);
2021
2022   make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
2023
2024   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
2025              BT_INTEGER, di, GFC_STD_F2008,
2026              gfc_check_i, gfc_simplify_leadz, NULL,
2027              i, BT_INTEGER, di, REQUIRED);
2028
2029   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
2030
2031   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
2032              BT_INTEGER, di, GFC_STD_F77,
2033              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
2034              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2035
2036   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
2037
2038   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
2039              BT_INTEGER, di, GFC_STD_F95,
2040              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
2041              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2042
2043   make_alias ("lnblnk", GFC_STD_GNU);
2044
2045   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
2046
2047   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
2048              dr, GFC_STD_GNU,
2049              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2050              x, BT_REAL, dr, REQUIRED);
2051
2052   make_alias ("log_gamma", GFC_STD_F2008);
2053
2054   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2055              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2056              x, BT_REAL, dr, REQUIRED);
2057
2058   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2059              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
2060              x, BT_REAL, dr, REQUIRED);
2061
2062   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
2063
2064
2065   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2066              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
2067              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2068
2069   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
2070
2071   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2072              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
2073              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2074
2075   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
2076
2077   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2078              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
2079              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2080
2081   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
2082
2083   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2084              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
2085              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
2086
2087   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
2088
2089   add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2090              GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
2091              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2092
2093   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2094
2095   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2096              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2097              x, BT_REAL, dr, REQUIRED);
2098
2099   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2100              NULL, gfc_simplify_log, gfc_resolve_log,
2101              x, BT_REAL, dr, REQUIRED);
2102
2103   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2104              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2105              x, BT_REAL, dd, REQUIRED);
2106
2107   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2108              NULL, gfc_simplify_log, gfc_resolve_log,
2109              x, BT_COMPLEX, dz, REQUIRED);
2110
2111   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
2112              NULL, gfc_simplify_log, gfc_resolve_log,
2113              x, BT_COMPLEX, dd, REQUIRED);
2114
2115   make_alias ("cdlog", GFC_STD_GNU);
2116
2117   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2118
2119   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2120              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2121              x, BT_REAL, dr, REQUIRED);
2122
2123   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2124              NULL, gfc_simplify_log10, gfc_resolve_log10,
2125              x, BT_REAL, dr, REQUIRED);
2126
2127   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2128              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2129              x, BT_REAL, dd, REQUIRED);
2130
2131   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2132
2133   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2134              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2135              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2136
2137   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2138
2139   add_sym_2_intent ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO,
2140                     BT_INTEGER, di, GFC_STD_GNU,
2141                     gfc_check_stat, NULL, gfc_resolve_lstat,
2142                     nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2143                     vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
2144
2145   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2146
2147   add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2148              GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2149              sz, BT_INTEGER, di, REQUIRED);
2150
2151   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2152
2153   add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
2154              BT_INTEGER, di, GFC_STD_F2008,
2155              gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
2156              i, BT_INTEGER, di, REQUIRED,
2157              kind, BT_INTEGER, di, OPTIONAL);
2158
2159   make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
2160
2161   add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
2162              BT_INTEGER, di, GFC_STD_F2008,
2163              gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
2164              i, BT_INTEGER, di, REQUIRED,
2165              kind, BT_INTEGER, di, OPTIONAL);
2166
2167   make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
2168
2169   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2170              gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2171              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2172
2173   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2174
2175   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2176      int(max).  The max function must take at least two arguments.  */
2177
2178   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2179              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2180              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2181
2182   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2183              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2184              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2185
2186   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2187              gfc_check_min_max_integer, gfc_simplify_max, NULL,
2188              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2189
2190   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2191              gfc_check_min_max_real, gfc_simplify_max, NULL,
2192              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2193
2194   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2195              gfc_check_min_max_real, gfc_simplify_max, NULL,
2196              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2197
2198   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2199              gfc_check_min_max_double, gfc_simplify_max, NULL,
2200              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2201
2202   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2203
2204   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2205              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2206              x, BT_UNKNOWN, dr, REQUIRED);
2207
2208   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2209
2210   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2211                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2212                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2213                msk, BT_LOGICAL, dl, OPTIONAL);
2214
2215   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2216
2217   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2218                 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2219                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2220                 msk, BT_LOGICAL, dl, OPTIONAL);
2221
2222   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2223
2224   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2225              GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2226
2227   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2228
2229   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2230              di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2231
2232   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2233
2234   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2235              gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2236              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2237              msk, BT_LOGICAL, dl, REQUIRED);
2238
2239   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2240
2241   add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
2242              BT_INTEGER, di, GFC_STD_F2008,
2243              gfc_check_merge_bits, gfc_simplify_merge_bits,
2244              gfc_resolve_merge_bits,
2245              i, BT_INTEGER, di, REQUIRED,
2246              j, BT_INTEGER, di, REQUIRED,
2247              msk, BT_INTEGER, di, REQUIRED);
2248
2249   make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
2250
2251   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2252      int(min).  */
2253
2254   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2255               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2256               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2257
2258   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2259               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2260               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2261
2262   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2263               gfc_check_min_max_integer, gfc_simplify_min, NULL,
2264               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2265
2266   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2267               gfc_check_min_max_real, gfc_simplify_min, NULL,
2268               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2269
2270   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2271               gfc_check_min_max_real, gfc_simplify_min, NULL,
2272               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2273
2274   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2275               gfc_check_min_max_double, gfc_simplify_min, NULL,
2276               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2277
2278   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2279
2280   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2281              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2282              x, BT_UNKNOWN, dr, REQUIRED);
2283
2284   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2285
2286   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2287                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2288                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2289                msk, BT_LOGICAL, dl, OPTIONAL);
2290
2291   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2292
2293   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2294                 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2295                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2296                 msk, BT_LOGICAL, dl, OPTIONAL);
2297
2298   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2299
2300   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2301              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2302              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2303
2304   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2305              NULL, gfc_simplify_mod, gfc_resolve_mod,
2306              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2307
2308   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2309              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2310              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2311
2312   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2313
2314   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2315              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2316              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2317
2318   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2319
2320   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2321              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2322              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2323
2324   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2325
2326   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2327              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2328              a, BT_CHARACTER, dc, REQUIRED);
2329
2330   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2331
2332   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2333              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2334              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2335
2336   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2337              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2338              a, BT_REAL, dd, REQUIRED);
2339
2340   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2341
2342   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2343              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2344              i, BT_INTEGER, di, REQUIRED);
2345
2346   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2347
2348   add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
2349              GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
2350              x, BT_REAL, dr, REQUIRED,
2351              dm, BT_INTEGER, ii, OPTIONAL);
2352
2353   make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
2354
2355   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2356              gfc_check_null, gfc_simplify_null, NULL,
2357              mo, BT_INTEGER, di, OPTIONAL);
2358
2359   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2360
2361   add_sym_0 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_INQUIRY, ACTUAL_NO,
2362              BT_INTEGER, di, GFC_STD_F2008,
2363              NULL, gfc_simplify_num_images, NULL);
2364
2365   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2366              gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2367              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2368              v, BT_REAL, dr, OPTIONAL);
2369
2370   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2371
2372
2373   add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
2374              GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
2375              msk, BT_LOGICAL, dl, REQUIRED,
2376              dm, BT_INTEGER, ii, OPTIONAL);
2377
2378   make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
2379
2380   add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
2381              BT_INTEGER, di, GFC_STD_F2008,
2382              gfc_check_i, gfc_simplify_popcnt, NULL,
2383              i, BT_INTEGER, di, REQUIRED);
2384
2385   make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
2386
2387   add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
2388              BT_INTEGER, di, GFC_STD_F2008,
2389              gfc_check_i, gfc_simplify_poppar, NULL,
2390              i, BT_INTEGER, di, REQUIRED);
2391
2392   make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
2393
2394   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2395              gfc_check_precision, gfc_simplify_precision, NULL,
2396              x, BT_UNKNOWN, 0, REQUIRED);
2397
2398   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2399
2400   add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2401                     BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2402                     a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2403
2404   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2405
2406   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2407                 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2408                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2409                 msk, BT_LOGICAL, dl, OPTIONAL);
2410
2411   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2412
2413   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2414              gfc_check_radix, gfc_simplify_radix, NULL,
2415              x, BT_UNKNOWN, 0, REQUIRED);
2416
2417   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2418
2419   /* The following function is for G77 compatibility.  */
2420   add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2421              4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
2422              i, BT_INTEGER, 4, OPTIONAL);
2423
2424   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2425      use slightly different shoddy multiplicative congruential PRNG.  */
2426   make_alias ("ran", GFC_STD_GNU);
2427
2428   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2429
2430   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2431              gfc_check_range, gfc_simplify_range, NULL,
2432              x, BT_REAL, dr, REQUIRED);
2433
2434   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2435
2436   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2437              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2438              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2439
2440   /* This provides compatibility with g77.  */
2441   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2442              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2443              a, BT_UNKNOWN, dr, REQUIRED);
2444
2445   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2446              gfc_check_float, gfc_simplify_float, NULL,
2447              a, BT_INTEGER, di, REQUIRED);
2448
2449   add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2450              gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2451              a, BT_REAL, dr, REQUIRED);
2452
2453   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2454              gfc_check_sngl, gfc_simplify_sngl, NULL,
2455              a, BT_REAL, dd, REQUIRED);
2456
2457   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2458
2459   add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2460              GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2461              p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2462
2463   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2464
2465   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2466              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2467              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2468
2469   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2470
2471   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2472              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2473              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2474              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2475
2476   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2477
2478   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2479              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2480              x, BT_REAL, dr, REQUIRED);
2481
2482   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2483
2484   add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2485              BT_LOGICAL, dl, GFC_STD_F2003,
2486              gfc_check_same_type_as, gfc_simplify_same_type_as, NULL,
2487              a, BT_UNKNOWN, 0, REQUIRED,
2488              b, BT_UNKNOWN, 0, REQUIRED);
2489
2490   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2491              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2492              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2493
2494   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2495
2496   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2497              BT_INTEGER, di, GFC_STD_F95,
2498              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2499              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2500              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2501
2502   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2503
2504   /* Added for G77 compatibility garbage.  */
2505   add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2506              4, GFC_STD_GNU, NULL, NULL, NULL);
2507
2508   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2509
2510   /* Added for G77 compatibility.  */
2511   add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2512              dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
2513              x, BT_REAL, dr, REQUIRED);
2514
2515   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2516
2517   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2518              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2519              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2520              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2521
2522   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2523
2524   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2525              GFC_STD_F95, gfc_check_selected_int_kind,
2526              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2527
2528   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2529
2530   add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2531              GFC_STD_F95, gfc_check_selected_real_kind,
2532              gfc_simplify_selected_real_kind, NULL,
2533              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2534              "radix", BT_INTEGER, di, OPTIONAL);
2535
2536   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2537
2538   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2539              gfc_check_set_exponent, gfc_simplify_set_exponent,
2540              gfc_resolve_set_exponent,
2541              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2542
2543   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2544
2545   add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2546              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2547              src, BT_REAL, dr, REQUIRED,
2548              kind, BT_INTEGER, di, OPTIONAL);
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   nargs = nfunc = nsub = nconv = 0;
3374
3375   /* Create a namespace to hold the resolved intrinsic symbols.  */
3376   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3377
3378   sizing = SZ_FUNCS;
3379   add_functions ();
3380   sizing = SZ_SUBS;
3381   add_subroutines ();
3382   sizing = SZ_CONVS;
3383   add_conversions ();
3384
3385   functions = XCNEWVAR (struct gfc_intrinsic_sym,
3386                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3387                         + sizeof (gfc_intrinsic_arg) * nargs);
3388
3389   next_sym = functions;
3390   subroutines = functions + nfunc;
3391
3392   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3393
3394   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3395
3396   sizing = SZ_NOTHING;
3397   nconv = 0;
3398
3399   add_functions ();
3400   add_subroutines ();
3401   add_conversions ();
3402
3403   /* Character conversion intrinsics need to be treated separately.  */
3404   add_char_conversions ();
3405 }
3406
3407
3408 void
3409 gfc_intrinsic_done_1 (void)
3410 {
3411   gfc_free (functions);
3412   gfc_free (conversion);
3413   gfc_free (char_conversions);
3414   gfc_free_namespace (gfc_intrinsic_namespace);
3415 }
3416
3417
3418 /******** Subroutines to check intrinsic interfaces ***********/
3419
3420 /* Given a formal argument list, remove any NULL arguments that may
3421    have been left behind by a sort against some formal argument list.  */
3422
3423 static void
3424 remove_nullargs (gfc_actual_arglist **ap)
3425 {
3426   gfc_actual_arglist *head, *tail, *next;
3427
3428   tail = NULL;
3429
3430   for (head = *ap; head; head = next)
3431     {
3432       next = head->next;
3433
3434       if (head->expr == NULL && !head->label)
3435         {
3436           head->next = NULL;
3437           gfc_free_actual_arglist (head);
3438         }
3439       else
3440         {
3441           if (tail == NULL)
3442             *ap = head;
3443           else
3444             tail->next = head;
3445
3446           tail = head;
3447           tail->next = NULL;
3448         }
3449     }
3450
3451   if (tail == NULL)
3452     *ap = NULL;
3453 }
3454
3455
3456 /* Given an actual arglist and a formal arglist, sort the actual
3457    arglist so that its arguments are in a one-to-one correspondence
3458    with the format arglist.  Arguments that are not present are given
3459    a blank gfc_actual_arglist structure.  If something is obviously
3460    wrong (say, a missing required argument) we abort sorting and
3461    return FAILURE.  */
3462
3463 static gfc_try
3464 sort_actual (const char *name, gfc_actual_arglist **ap,
3465              gfc_intrinsic_arg *formal, locus *where)
3466 {
3467   gfc_actual_arglist *actual, *a;
3468   gfc_intrinsic_arg *f;
3469
3470   remove_nullargs (ap);
3471   actual = *ap;
3472
3473   for (f = formal; f; f = f->next)
3474     f->actual = NULL;
3475
3476   f = formal;
3477   a = actual;
3478
3479   if (f == NULL && a == NULL)   /* No arguments */
3480     return SUCCESS;
3481
3482   for (;;)
3483     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3484       if (f == NULL)
3485         break;
3486       if (a == NULL)
3487         goto optional;
3488
3489       if (a->name != NULL)
3490         goto keywords;
3491
3492       f->actual = a;
3493
3494       f = f->next;
3495       a = a->next;
3496     }
3497
3498   if (a == NULL)
3499     goto do_sort;
3500
3501   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3502   return FAILURE;
3503
3504 keywords:
3505   /* Associate the remaining actual arguments, all of which have
3506      to be keyword arguments.  */
3507   for (; a; a = a->next)
3508     {
3509       for (f = formal; f; f = f->next)
3510         if (strcmp (a->name, f->name) == 0)
3511           break;
3512
3513       if (f == NULL)
3514         {
3515           if (a->name[0] == '%')
3516             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3517                        "are not allowed in this context at %L", where);
3518           else
3519             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3520                        a->name, name, where);
3521           return FAILURE;
3522         }
3523
3524       if (f->actual != NULL)
3525         {
3526           gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3527                      f->name, name, where);
3528           return FAILURE;
3529         }
3530
3531       f->actual = a;
3532     }
3533
3534 optional:
3535   /* At this point, all unmatched formal args must be optional.  */
3536   for (f = formal; f; f = f->next)
3537     {
3538       if (f->actual == NULL && f->optional == 0)
3539         {
3540           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3541                      f->name, name, where);
3542           return FAILURE;
3543         }
3544     }
3545
3546 do_sort:
3547   /* Using the formal argument list, string the actual argument list
3548      together in a way that corresponds with the formal list.  */
3549   actual = NULL;
3550
3551   for (f = formal; f; f = f->next)
3552     {
3553       if (f->actual && f->actual->label != NULL && f->ts.type)
3554         {
3555           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3556           return FAILURE;
3557         }
3558
3559       if (f->actual == NULL)
3560         {
3561           a = gfc_get_actual_arglist ();
3562           a->missing_arg_type = f->ts.type;
3563         }
3564       else
3565         a = f->actual;
3566
3567       if (actual == NULL)
3568         *ap = a;
3569       else
3570         actual->next = a;
3571
3572       actual = a;
3573     }
3574   actual->next = NULL;          /* End the sorted argument list.  */
3575
3576   return SUCCESS;
3577 }
3578
3579
3580 /* Compare an actual argument list with an intrinsic's formal argument
3581    list.  The lists are checked for agreement of type.  We don't check
3582    for arrayness here.  */
3583
3584 static gfc_try
3585 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3586                int error_flag)
3587 {
3588   gfc_actual_arglist *actual;
3589   gfc_intrinsic_arg *formal;
3590   int i;
3591
3592   formal = sym->formal;
3593   actual = *ap;
3594
3595   i = 0;
3596   for (; formal; formal = formal->next, actual = actual->next, i++)
3597     {
3598       gfc_typespec ts;
3599
3600       if (actual->expr == NULL)
3601         continue;
3602
3603       ts = formal->ts;
3604
3605       /* A kind of 0 means we don't check for kind.  */
3606       if (ts.kind == 0)
3607         ts.kind = actual->expr->ts.kind;
3608
3609       if (!gfc_compare_types (&ts, &actual->expr->ts))
3610         {
3611           if (error_flag)
3612             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3613                        "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
3614                        gfc_current_intrinsic, &actual->expr->where,
3615                        gfc_typename (&formal->ts),
3616                        gfc_typename (&actual->expr->ts));
3617           return FAILURE;
3618         }
3619
3620       /* If the formal argument is INTENT([IN]OUT), check for definability.  */
3621       if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
3622         {
3623           const char* context = (error_flag
3624                                  ? _("actual argument to INTENT = OUT/INOUT")
3625                                  : NULL);
3626
3627           /* No pointer arguments for intrinsics.  */
3628           if (gfc_check_vardef_context (actual->expr, false, context)
3629                 == FAILURE)
3630             return FAILURE;
3631         }
3632     }
3633
3634   return SUCCESS;
3635 }
3636
3637
3638 /* Given a pointer to an intrinsic symbol and an expression node that
3639    represent the function call to that subroutine, figure out the type
3640    of the result.  This may involve calling a resolution subroutine.  */
3641
3642 static void
3643 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3644 {
3645   gfc_expr *a1, *a2, *a3, *a4, *a5;
3646   gfc_actual_arglist *arg;
3647
3648   if (specific->resolve.f1 == NULL)
3649     {
3650       if (e->value.function.name == NULL)
3651         e->value.function.name = specific->lib_name;
3652
3653       if (e->ts.type == BT_UNKNOWN)
3654         e->ts = specific->ts;
3655       return;
3656     }
3657
3658   arg = e->value.function.actual;
3659
3660   /* Special case hacks for MIN and MAX.  */
3661   if (specific->resolve.f1m == gfc_resolve_max
3662       || specific->resolve.f1m == gfc_resolve_min)
3663     {
3664       (*specific->resolve.f1m) (e, arg);
3665       return;
3666     }
3667
3668   if (arg == NULL)
3669     {
3670       (*specific->resolve.f0) (e);
3671       return;
3672     }
3673
3674   a1 = arg->expr;
3675   arg = arg->next;
3676
3677   if (arg == NULL)
3678     {
3679       (*specific->resolve.f1) (e, a1);
3680       return;
3681     }
3682
3683   a2 = arg->expr;
3684   arg = arg->next;
3685
3686   if (arg == NULL)
3687     {
3688       (*specific->resolve.f2) (e, a1, a2);
3689       return;
3690     }
3691
3692   a3 = arg->expr;
3693   arg = arg->next;
3694
3695   if (arg == NULL)
3696     {
3697       (*specific->resolve.f3) (e, a1, a2, a3);
3698       return;
3699     }
3700
3701   a4 = arg->expr;
3702   arg = arg->next;
3703
3704   if (arg == NULL)
3705     {
3706       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3707       return;
3708     }
3709
3710   a5 = arg->expr;
3711   arg = arg->next;
3712
3713   if (arg == NULL)
3714     {
3715       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3716       return;
3717     }
3718
3719   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3720 }
3721
3722
3723 /* Given an intrinsic symbol node and an expression node, call the
3724    simplification function (if there is one), perhaps replacing the
3725    expression with something simpler.  We return FAILURE on an error
3726    of the simplification, SUCCESS if the simplification worked, even
3727    if nothing has changed in the expression itself.  */
3728
3729 static gfc_try
3730 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3731 {
3732   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3733   gfc_actual_arglist *arg;
3734
3735   /* Max and min require special handling due to the variable number
3736      of args.  */
3737   if (specific->simplify.f1 == gfc_simplify_min)
3738     {
3739       result = gfc_simplify_min (e);
3740       goto finish;
3741     }
3742
3743   if (specific->simplify.f1 == gfc_simplify_max)
3744     {
3745       result = gfc_simplify_max (e);
3746       goto finish;
3747     }
3748
3749   if (specific->simplify.f1 == NULL)
3750     {
3751       result = NULL;
3752       goto finish;
3753     }
3754
3755   arg = e->value.function.actual;
3756
3757   if (arg == NULL)
3758     {
3759       result = (*specific->simplify.f0) ();
3760       goto finish;
3761     }
3762
3763   a1 = arg->expr;
3764   arg = arg->next;
3765
3766   if (specific->simplify.cc == gfc_convert_constant
3767       || specific->simplify.cc == gfc_convert_char_constant)
3768     {
3769       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3770       goto finish;
3771     }
3772
3773   if (arg == NULL)
3774     result = (*specific->simplify.f1) (a1);
3775   else
3776     {
3777       a2 = arg->expr;
3778       arg = arg->next;
3779
3780       if (arg == NULL)
3781         result = (*specific->simplify.f2) (a1, a2);
3782       else
3783         {
3784           a3 = arg->expr;
3785           arg = arg->next;
3786
3787           if (arg == NULL)
3788             result = (*specific->simplify.f3) (a1, a2, a3);
3789           else
3790             {
3791               a4 = arg->expr;
3792               arg = arg->next;
3793
3794               if (arg == NULL)
3795                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3796               else
3797                 {
3798                   a5 = arg->expr;
3799                   arg = arg->next;
3800
3801                   if (arg == NULL)
3802                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3803                   else
3804                     gfc_internal_error
3805                       ("do_simplify(): Too many args for intrinsic");
3806                 }
3807             }
3808         }
3809     }
3810
3811 finish:
3812   if (result == &gfc_bad_expr)
3813     return FAILURE;
3814
3815   if (result == NULL)
3816     resolve_intrinsic (specific, e);    /* Must call at run-time */
3817   else
3818     {
3819       result->where = e->where;
3820       gfc_replace_expr (e, result);
3821     }
3822
3823   return SUCCESS;
3824 }
3825
3826
3827 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3828    error messages.  This subroutine returns FAILURE if a subroutine
3829    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3830    list cannot match any intrinsic.  */
3831
3832 static void
3833 init_arglist (gfc_intrinsic_sym *isym)
3834 {
3835   gfc_intrinsic_arg *formal;
3836   int i;
3837
3838   gfc_current_intrinsic = isym->name;
3839
3840   i = 0;
3841   for (formal = isym->formal; formal; formal = formal->next)
3842     {
3843       if (i >= MAX_INTRINSIC_ARGS)
3844         gfc_internal_error ("init_arglist(): too many arguments");
3845       gfc_current_intrinsic_arg[i++] = formal;
3846     }
3847 }
3848
3849
3850 /* Given a pointer to an intrinsic symbol and an expression consisting
3851    of a function call, see if the function call is consistent with the
3852    intrinsic's formal argument list.  Return SUCCESS if the expression
3853    and intrinsic match, FAILURE otherwise.  */
3854
3855 static gfc_try
3856 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3857 {
3858   gfc_actual_arglist *arg, **ap;
3859   gfc_try t;
3860
3861   ap = &expr->value.function.actual;
3862
3863   init_arglist (specific);
3864
3865   /* Don't attempt to sort the argument list for min or max.  */
3866   if (specific->check.f1m == gfc_check_min_max
3867       || specific->check.f1m == gfc_check_min_max_integer
3868       || specific->check.f1m == gfc_check_min_max_real
3869       || specific->check.f1m == gfc_check_min_max_double)
3870     return (*specific->check.f1m) (*ap);
3871
3872   if (sort_actual (specific->name, ap, specific->formal,
3873                    &expr->where) == FAILURE)
3874     return FAILURE;
3875
3876   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3877     /* This is special because we might have to reorder the argument list.  */
3878     t = gfc_check_minloc_maxloc (*ap);
3879   else if (specific->check.f3red == gfc_check_minval_maxval)
3880     /* This is also special because we also might have to reorder the
3881        argument list.  */
3882     t = gfc_check_minval_maxval (*ap);
3883   else if (specific->check.f3red == gfc_check_product_sum)
3884     /* Same here. The difference to the previous case is that we allow a
3885        general numeric type.  */
3886     t = gfc_check_product_sum (*ap);
3887   else if (specific->check.f3red == gfc_check_transf_bit_intrins)
3888     /* Same as for PRODUCT and SUM, but different checks.  */
3889     t = gfc_check_transf_bit_intrins (*ap);
3890   else
3891      {
3892        if (specific->check.f1 == NULL)
3893          {
3894            t = check_arglist (ap, specific, error_flag);
3895            if (t == SUCCESS)
3896              expr->ts = specific->ts;
3897          }
3898        else
3899          t = do_check (specific, *ap);
3900      }
3901
3902   /* Check conformance of elemental intrinsics.  */
3903   if (t == SUCCESS && specific->elemental)
3904     {
3905       int n = 0;
3906       gfc_expr *first_expr;
3907       arg = expr->value.function.actual;
3908
3909       /* There is no elemental intrinsic without arguments.  */
3910       gcc_assert(arg != NULL);
3911       first_expr = arg->expr;
3912
3913       for ( ; arg && arg->expr; arg = arg->next, n++)
3914         if (gfc_check_conformance (first_expr, arg->expr,
3915                                    "arguments '%s' and '%s' for "
3916                                    "intrinsic '%s'",
3917                                    gfc_current_intrinsic_arg[0]->name,
3918                                    gfc_current_intrinsic_arg[n]->name,
3919                                    gfc_current_intrinsic) == FAILURE)
3920           return FAILURE;
3921     }
3922
3923   if (t == FAILURE)
3924     remove_nullargs (ap);
3925
3926   return t;
3927 }
3928
3929
3930 /* Check whether an intrinsic belongs to whatever standard the user
3931    has chosen, taking also into account -fall-intrinsics.  Here, no
3932    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3933    textual representation of the symbols standard status (like
3934    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3935    can be used to construct a detailed warning/error message in case of
3936    a FAILURE.  */
3937
3938 gfc_try
3939 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3940                               const char** symstd, bool silent, locus where)
3941 {
3942   const char* symstd_msg;
3943
3944   /* For -fall-intrinsics, just succeed.  */
3945   if (gfc_option.flag_all_intrinsics)
3946     return SUCCESS;
3947
3948   /* Find the symbol's standard message for later usage.  */
3949   switch (isym->standard)
3950     {
3951     case GFC_STD_F77:
3952       symstd_msg = "available since Fortran 77";
3953       break;
3954
3955     case GFC_STD_F95_OBS:
3956       symstd_msg = "obsolescent in Fortran 95";
3957       break;
3958
3959     case GFC_STD_F95_DEL:
3960       symstd_msg = "deleted in Fortran 95";
3961       break;
3962
3963     case GFC_STD_F95:
3964       symstd_msg = "new in Fortran 95";
3965       break;
3966
3967     case GFC_STD_F2003:
3968       symstd_msg = "new in Fortran 2003";
3969       break;
3970
3971     case GFC_STD_F2008:
3972       symstd_msg = "new in Fortran 2008";
3973       break;
3974
3975     case GFC_STD_GNU:
3976       symstd_msg = "a GNU Fortran extension";
3977       break;
3978
3979     case GFC_STD_LEGACY:
3980       symstd_msg = "for backward compatibility";
3981       break;
3982
3983     default:
3984       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3985                           isym->name, isym->standard);
3986     }
3987
3988   /* If warning about the standard, warn and succeed.  */
3989   if (gfc_option.warn_std & isym->standard)
3990     {
3991       /* Do only print a warning if not a GNU extension.  */
3992       if (!silent && isym->standard != GFC_STD_GNU)
3993         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3994                      isym->name, _(symstd_msg), &where);
3995
3996       return SUCCESS;
3997     }
3998
3999   /* If allowing the symbol's standard, succeed, too.  */
4000   if (gfc_option.allow_std & isym->standard)
4001     return SUCCESS;
4002
4003   /* Otherwise, fail.  */
4004   if (symstd)
4005     *symstd = _(symstd_msg);
4006   return FAILURE;
4007 }
4008
4009
4010 /* See if a function call corresponds to an intrinsic function call.
4011    We return:
4012
4013     MATCH_YES    if the call corresponds to an intrinsic, simplification
4014                  is done if possible.
4015
4016     MATCH_NO     if the call does not correspond to an intrinsic
4017
4018     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
4019                  error during the simplification process.
4020
4021    The error_flag parameter enables an error reporting.  */
4022
4023 match
4024 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
4025 {
4026   gfc_intrinsic_sym *isym, *specific;
4027   gfc_actual_arglist *actual;
4028   const char *name;
4029   int flag;
4030
4031   if (expr->value.function.isym != NULL)
4032     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
4033            ? MATCH_ERROR : MATCH_YES;
4034
4035   if (!error_flag)
4036     gfc_push_suppress_errors ();
4037   flag = 0;
4038
4039   for (actual = expr->value.function.actual; actual; actual = actual->next)
4040     if (actual->expr != NULL)
4041       flag |= (actual->expr->ts.type != BT_INTEGER
4042                && actual->expr->ts.type != BT_CHARACTER);
4043
4044   name = expr->symtree->n.sym->name;
4045
4046   if (expr->symtree->n.sym->intmod_sym_id)
4047     {
4048       int id = expr->symtree->n.sym->intmod_sym_id;
4049       isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
4050     }
4051   else
4052     isym = specific = gfc_find_function (name);
4053
4054   if (isym == NULL)
4055     {
4056       if (!error_flag)
4057         gfc_pop_suppress_errors ();
4058       return MATCH_NO;
4059     }
4060
4061   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
4062        || isym->id == GFC_ISYM_CMPLX)
4063       && gfc_init_expr_flag
4064       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
4065                          "as initialization expression at %L", name,
4066                          &expr->where) == FAILURE)
4067     {
4068       if (!error_flag)
4069         gfc_pop_suppress_errors ();
4070       return MATCH_ERROR;
4071     }
4072
4073   gfc_current_intrinsic_where = &expr->where;
4074
4075   /* Bypass the generic list for min and max.  */
4076   if (isym->check.f1m == gfc_check_min_max)
4077     {
4078       init_arglist (isym);
4079
4080       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
4081         goto got_specific;
4082
4083       if (!error_flag)
4084         gfc_pop_suppress_errors ();
4085       return MATCH_NO;
4086     }
4087
4088   /* If the function is generic, check all of its specific
4089      incarnations.  If the generic name is also a specific, we check
4090      that name last, so that any error message will correspond to the
4091      specific.  */
4092   gfc_push_suppress_errors ();
4093
4094   if (isym->generic)
4095     {
4096       for (specific = isym->specific_head; specific;
4097            specific = specific->next)
4098         {
4099           if (specific == isym)
4100             continue;
4101           if (check_specific (specific, expr, 0) == SUCCESS)
4102             {
4103               gfc_pop_suppress_errors ();
4104               goto got_specific;
4105             }
4106         }
4107     }
4108
4109   gfc_pop_suppress_errors ();
4110
4111   if (check_specific (isym, expr, error_flag) == FAILURE)
4112     {
4113       if (!error_flag)
4114         gfc_pop_suppress_errors ();
4115       return MATCH_NO;
4116     }
4117
4118   specific = isym;
4119
4120 got_specific:
4121   expr->value.function.isym = specific;
4122   gfc_intrinsic_symbol (expr->symtree->n.sym);
4123
4124   if (!error_flag)
4125     gfc_pop_suppress_errors ();
4126
4127   if (do_simplify (specific, expr) == FAILURE)
4128     return MATCH_ERROR;
4129
4130   /* F95, 7.1.6.1, Initialization expressions
4131      (4) An elemental intrinsic function reference of type integer or
4132          character where each argument is an initialization expression
4133          of type integer or character
4134
4135      F2003, 7.1.7 Initialization expression
4136      (4)   A reference to an elemental standard intrinsic function,
4137            where each argument is an initialization expression  */
4138
4139   if (gfc_init_expr_flag && isym->elemental && flag
4140       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
4141                         "as initialization expression with non-integer/non-"
4142                         "character arguments at %L", &expr->where) == FAILURE)
4143     return MATCH_ERROR;
4144
4145   return MATCH_YES;
4146 }
4147
4148
4149 /* See if a CALL statement corresponds to an intrinsic subroutine.
4150    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4151    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4152    correspond).  */
4153
4154 match
4155 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
4156 {
4157   gfc_intrinsic_sym *isym;
4158   const char *name;
4159
4160   name = c->symtree->n.sym->name;
4161
4162   isym = gfc_find_subroutine (name);
4163   if (isym == NULL)
4164     return MATCH_NO;
4165
4166   if (!error_flag)
4167     gfc_push_suppress_errors ();
4168
4169   init_arglist (isym);
4170
4171   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
4172     goto fail;
4173
4174   if (isym->check.f1 != NULL)
4175     {
4176       if (do_check (isym, c->ext.actual) == FAILURE)
4177         goto fail;
4178     }
4179   else
4180     {
4181       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
4182         goto fail;
4183     }
4184
4185   /* The subroutine corresponds to an intrinsic.  Allow errors to be
4186      seen at this point.  */
4187   if (!error_flag)
4188     gfc_pop_suppress_errors ();
4189
4190   c->resolved_isym = isym;
4191   if (isym->resolve.s1 != NULL)
4192     isym->resolve.s1 (c);
4193   else
4194     {
4195       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
4196       c->resolved_sym->attr.elemental = isym->elemental;
4197     }
4198
4199   if (gfc_pure (NULL) && !isym->pure)
4200     {
4201       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
4202                  &c->loc);
4203       return MATCH_ERROR;
4204     }
4205
4206   c->resolved_sym->attr.noreturn = isym->noreturn;
4207
4208   return MATCH_YES;
4209
4210 fail:
4211   if (!error_flag)
4212     gfc_pop_suppress_errors ();
4213   return MATCH_NO;
4214 }
4215
4216
4217 /* Call gfc_convert_type() with warning enabled.  */
4218
4219 gfc_try
4220 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
4221 {
4222   return gfc_convert_type_warn (expr, ts, eflag, 1);
4223 }
4224
4225
4226 /* Try to convert an expression (in place) from one type to another.
4227    'eflag' controls the behavior on error.
4228
4229    The possible values are:
4230
4231      1 Generate a gfc_error()
4232      2 Generate a gfc_internal_error().
4233
4234    'wflag' controls the warning related to conversion.  */
4235
4236 gfc_try
4237 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
4238 {
4239   gfc_intrinsic_sym *sym;
4240   gfc_typespec from_ts;
4241   locus old_where;
4242   gfc_expr *new_expr;
4243   int rank;
4244   mpz_t *shape;
4245
4246   from_ts = expr->ts;           /* expr->ts gets clobbered */
4247
4248   if (ts->type == BT_UNKNOWN)
4249     goto bad;
4250
4251   /* NULL and zero size arrays get their type here.  */
4252   if (expr->expr_type == EXPR_NULL
4253       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
4254     {
4255       /* Sometimes the RHS acquire the type.  */
4256       expr->ts = *ts;
4257       return SUCCESS;
4258     }
4259
4260   if (expr->ts.type == BT_UNKNOWN)
4261     goto bad;
4262
4263   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4264       && gfc_compare_types (&expr->ts, ts))
4265     return SUCCESS;
4266
4267   sym = find_conv (&expr->ts, ts);
4268   if (sym == NULL)
4269     goto bad;
4270
4271   /* At this point, a conversion is necessary. A warning may be needed.  */
4272   if ((gfc_option.warn_std & sym->standard) != 0)
4273     {
4274       gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4275                        gfc_typename (&from_ts), gfc_typename (ts),
4276                        &expr->where);
4277     }
4278   else if (wflag)
4279     {
4280       if (gfc_option.flag_range_check
4281           && expr->expr_type == EXPR_CONSTANT
4282           && from_ts.type == ts->type)
4283         {
4284           /* Do nothing. Constants of the same type are range-checked
4285              elsewhere. If a value too large for the target type is
4286              assigned, an error is generated. Not checking here avoids
4287              duplications of warnings/errors.
4288              If range checking was disabled, but -Wconversion enabled,
4289              a non range checked warning is generated below.  */
4290         }
4291       else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4292         {
4293           /* Do nothing. This block exists only to simplify the other
4294              else-if expressions.
4295                LOGICAL <> LOGICAL    no warning, independent of kind values
4296                LOGICAL <> INTEGER    extension, warned elsewhere
4297                LOGICAL <> REAL       invalid, error generated elsewhere
4298                LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
4299         }
4300       else if (from_ts.type == ts->type
4301                || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4302                || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4303                || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4304         {
4305           /* Larger kinds can hold values of smaller kinds without problems.
4306              Hence, only warn if target kind is smaller than the source
4307              kind - or if -Wconversion-extra is specified.  */
4308           if (gfc_option.warn_conversion_extra)
4309             gfc_warning_now ("Conversion from %s to %s at %L",
4310                              gfc_typename (&from_ts), gfc_typename (ts),
4311                              &expr->where);
4312           else if (gfc_option.gfc_warn_conversion
4313                    && from_ts.kind > ts->kind)
4314             gfc_warning_now ("Possible change of value in conversion "
4315                              "from %s to %s at %L", gfc_typename (&from_ts),
4316                              gfc_typename (ts), &expr->where);
4317         }
4318       else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4319                || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4320                || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4321         {
4322           /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4323              usually comes with a loss of information, regardless of kinds.  */
4324           if (gfc_option.warn_conversion_extra
4325               || gfc_option.gfc_warn_conversion)
4326             gfc_warning_now ("Possible change of value in conversion "
4327                              "from %s to %s at %L", gfc_typename (&from_ts),
4328                              gfc_typename (ts), &expr->where);
4329         }
4330       else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4331         {
4332           /* If HOLLERITH is involved, all bets are off.  */
4333           if (gfc_option.warn_conversion_extra
4334               || gfc_option.gfc_warn_conversion)
4335             gfc_warning_now ("Conversion from %s to %s at %L",
4336                              gfc_typename (&from_ts), gfc_typename (ts),
4337                              &expr->where);
4338         }
4339       else
4340         gcc_unreachable ();
4341     }
4342
4343   /* Insert a pre-resolved function call to the right function.  */
4344   old_where = expr->where;
4345   rank = expr->rank;
4346   shape = expr->shape;
4347
4348   new_expr = gfc_get_expr ();
4349   *new_expr = *expr;
4350
4351   new_expr = gfc_build_conversion (new_expr);
4352   new_expr->value.function.name = sym->lib_name;
4353   new_expr->value.function.isym = sym;
4354   new_expr->where = old_where;
4355   new_expr->rank = rank;
4356   new_expr->shape = gfc_copy_shape (shape, rank);
4357
4358   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4359   new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4360   new_expr->symtree->n.sym->ts = *ts;
4361   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4362   new_expr->symtree->n.sym->attr.function = 1;
4363   new_expr->symtree->n.sym->attr.elemental = 1;
4364   new_expr->symtree->n.sym->attr.pure = 1;
4365   new_expr->symtree->n.sym->attr.referenced = 1;
4366   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4367   gfc_commit_symbol (new_expr->symtree->n.sym);
4368
4369   *expr = *new_expr;
4370
4371   gfc_free (new_expr);
4372   expr->ts = *ts;
4373
4374   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4375       && do_simplify (sym, expr) == FAILURE)
4376     {
4377
4378       if (eflag == 2)
4379         goto bad;
4380       return FAILURE;           /* Error already generated in do_simplify() */
4381     }
4382
4383   return SUCCESS;
4384
4385 bad:
4386   if (eflag == 1)
4387     {
4388       gfc_error ("Can't convert %s to %s at %L",
4389                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4390       return FAILURE;
4391     }
4392
4393   gfc_internal_error ("Can't convert %s to %s at %L",
4394                       gfc_typename (&from_ts), gfc_typename (ts),
4395                       &expr->where);
4396   /* Not reached */
4397 }
4398
4399
4400 gfc_try
4401 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4402 {
4403   gfc_intrinsic_sym *sym;
4404   locus old_where;
4405   gfc_expr *new_expr;
4406   int rank;
4407   mpz_t *shape;
4408
4409   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4410
4411   sym = find_char_conv (&expr->ts, ts);
4412   gcc_assert (sym);
4413
4414   /* Insert a pre-resolved function call to the right function.  */
4415   old_where = expr->where;
4416   rank = expr->rank;
4417   shape = expr->shape;
4418
4419   new_expr = gfc_get_expr ();
4420   *new_expr = *expr;
4421
4422   new_expr = gfc_build_conversion (new_expr);
4423   new_expr->value.function.name = sym->lib_name;
4424   new_expr->value.function.isym = sym;
4425   new_expr->where = old_where;
4426   new_expr->rank = rank;
4427   new_expr->shape = gfc_copy_shape (shape, rank);
4428
4429   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4430   new_expr->symtree->n.sym->ts = *ts;
4431   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4432   new_expr->symtree->n.sym->attr.function = 1;
4433   new_expr->symtree->n.sym->attr.elemental = 1;
4434   new_expr->symtree->n.sym->attr.referenced = 1;
4435   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4436   gfc_commit_symbol (new_expr->symtree->n.sym);
4437
4438   *expr = *new_expr;
4439
4440   gfc_free (new_expr);
4441   expr->ts = *ts;
4442
4443   if (gfc_is_constant_expr (expr->value.function.actual->expr)
4444       && do_simplify (sym, expr) == FAILURE)
4445     {
4446       /* Error already generated in do_simplify() */
4447       return FAILURE;
4448     }
4449
4450   return SUCCESS;
4451 }
4452
4453
4454 /* Check if the passed name is name of an intrinsic (taking into account the
4455    current -std=* and -fall-intrinsic settings).  If it is, see if we should
4456    warn about this as a user-procedure having the same name as an intrinsic
4457    (-Wintrinsic-shadow enabled) and do so if we should.  */
4458
4459 void
4460 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4461 {
4462   gfc_intrinsic_sym* isym;
4463
4464   /* If the warning is disabled, do nothing at all.  */
4465   if (!gfc_option.warn_intrinsic_shadow)
4466     return;
4467
4468   /* Try to find an intrinsic of the same name.  */
4469   if (func)
4470     isym = gfc_find_function (sym->name);
4471   else
4472     isym = gfc_find_subroutine (sym->name);
4473
4474   /* If no intrinsic was found with this name or it's not included in the
4475      selected standard, everything's fine.  */
4476   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4477                                              sym->declared_at) == FAILURE)
4478     return;
4479
4480   /* Emit the warning.  */
4481   if (in_module)
4482     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4483                  " name.  In order to call the intrinsic, explicit INTRINSIC"
4484                  " declarations may be required.",
4485                  sym->name, &sym->declared_at);
4486   else
4487     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
4488                  " only be called via an explicit interface or if declared"
4489                  " EXTERNAL.", sym->name, &sym->declared_at);
4490 }