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