gcc/fortran/intrinsic.c

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