gcc/fortran/intrinsic.c

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