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