gcc/fortran/intrinsic.c

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