gcc/fortran/intrinsic.c

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