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