gcc/fortran/intrinsic.c

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