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 gfc_try
 179 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 180 {
 181   gfc_expr *a1, *a2, *a3, *a4, *a5;
 182
 183   if (arg == NULL)
 184     return (*specific->check.f0) ();
 185
 186   a1 = arg->expr;
 187   arg = arg->next;
 188   if (arg == NULL)
 189     return (*specific->check.f1) (a1);
 190
 191   a2 = arg->expr;
 192   arg = arg->next;
 193   if (arg == NULL)
 194     return (*specific->check.f2) (a1, a2);
 195
 196   a3 = arg->expr;
 197   arg = arg->next;
 198   if (arg == NULL)
 199     return (*specific->check.f3) (a1, a2, a3);
 200
 201   a4 = arg->expr;
 202   arg = arg->next;
 203   if (arg == NULL)
 204     return (*specific->check.f4) (a1, a2, a3, a4);
 205
 206   a5 = arg->expr;
 207   arg = arg->next;
 208   if (arg == NULL)
 209     return (*specific->check.f5) (a1, a2, a3, a4, a5);
 210
 211   gfc_internal_error ("do_check(): too many args");
 212 }
 213
 214
 215 /*********** Subroutines to build the intrinsic list ****************/
 216
 217 /* Add a single intrinsic symbol to the current list.
 218
 219    Argument list:
 220       char *     name of function
 221       int       whether function is elemental
 222       int       If the function can be used as an actual argument [1]
 223       bt         return type of function
 224       int       kind of return type of function
 225       int       Fortran standard version
 226       check      pointer to check function
 227       simplify   pointer to simplification function
 228       resolve    pointer to resolution function
 229
 230    Optional arguments come in multiples of 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            gfc_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            gfc_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             gfc_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             gfc_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            gfc_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             gfc_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            gfc_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              gfc_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               gfc_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             gfc_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            gfc_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             gfc_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             gfc_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_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1785              BT_INTEGER, di, GFC_STD_F2008,
1786              gfc_check_i, gfc_simplify_leadz, NULL,
1787              i, BT_INTEGER, di, REQUIRED);
1788
1789   make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1790
1791   add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1792              BT_INTEGER, di, GFC_STD_F77,
1793              gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1794              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1795
1796   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1797
1798   add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1799              BT_INTEGER, di, GFC_STD_F95,
1800              gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1801              stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1802
1803   make_alias ("lnblnk", GFC_STD_GNU);
1804
1805   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1806
1807   add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1808              dr, GFC_STD_GNU,
1809              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1810              x, BT_REAL, dr, REQUIRED);
1811
1812   make_alias ("log_gamma", GFC_STD_F2008);
1813
1814   add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1815              gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1816              x, BT_REAL, dr, REQUIRED);
1817
1818   add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1819              gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1820              x, BT_REAL, dr, REQUIRED);
1821
1822   make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1823
1824
1825   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1826              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1827              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1828
1829   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1830
1831   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1832              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1833              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1834
1835   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1836
1837   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1838              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1839              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1840
1841   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1842
1843   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1844              GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1845              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1846
1847   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1848
1849   add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1850              gfc_check_link, NULL, gfc_resolve_link,
1851              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
1852
1853   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1854
1855   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1856              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1857              x, BT_REAL, dr, REQUIRED);
1858
1859   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1860              NULL, gfc_simplify_log, gfc_resolve_log,
1861              x, BT_REAL, dr, REQUIRED);
1862
1863   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1864              gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
1865              x, BT_REAL, dd, REQUIRED);
1866
1867   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1868              NULL, gfc_simplify_log, gfc_resolve_log,
1869              x, BT_COMPLEX, dz, REQUIRED);
1870
1871   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1872              NULL, gfc_simplify_log, gfc_resolve_log,
1873              x, BT_COMPLEX, dd, REQUIRED);
1874
1875   make_alias ("cdlog", GFC_STD_GNU);
1876
1877   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
1878
1879   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1880              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1881              x, BT_REAL, dr, REQUIRED);
1882
1883   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1884              NULL, gfc_simplify_log10, gfc_resolve_log10,
1885              x, BT_REAL, dr, REQUIRED);
1886
1887   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1888              gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
1889              x, BT_REAL, dd, REQUIRED);
1890
1891   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
1892
1893   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1894              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1895              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1896
1897   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
1898
1899   add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1900              gfc_check_stat, NULL, gfc_resolve_lstat,
1901              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1902
1903   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
1904
1905   add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1906              gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di,
1907              REQUIRED);
1908
1909   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1910
1911   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1912              gfc_check_matmul, NULL, gfc_resolve_matmul,
1913              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1914
1915   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1916
1917   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1918      int(max).  The max function must take at least two arguments.  */
1919
1920   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1921              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1922              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1923
1924   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1925              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1926              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1927
1928   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1929              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1930              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1931
1932   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1933              gfc_check_min_max_real, gfc_simplify_max, NULL,
1934              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1935
1936   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1937              gfc_check_min_max_real, gfc_simplify_max, NULL,
1938              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1939
1940   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1941              gfc_check_min_max_double, gfc_simplify_max, NULL,
1942              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1943
1944   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1945
1946   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1947              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1948              x, BT_UNKNOWN, dr, REQUIRED);
1949
1950   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
1951
1952   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1953                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1954                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1955                msk, BT_LOGICAL, dl, OPTIONAL);
1956
1957   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1958
1959   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1960                 gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
1961                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1962                 msk, BT_LOGICAL, dl, OPTIONAL);
1963
1964   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1965
1966   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1967              NULL, NULL, gfc_resolve_mclock);
1968
1969   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1970
1971   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1972              NULL, NULL, gfc_resolve_mclock8);
1973
1974   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1975
1976   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1977              gfc_check_merge, NULL, gfc_resolve_merge,
1978              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1979              msk, BT_LOGICAL, dl, REQUIRED);
1980
1981   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1982
1983   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1984      int(min).  */
1985
1986   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1987               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1988               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1989
1990   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1991               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1992               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1993
1994   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1995               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1996               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1997
1998   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1999               gfc_check_min_max_real, gfc_simplify_min, NULL,
2000               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2001
2002   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2003               gfc_check_min_max_real, gfc_simplify_min, NULL,
2004               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2005
2006   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2007               gfc_check_min_max_double, gfc_simplify_min, NULL,
2008               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2009
2010   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2011
2012   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2013              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2014              x, BT_UNKNOWN, dr, REQUIRED);
2015
2016   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2017
2018   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2019                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2020                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2021                msk, BT_LOGICAL, dl, OPTIONAL);
2022
2023   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2024
2025   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2026                 gfc_check_minval_maxval, NULL, gfc_resolve_minval,
2027                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2028                 msk, BT_LOGICAL, dl, OPTIONAL);
2029
2030   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2031
2032   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2033              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2034              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2035
2036   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2037              NULL, gfc_simplify_mod, gfc_resolve_mod,
2038              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2039
2040   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2041              gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2042              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2043
2044   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2045
2046   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2047              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2048              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2049
2050   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2051
2052   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2053              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2054              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2055
2056   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2057
2058   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2059              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2060              a, BT_CHARACTER, dc, REQUIRED);
2061
2062   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2063
2064   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2065              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2066              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2067
2068   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2069              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2070              a, BT_REAL, dd, REQUIRED);
2071
2072   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2073
2074   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2075              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2076              i, BT_INTEGER, di, REQUIRED);
2077
2078   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2079
2080   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2081              gfc_check_null, gfc_simplify_null, NULL,
2082              mo, BT_INTEGER, di, OPTIONAL);
2083
2084   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2085
2086   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2087              gfc_check_pack, NULL, gfc_resolve_pack,
2088              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2089              v, BT_REAL, dr, OPTIONAL);
2090
2091   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2092
2093   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2094              gfc_check_precision, gfc_simplify_precision, NULL,
2095              x, BT_UNKNOWN, 0, REQUIRED);
2096
2097   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2098
2099   add_sym_1 ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2100              gfc_check_present, NULL, NULL,
2101              a, BT_REAL, dr, REQUIRED);
2102
2103   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2104
2105   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2106                 gfc_check_product_sum, NULL, gfc_resolve_product,
2107                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2108                 msk, BT_LOGICAL, dl, OPTIONAL);
2109
2110   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2111
2112   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2113              gfc_check_radix, gfc_simplify_radix, NULL,
2114              x, BT_UNKNOWN, 0, REQUIRED);
2115
2116   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2117
2118   /* The following function is for G77 compatibility.  */
2119   add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2120              gfc_check_rand, NULL, NULL,
2121              i, BT_INTEGER, 4, OPTIONAL);
2122
2123   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
2124      use slightly different shoddy multiplicative congruential PRNG.  */
2125   make_alias ("ran", GFC_STD_GNU);
2126
2127   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2128
2129   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2130              gfc_check_range, gfc_simplify_range, NULL,
2131              x, BT_REAL, dr, REQUIRED);
2132
2133   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2134
2135   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2136              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2137              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2138
2139   /* This provides compatibility with g77.  */
2140   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2141              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2142              a, BT_UNKNOWN, dr, REQUIRED);
2143
2144   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2145              gfc_check_i, gfc_simplify_float, NULL,
2146              a, BT_INTEGER, di, REQUIRED);
2147
2148   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2149              NULL, gfc_simplify_sngl, NULL,
2150              a, BT_REAL, dd, REQUIRED);
2151
2152   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2153
2154   add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2155              gfc_check_rename, NULL, gfc_resolve_rename,
2156              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2157
2158   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2159
2160   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2161              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2162              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2163
2164   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2165
2166   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2167              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2168              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2169              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2170
2171   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2172
2173   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2174              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2175              x, BT_REAL, dr, REQUIRED);
2176
2177   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2178
2179   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2180              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2181              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2182
2183   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2184
2185   add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2186              BT_INTEGER, di, GFC_STD_F95,
2187              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2188              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2189              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2190
2191   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2192
2193   /* Added for G77 compatibility garbage.  */
2194   add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2195              NULL, NULL, NULL);
2196
2197   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2198
2199   /* Added for G77 compatibility.  */
2200   add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2201              gfc_check_secnds, NULL, gfc_resolve_secnds,
2202              x, BT_REAL, dr, REQUIRED);
2203
2204   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2205
2206   add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2207              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2208              gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2209              NULL, nm, BT_CHARACTER, dc, REQUIRED);
2210
2211   make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2212
2213   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2214              GFC_STD_F95, gfc_check_selected_int_kind,
2215              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2216
2217   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2218
2219   add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2220              GFC_STD_F95, gfc_check_selected_real_kind,
2221              gfc_simplify_selected_real_kind, NULL,
2222              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2223
2224   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2225
2226   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2227              gfc_check_set_exponent, gfc_simplify_set_exponent,
2228              gfc_resolve_set_exponent,
2229              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2230
2231   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2232
2233   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2234              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2235              src, BT_REAL, dr, REQUIRED);
2236
2237   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2238
2239   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2240              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2241              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2242
2243   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2244              NULL, gfc_simplify_sign, gfc_resolve_sign,
2245              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2246
2247   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2248              gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2249              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2250
2251   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2252
2253   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2254              gfc_check_signal, NULL, gfc_resolve_signal,
2255              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2256
2257   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2258
2259   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2260              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2261              x, BT_REAL, dr, REQUIRED);
2262
2263   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2264              gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2265              x, BT_REAL, dd, REQUIRED);
2266
2267   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2268              NULL, gfc_simplify_sin, gfc_resolve_sin,
2269              x, BT_COMPLEX, dz, REQUIRED);
2270
2271   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2272              NULL, gfc_simplify_sin, gfc_resolve_sin,
2273              x, BT_COMPLEX, dd, REQUIRED);
2274
2275   make_alias ("cdsin", GFC_STD_GNU);
2276
2277   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2278
2279   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2280              gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2281              x, BT_REAL, dr, REQUIRED);
2282
2283   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2284              gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2285              x, BT_REAL, dd, REQUIRED);
2286
2287   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2288
2289   add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2290              BT_INTEGER, di, GFC_STD_F95,
2291              gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2292              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2293              kind, BT_INTEGER, di, OPTIONAL);
2294
2295   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2296
2297   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2298              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2299              x, BT_UNKNOWN, 0, REQUIRED);
2300
2301   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2302   make_alias ("c_sizeof", GFC_STD_F2008);
2303
2304   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2305              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2306              x, BT_REAL, dr, REQUIRED);
2307
2308   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2309
2310   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2311              gfc_check_spread, NULL, gfc_resolve_spread,
2312              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2313              ncopies, BT_INTEGER, di, REQUIRED);
2314
2315   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2316
2317   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2318              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2319              x, BT_REAL, dr, REQUIRED);
2320
2321   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2322              gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2323              x, BT_REAL, dd, REQUIRED);
2324
2325   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2326              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2327              x, BT_COMPLEX, dz, REQUIRED);
2328
2329   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2330              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2331              x, BT_COMPLEX, dd, REQUIRED);
2332
2333   make_alias ("cdsqrt", GFC_STD_GNU);
2334
2335   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2336
2337   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2338              gfc_check_stat, NULL, gfc_resolve_stat,
2339              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2340
2341   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2342
2343   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2344                 gfc_check_product_sum, NULL, gfc_resolve_sum,
2345                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2346                 msk, BT_LOGICAL, dl, OPTIONAL);
2347
2348   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2349
2350   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2351              gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2352              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2353
2354   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2355
2356   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2357              NULL, NULL, NULL,
2358              c, BT_CHARACTER, dc, REQUIRED);
2359
2360   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2361
2362   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2363              gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2364              x, BT_REAL, dr, REQUIRED);
2365
2366   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2367              gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2368              x, BT_REAL, dd, REQUIRED);
2369
2370   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2371
2372   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2373              gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2374              x, BT_REAL, dr, REQUIRED);
2375
2376   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2377              gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2378              x, BT_REAL, dd, REQUIRED);
2379
2380   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2381
2382   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2383              NULL, NULL, gfc_resolve_time);
2384
2385   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2386
2387   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2388              NULL, NULL, gfc_resolve_time8);
2389
2390   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2391
2392   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2393              gfc_check_x, gfc_simplify_tiny, NULL,
2394              x, BT_REAL, dr, REQUIRED);
2395
2396   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2397
2398   add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2399              BT_INTEGER, di, GFC_STD_F2008,
2400              gfc_check_i, gfc_simplify_trailz, NULL,
2401              i, BT_INTEGER, di, REQUIRED);
2402
2403   make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2404
2405   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2406              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2407              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2408              sz, BT_INTEGER, di, OPTIONAL);
2409
2410   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2411
2412   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2413              gfc_check_transpose, NULL, gfc_resolve_transpose,
2414              m, BT_REAL, dr, REQUIRED);
2415
2416   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2417
2418   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2419              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2420              stg, BT_CHARACTER, dc, REQUIRED);
2421
2422   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2423
2424   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2425              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2426              ut, BT_INTEGER, di, REQUIRED);
2427
2428   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2429
2430   add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2431              BT_INTEGER, di, GFC_STD_F95,
2432              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2433              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2434              kind, BT_INTEGER, di, OPTIONAL);
2435
2436   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2437
2438   /* g77 compatibility for UMASK.  */
2439   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2440              gfc_check_umask, NULL, gfc_resolve_umask,
2441              a, BT_INTEGER, di, REQUIRED);
2442
2443   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2444
2445   /* g77 compatibility for UNLINK.  */
2446   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2447              gfc_check_unlink, NULL, gfc_resolve_unlink,
2448              a, BT_CHARACTER, dc, REQUIRED);
2449
2450   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2451
2452   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2453              gfc_check_unpack, NULL, gfc_resolve_unpack,
2454              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2455              f, BT_REAL, dr, REQUIRED);
2456
2457   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2458
2459   add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2460              BT_INTEGER, di, GFC_STD_F95,
2461              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2462              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2463              bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2464
2465   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2466
2467   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
2468              gfc_check_loc, NULL, gfc_resolve_loc,
2469              ar, BT_UNKNOWN, 0, REQUIRED);
2470
2471   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2472 }
2473
2474
2475 /* Add intrinsic subroutines.  */
2476
2477 static void
2478 add_subroutines (void)
2479 {
2480   /* Argument names as in the standard (to be used as argument keywords).  */
2481   const char
2482     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2483     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2484     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2485     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2486     *com = "command", *length = "length", *st = "status",
2487     *val = "value", *num = "number", *name = "name",
2488     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2489     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2490     *whence = "whence", *pos = "pos";
2491
2492   int di, dr, dc, dl, ii;
2493
2494   di = gfc_default_integer_kind;
2495   dr = gfc_default_real_kind;
2496   dc = gfc_default_character_kind;
2497   dl = gfc_default_logical_kind;
2498   ii = gfc_index_integer_kind;
2499
2500   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2501
2502   make_noreturn();
2503
2504   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2505               gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2506               tm, BT_REAL, dr, REQUIRED);
2507
2508   /* More G77 compatibility garbage.  */
2509   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2510               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2511               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2512
2513   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2514               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2515               vl, BT_INTEGER, 4, REQUIRED);
2516
2517   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2518               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2519               vl, BT_INTEGER, 4, REQUIRED);
2520
2521   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2522               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2523               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2524
2525   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2526               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2527               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2528
2529   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2530               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2531               tm, BT_REAL, dr, REQUIRED);
2532
2533   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2534               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2535               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2536
2537   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2538               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2539               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2540               st, BT_INTEGER, di, OPTIONAL);
2541
2542   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2543               gfc_check_date_and_time, NULL, NULL,
2544               dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2545               zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2546
2547   /* More G77 compatibility garbage.  */
2548   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2549               gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2550               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2551
2552   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2553               gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2554               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2555
2556   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2557               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2558               dt, BT_CHARACTER, dc, REQUIRED);
2559
2560   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2561               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2562               dc, REQUIRED);
2563
2564   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2565               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2566               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2567
2568   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2569               NULL, NULL, NULL,
2570               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2571               REQUIRED);
2572
2573   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2574               gfc_check_getarg, NULL, gfc_resolve_getarg,
2575               pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2576
2577   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2578               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2579               dc, REQUIRED);
2580
2581   /* F2003 commandline routines.  */
2582
2583   add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2584               NULL, NULL, gfc_resolve_get_command,
2585               com, BT_CHARACTER, dc, OPTIONAL,
2586               length, BT_INTEGER, di, OPTIONAL,
2587               st, BT_INTEGER, di, OPTIONAL);
2588
2589   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2590               NULL, NULL, gfc_resolve_get_command_argument,
2591               num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2592               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2593
2594   /* F2003 subroutine to get environment variables.  */
2595
2596   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2597               NULL, NULL, gfc_resolve_get_environment_variable,
2598               name, BT_CHARACTER, dc, REQUIRED,
2599               val, BT_CHARACTER, dc, OPTIONAL,
2600               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2601               trim_name, BT_LOGICAL, dl, OPTIONAL);
2602
2603   add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2604               gfc_check_move_alloc, NULL, NULL,
2605               f, BT_UNKNOWN, 0, REQUIRED,
2606               t, BT_UNKNOWN, 0, REQUIRED);
2607
2608   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2609               gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2610               f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2611               ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2612               tp, BT_INTEGER, di, REQUIRED);
2613
2614   add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2615               gfc_check_random_number, NULL, gfc_resolve_random_number,
2616               h, BT_REAL, dr, REQUIRED);
2617
2618   add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2619               BT_UNKNOWN, 0, GFC_STD_F95,
2620               gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2621               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2622               gt, BT_INTEGER, di, OPTIONAL);
2623
2624   /* More G77 compatibility garbage.  */
2625   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2626               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2627               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2628               st, BT_INTEGER, di, OPTIONAL);
2629
2630   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2631               gfc_check_srand, NULL, gfc_resolve_srand,
2632               c, BT_INTEGER, 4, REQUIRED);
2633
2634   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2635               gfc_check_exit, NULL, gfc_resolve_exit,
2636               st, BT_INTEGER, di, OPTIONAL);
2637
2638   make_noreturn();
2639
2640   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2641               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2642               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2643               st, BT_INTEGER, di, OPTIONAL);
2644
2645   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2646               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2647               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2648
2649   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2650               gfc_check_flush, NULL, gfc_resolve_flush,
2651               ut, BT_INTEGER, di, OPTIONAL);
2652
2653   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2654               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2655               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2656               st, BT_INTEGER, di, OPTIONAL);
2657
2658   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2659               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2660               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2661
2662   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2663               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2664
2665   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2666               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2667               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2668               whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2669
2670   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2671               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2672               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2673
2674   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2675               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2676               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2677
2678   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2679               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2680               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2681
2682   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2684               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2685               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2686
2687   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2688               gfc_check_perror, NULL, gfc_resolve_perror,
2689               c, BT_CHARACTER, dc, REQUIRED);
2690
2691   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2692               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2693               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2694               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2695
2696   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2697               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2698               val, BT_INTEGER, di, REQUIRED);
2699
2700   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2701               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2702               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2703               st, BT_INTEGER, di, OPTIONAL);
2704
2705   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2706               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2707               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2708               st, BT_INTEGER, di, OPTIONAL);
2709
2710   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2711               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2712               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2713               st, BT_INTEGER, di, OPTIONAL);
2714
2715   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2716               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2717               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2718               st, BT_INTEGER, di, OPTIONAL);
2719
2720   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2721               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2722               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2723               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2724
2725   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2726               NULL, NULL, gfc_resolve_system_sub,
2727               com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2728
2729   add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2730               gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2731               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2732               cm, BT_INTEGER, di, OPTIONAL);
2733
2734   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2735               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2736               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2737
2738   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2739               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2740               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2741
2742   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2743               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2744               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2745 }
2746
2747
2748 /* Add a function to the list of conversion symbols.  */
2749
2750 static void
2751 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2752 {
2753   gfc_typespec from, to;
2754   gfc_intrinsic_sym *sym;
2755
2756   if (sizing == SZ_CONVS)
2757     {
2758       nconv++;
2759       return;
2760     }
2761
2762   gfc_clear_ts (&from);
2763   from.type = from_type;
2764   from.kind = from_kind;
2765
2766   gfc_clear_ts (&to);
2767   to.type = to_type;
2768   to.kind = to_kind;
2769
2770   sym = conversion + nconv;
2771
2772   sym->name = conv_name (&from, &to);
2773   sym->lib_name = sym->name;
2774   sym->simplify.cc = gfc_convert_constant;
2775   sym->standard = standard;
2776   sym->elemental = 1;
2777   sym->conversion = 1;
2778   sym->ts = to;
2779   sym->id = GFC_ISYM_CONVERSION;
2780
2781   nconv++;
2782 }
2783
2784
2785 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2786    functions by looping over the kind tables.  */
2787
2788 static void
2789 add_conversions (void)
2790 {
2791   int i, j;
2792
2793   /* Integer-Integer conversions.  */
2794   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2795     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2796       {
2797         if (i == j)
2798           continue;
2799
2800         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2801                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2802       }
2803
2804   /* Integer-Real/Complex conversions.  */
2805   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2806     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2807       {
2808         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2809                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2810
2811         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2812                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2813
2814         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2815                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2816
2817         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2818                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2819       }
2820
2821   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2822     {
2823       /* Hollerith-Integer conversions.  */
2824       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2825         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2826                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2827       /* Hollerith-Real conversions.  */
2828       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2829         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2830                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2831       /* Hollerith-Complex conversions.  */
2832       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2833         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2834                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2835
2836       /* Hollerith-Character conversions.  */
2837       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2838                   gfc_default_character_kind, GFC_STD_LEGACY);
2839
2840       /* Hollerith-Logical conversions.  */
2841       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2842         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2843                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2844     }
2845
2846   /* Real/Complex - Real/Complex conversions.  */
2847   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2848     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2849       {
2850         if (i != j)
2851           {
2852             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2853                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2854
2855             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2856                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2857           }
2858
2859         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2860                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2861
2862         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2863                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2864       }
2865
2866   /* Logical/Logical kind conversion.  */
2867   for (i = 0; gfc_logical_kinds[i].kind; i++)
2868     for (j = 0; gfc_logical_kinds[j].kind; j++)
2869       {
2870         if (i == j)
2871           continue;
2872
2873         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2874                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2875       }
2876
2877   /* Integer-Logical and Logical-Integer conversions.  */
2878   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2879     for (i=0; gfc_integer_kinds[i].kind; i++)
2880       for (j=0; gfc_logical_kinds[j].kind; j++)
2881         {
2882           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2883                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2884           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2885                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2886         }
2887 }
2888
2889
2890 static void
2891 add_char_conversions (void)
2892 {
2893   int n, i, j;
2894
2895   /* Count possible conversions.  */
2896   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
2897     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
2898       if (i != j)
2899         ncharconv++;
2900
2901   /* Allocate memory.  */
2902   char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
2903
2904   /* Add the conversions themselves.  */
2905   n = 0;
2906   for (i = 0; gfc_character_kinds[i].kind != 0; i++)
2907     for (j = 0; gfc_character_kinds[j].kind != 0; j++)
2908       {
2909         gfc_typespec from, to;
2910
2911         if (i == j)
2912           continue;
2913
2914         gfc_clear_ts (&from);
2915         from.type = BT_CHARACTER;
2916         from.kind = gfc_character_kinds[i].kind;
2917
2918         gfc_clear_ts (&to);
2919         to.type = BT_CHARACTER;
2920         to.kind = gfc_character_kinds[j].kind;
2921
2922         char_conversions[n].name = conv_name (&from, &to);
2923         char_conversions[n].lib_name = char_conversions[n].name;
2924         char_conversions[n].simplify.cc = gfc_convert_char_constant;
2925         char_conversions[n].standard = GFC_STD_F2003;
2926         char_conversions[n].elemental = 1;
2927         char_conversions[n].conversion = 0;
2928         char_conversions[n].ts = to;
2929         char_conversions[n].id = GFC_ISYM_CONVERSION;
2930
2931         n++;
2932       }
2933 }
2934
2935
2936 /* Initialize the table of intrinsics.  */
2937 void
2938 gfc_intrinsic_init_1 (void)
2939 {
2940   int i;
2941
2942   nargs = nfunc = nsub = nconv = 0;
2943
2944   /* Create a namespace to hold the resolved intrinsic symbols.  */
2945   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2946
2947   sizing = SZ_FUNCS;
2948   add_functions ();
2949   sizing = SZ_SUBS;
2950   add_subroutines ();
2951   sizing = SZ_CONVS;
2952   add_conversions ();
2953
2954   functions = XCNEWVAR (struct gfc_intrinsic_sym,
2955                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2956                         + sizeof (gfc_intrinsic_arg) * nargs);
2957
2958   next_sym = functions;
2959   subroutines = functions + nfunc;
2960
2961   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
2962
2963   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2964
2965   sizing = SZ_NOTHING;
2966   nconv = 0;
2967
2968   add_functions ();
2969   add_subroutines ();
2970   add_conversions ();
2971
2972   /* Character conversion intrinsics need to be treated separately.  */
2973   add_char_conversions ();
2974
2975   /* Set the pure flag.  All intrinsic functions are pure, and
2976      intrinsic subroutines are pure if they are elemental.  */
2977
2978   for (i = 0; i < nfunc; i++)
2979     functions[i].pure = 1;
2980
2981   for (i = 0; i < nsub; i++)
2982     subroutines[i].pure = subroutines[i].elemental;
2983 }
2984
2985
2986 void
2987 gfc_intrinsic_done_1 (void)
2988 {
2989   gfc_free (functions);
2990   gfc_free (conversion);
2991   gfc_free (char_conversions);
2992   gfc_free_namespace (gfc_intrinsic_namespace);
2993 }
2994
2995
2996 /******** Subroutines to check intrinsic interfaces ***********/
2997
2998 /* Given a formal argument list, remove any NULL arguments that may
2999    have been left behind by a sort against some formal argument list.  */
3000
3001 static void
3002 remove_nullargs (gfc_actual_arglist **ap)
3003 {
3004   gfc_actual_arglist *head, *tail, *next;
3005
3006   tail = NULL;
3007
3008   for (head = *ap; head; head = next)
3009     {
3010       next = head->next;
3011
3012       if (head->expr == NULL && !head->label)
3013         {
3014           head->next = NULL;
3015           gfc_free_actual_arglist (head);
3016         }
3017       else
3018         {
3019           if (tail == NULL)
3020             *ap = head;
3021           else
3022             tail->next = head;
3023
3024           tail = head;
3025           tail->next = NULL;
3026         }
3027     }
3028
3029   if (tail == NULL)
3030     *ap = NULL;
3031 }
3032
3033
3034 /* Given an actual arglist and a formal arglist, sort the actual
3035    arglist so that its arguments are in a one-to-one correspondence
3036    with the format arglist.  Arguments that are not present are given
3037    a blank gfc_actual_arglist structure.  If something is obviously
3038    wrong (say, a missing required argument) we abort sorting and
3039    return FAILURE.  */
3040
3041 static gfc_try
3042 sort_actual (const char *name, gfc_actual_arglist **ap,
3043              gfc_intrinsic_arg *formal, locus *where)
3044 {
3045   gfc_actual_arglist *actual, *a;
3046   gfc_intrinsic_arg *f;
3047
3048   remove_nullargs (ap);
3049   actual = *ap;
3050
3051   for (f = formal; f; f = f->next)
3052     f->actual = NULL;
3053
3054   f = formal;
3055   a = actual;
3056
3057   if (f == NULL && a == NULL)   /* No arguments */
3058     return SUCCESS;
3059
3060   for (;;)
3061     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3062       if (f == NULL)
3063         break;
3064       if (a == NULL)
3065         goto optional;
3066
3067       if (a->name != NULL)
3068         goto keywords;
3069
3070       f->actual = a;
3071
3072       f = f->next;
3073       a = a->next;
3074     }
3075
3076   if (a == NULL)
3077     goto do_sort;
3078
3079   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3080   return FAILURE;
3081
3082 keywords:
3083   /* Associate the remaining actual arguments, all of which have
3084      to be keyword arguments.  */
3085   for (; a; a = a->next)
3086     {
3087       for (f = formal; f; f = f->next)
3088         if (strcmp (a->name, f->name) == 0)
3089           break;
3090
3091       if (f == NULL)
3092         {
3093           if (a->name[0] == '%')
3094             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3095                        "are not allowed in this context at %L", where);
3096           else
3097             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3098                        a->name, name, where);
3099           return FAILURE;
3100         }
3101
3102       if (f->actual != NULL)
3103         {
3104           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3105                      f->name, name, where);
3106           return FAILURE;
3107         }
3108
3109       f->actual = a;
3110     }
3111
3112 optional:
3113   /* At this point, all unmatched formal args must be optional.  */
3114   for (f = formal; f; f = f->next)
3115     {
3116       if (f->actual == NULL && f->optional == 0)
3117         {
3118           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3119                      f->name, name, where);
3120           return FAILURE;
3121         }
3122     }
3123
3124 do_sort:
3125   /* Using the formal argument list, string the actual argument list
3126      together in a way that corresponds with the formal list.  */
3127   actual = NULL;
3128
3129   for (f = formal; f; f = f->next)
3130     {
3131       if (f->actual && f->actual->label != NULL && f->ts.type)
3132         {
3133           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3134           return FAILURE;
3135         }
3136
3137       if (f->actual == NULL)
3138         {
3139           a = gfc_get_actual_arglist ();
3140           a->missing_arg_type = f->ts.type;
3141         }
3142       else
3143         a = f->actual;
3144
3145       if (actual == NULL)
3146         *ap = a;
3147       else
3148         actual->next = a;
3149
3150       actual = a;
3151     }
3152   actual->next = NULL;          /* End the sorted argument list.  */
3153
3154   return SUCCESS;
3155 }
3156
3157
3158 /* Compare an actual argument list with an intrinsic's formal argument
3159    list.  The lists are checked for agreement of type.  We don't check
3160    for arrayness here.  */
3161
3162 static gfc_try
3163 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3164                int error_flag)
3165 {
3166   gfc_actual_arglist *actual;
3167   gfc_intrinsic_arg *formal;
3168   int i;
3169
3170   formal = sym->formal;
3171   actual = *ap;
3172
3173   i = 0;
3174   for (; formal; formal = formal->next, actual = actual->next, i++)
3175     {
3176       gfc_typespec ts;
3177
3178       if (actual->expr == NULL)
3179         continue;
3180
3181       ts = formal->ts;
3182
3183       /* A kind of 0 means we don't check for kind.  */
3184       if (ts.kind == 0)
3185         ts.kind = actual->expr->ts.kind;
3186
3187       if (!gfc_compare_types (&ts, &actual->expr->ts))
3188         {
3189           if (error_flag)
3190             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3191                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3192                        gfc_current_intrinsic, &actual->expr->where,
3193                        gfc_typename (&formal->ts),
3194                        gfc_typename (&actual->expr->ts));
3195           return FAILURE;
3196         }
3197     }
3198
3199   return SUCCESS;
3200 }
3201
3202
3203 /* Given a pointer to an intrinsic symbol and an expression node that
3204    represent the function call to that subroutine, figure out the type
3205    of the result.  This may involve calling a resolution subroutine.  */
3206
3207 static void
3208 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3209 {
3210   gfc_expr *a1, *a2, *a3, *a4, *a5;
3211   gfc_actual_arglist *arg;
3212
3213   if (specific->resolve.f1 == NULL)
3214     {
3215       if (e->value.function.name == NULL)
3216         e->value.function.name = specific->lib_name;
3217
3218       if (e->ts.type == BT_UNKNOWN)
3219         e->ts = specific->ts;
3220       return;
3221     }
3222
3223   arg = e->value.function.actual;
3224
3225   /* Special case hacks for MIN and MAX.  */
3226   if (specific->resolve.f1m == gfc_resolve_max
3227       || specific->resolve.f1m == gfc_resolve_min)
3228     {
3229       (*specific->resolve.f1m) (e, arg);
3230       return;
3231     }
3232
3233   if (arg == NULL)
3234     {
3235       (*specific->resolve.f0) (e);
3236       return;
3237     }
3238
3239   a1 = arg->expr;
3240   arg = arg->next;
3241
3242   if (arg == NULL)
3243     {
3244       (*specific->resolve.f1) (e, a1);
3245       return;
3246     }
3247
3248   a2 = arg->expr;
3249   arg = arg->next;
3250
3251   if (arg == NULL)
3252     {
3253       (*specific->resolve.f2) (e, a1, a2);
3254       return;
3255     }
3256
3257   a3 = arg->expr;
3258   arg = arg->next;
3259
3260   if (arg == NULL)
3261     {
3262       (*specific->resolve.f3) (e, a1, a2, a3);
3263       return;
3264     }
3265
3266   a4 = arg->expr;
3267   arg = arg->next;
3268
3269   if (arg == NULL)
3270     {
3271       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3272       return;
3273     }
3274
3275   a5 = arg->expr;
3276   arg = arg->next;
3277
3278   if (arg == NULL)
3279     {
3280       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3281       return;
3282     }
3283
3284   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3285 }
3286
3287
3288 /* Given an intrinsic symbol node and an expression node, call the
3289    simplification function (if there is one), perhaps replacing the
3290    expression with something simpler.  We return FAILURE on an error
3291    of the simplification, SUCCESS if the simplification worked, even
3292    if nothing has changed in the expression itself.  */
3293
3294 static gfc_try
3295 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3296 {
3297   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3298   gfc_actual_arglist *arg;
3299
3300   /* Max and min require special handling due to the variable number
3301      of args.  */
3302   if (specific->simplify.f1 == gfc_simplify_min)
3303     {
3304       result = gfc_simplify_min (e);
3305       goto finish;
3306     }
3307
3308   if (specific->simplify.f1 == gfc_simplify_max)
3309     {
3310       result = gfc_simplify_max (e);
3311       goto finish;
3312     }
3313
3314   if (specific->simplify.f1 == NULL)
3315     {
3316       result = NULL;
3317       goto finish;
3318     }
3319
3320   arg = e->value.function.actual;
3321
3322   if (arg == NULL)
3323     {
3324       result = (*specific->simplify.f0) ();
3325       goto finish;
3326     }
3327
3328   a1 = arg->expr;
3329   arg = arg->next;
3330
3331   if (specific->simplify.cc == gfc_convert_constant
3332       || specific->simplify.cc == gfc_convert_char_constant)
3333     {
3334       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3335       goto finish;
3336     }
3337
3338   /* TODO: Warn if -pedantic and initialization expression and arg
3339      types not integer or character */
3340
3341   if (arg == NULL)
3342     result = (*specific->simplify.f1) (a1);
3343   else
3344     {
3345       a2 = arg->expr;
3346       arg = arg->next;
3347
3348       if (arg == NULL)
3349         result = (*specific->simplify.f2) (a1, a2);
3350       else
3351         {
3352           a3 = arg->expr;
3353           arg = arg->next;
3354
3355           if (arg == NULL)
3356             result = (*specific->simplify.f3) (a1, a2, a3);
3357           else
3358             {
3359               a4 = arg->expr;
3360               arg = arg->next;
3361
3362               if (arg == NULL)
3363                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3364               else
3365                 {
3366                   a5 = arg->expr;
3367                   arg = arg->next;
3368
3369                   if (arg == NULL)
3370                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3371                   else
3372                     gfc_internal_error
3373                       ("do_simplify(): Too many args for intrinsic");
3374                 }
3375             }
3376         }
3377     }
3378
3379 finish:
3380   if (result == &gfc_bad_expr)
3381     return FAILURE;
3382
3383   if (result == NULL)
3384     resolve_intrinsic (specific, e);    /* Must call at run-time */
3385   else
3386     {
3387       result->where = e->where;
3388       gfc_replace_expr (e, result);
3389     }
3390
3391   return SUCCESS;
3392 }
3393
3394
3395 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3396    error messages.  This subroutine returns FAILURE if a subroutine
3397    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3398    list cannot match any intrinsic.  */
3399
3400 static void
3401 init_arglist (gfc_intrinsic_sym *isym)
3402 {
3403   gfc_intrinsic_arg *formal;
3404   int i;
3405
3406   gfc_current_intrinsic = isym->name;
3407
3408   i = 0;
3409   for (formal = isym->formal; formal; formal = formal->next)
3410     {
3411       if (i >= MAX_INTRINSIC_ARGS)
3412         gfc_internal_error ("init_arglist(): too many arguments");
3413       gfc_current_intrinsic_arg[i++] = formal->name;
3414     }
3415 }
3416
3417
3418 /* Given a pointer to an intrinsic symbol and an expression consisting
3419    of a function call, see if the function call is consistent with the
3420    intrinsic's formal argument list.  Return SUCCESS if the expression
3421    and intrinsic match, FAILURE otherwise.  */
3422
3423 static gfc_try
3424 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3425 {
3426   gfc_actual_arglist *arg, **ap;
3427   gfc_try t;
3428
3429   ap = &expr->value.function.actual;
3430
3431   init_arglist (specific);
3432
3433   /* Don't attempt to sort the argument list for min or max.  */
3434   if (specific->check.f1m == gfc_check_min_max
3435       || specific->check.f1m == gfc_check_min_max_integer
3436       || specific->check.f1m == gfc_check_min_max_real
3437       || specific->check.f1m == gfc_check_min_max_double)
3438     return (*specific->check.f1m) (*ap);
3439
3440   if (sort_actual (specific->name, ap, specific->formal,
3441                    &expr->where) == FAILURE)
3442     return FAILURE;
3443
3444   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3445     /* This is special because we might have to reorder the argument list.  */
3446     t = gfc_check_minloc_maxloc (*ap);
3447   else if (specific->check.f3red == gfc_check_minval_maxval)
3448     /* This is also special because we also might have to reorder the
3449        argument list.  */
3450     t = gfc_check_minval_maxval (*ap);
3451   else if (specific->check.f3red == gfc_check_product_sum)
3452     /* Same here. The difference to the previous case is that we allow a
3453        general numeric type.  */
3454     t = gfc_check_product_sum (*ap);
3455   else
3456      {
3457        if (specific->check.f1 == NULL)
3458          {
3459            t = check_arglist (ap, specific, error_flag);
3460            if (t == SUCCESS)
3461              expr->ts = specific->ts;
3462          }
3463        else
3464          t = do_check (specific, *ap);
3465      }
3466
3467   /* Check conformance of elemental intrinsics.  */
3468   if (t == SUCCESS && specific->elemental)
3469     {
3470       int n = 0;
3471       gfc_expr *first_expr;
3472       arg = expr->value.function.actual;
3473
3474       /* There is no elemental intrinsic without arguments.  */
3475       gcc_assert(arg != NULL);
3476       first_expr = arg->expr;
3477
3478       for ( ; arg && arg->expr; arg = arg->next, n++)
3479         {
3480           char buffer[80];
3481           snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3482                     gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3483                     gfc_current_intrinsic);
3484           if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3485             return FAILURE;
3486         }
3487     }
3488
3489   if (t == FAILURE)
3490     remove_nullargs (ap);
3491
3492   return t;
3493 }
3494
3495
3496 /* Check whether an intrinsic belongs to whatever standard the user
3497    has chosen, taking also into account -fall-intrinsics.  Here, no
3498    warning/error is emitted; but if symstd is not NULL, it is pointed to a
3499    textual representation of the symbols standard status (like
3500    "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3501    can be used to construct a detailed warning/error message in case of
3502    a FAILURE.  */
3503
3504 gfc_try
3505 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3506                               const char** symstd, bool silent, locus where)
3507 {
3508   const char* symstd_msg;
3509
3510   /* For -fall-intrinsics, just succeed.  */
3511   if (gfc_option.flag_all_intrinsics)
3512     return SUCCESS;
3513
3514   /* Find the symbol's standard message for later usage.  */
3515   switch (isym->standard)
3516     {
3517     case GFC_STD_F77:
3518       symstd_msg = "available since Fortran 77";
3519       break;
3520
3521     case GFC_STD_F95_OBS:
3522       symstd_msg = "obsolescent in Fortran 95";
3523       break;
3524
3525     case GFC_STD_F95_DEL:
3526       symstd_msg = "deleted in Fortran 95";
3527       break;
3528
3529     case GFC_STD_F95:
3530       symstd_msg = "new in Fortran 95";
3531       break;
3532
3533     case GFC_STD_F2003:
3534       symstd_msg = "new in Fortran 2003";
3535       break;
3536
3537     case GFC_STD_F2008:
3538       symstd_msg = "new in Fortran 2008";
3539       break;
3540
3541     case GFC_STD_GNU:
3542       symstd_msg = "a GNU Fortran extension";
3543       break;
3544
3545     case GFC_STD_LEGACY:
3546       symstd_msg = "for backward compatibility";
3547       break;
3548
3549     default:
3550       gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3551                           isym->name, isym->standard);
3552     }
3553
3554   /* If warning about the standard, warn and succeed.  */
3555   if (gfc_option.warn_std & isym->standard)
3556     {
3557       /* Do only print a warning if not a GNU extension.  */
3558       if (!silent && isym->standard != GFC_STD_GNU)
3559         gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3560                      isym->name, _(symstd_msg), &where);
3561
3562       return SUCCESS;
3563     }
3564
3565   /* If allowing the symbol's standard, succeed, too.  */
3566   if (gfc_option.allow_std & isym->standard)
3567     return SUCCESS;
3568
3569   /* Otherwise, fail.  */
3570   if (symstd)
3571     *symstd = _(symstd_msg);
3572   return FAILURE;
3573 }
3574
3575
3576 /* See if a function call corresponds to an intrinsic function call.
3577    We return:
3578
3579     MATCH_YES    if the call corresponds to an intrinsic, simplification
3580                  is done if possible.
3581
3582     MATCH_NO     if the call does not correspond to an intrinsic
3583
3584     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3585                  error during the simplification process.
3586
3587    The error_flag parameter enables an error reporting.  */
3588
3589 match
3590 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3591 {
3592   gfc_intrinsic_sym *isym, *specific;
3593   gfc_actual_arglist *actual;
3594   const char *name;
3595   int flag;
3596
3597   if (expr->value.function.isym != NULL)
3598     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3599            ? MATCH_ERROR : MATCH_YES;
3600
3601   if (!error_flag)
3602     gfc_push_suppress_errors ();
3603   flag = 0;
3604
3605   for (actual = expr->value.function.actual; actual; actual = actual->next)
3606     if (actual->expr != NULL)
3607       flag |= (actual->expr->ts.type != BT_INTEGER
3608                && actual->expr->ts.type != BT_CHARACTER);
3609
3610   name = expr->symtree->n.sym->name;
3611
3612   isym = specific = gfc_find_function (name);
3613   if (isym == NULL)
3614     {
3615       if (!error_flag)
3616         gfc_pop_suppress_errors ();
3617       return MATCH_NO;
3618     }
3619
3620   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3621        || isym->id == GFC_ISYM_CMPLX)
3622       && gfc_init_expr
3623       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3624                          "as initialization expression at %L", name,
3625                          &expr->where) == FAILURE)
3626     {
3627       if (!error_flag)
3628         gfc_pop_suppress_errors ();
3629       return MATCH_ERROR;
3630     }
3631
3632   gfc_current_intrinsic_where = &expr->where;
3633
3634   /* Bypass the generic list for min and max.  */
3635   if (isym->check.f1m == gfc_check_min_max)
3636     {
3637       init_arglist (isym);
3638
3639       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3640         goto got_specific;
3641
3642       if (!error_flag)
3643         gfc_pop_suppress_errors ();
3644       return MATCH_NO;
3645     }
3646
3647   /* If the function is generic, check all of its specific
3648      incarnations.  If the generic name is also a specific, we check
3649      that name last, so that any error message will correspond to the
3650      specific.  */
3651   gfc_push_suppress_errors ();
3652
3653   if (isym->generic)
3654     {
3655       for (specific = isym->specific_head; specific;
3656            specific = specific->next)
3657         {
3658           if (specific == isym)
3659             continue;
3660           if (check_specific (specific, expr, 0) == SUCCESS)
3661             {
3662               gfc_pop_suppress_errors ();
3663               goto got_specific;
3664             }
3665         }
3666     }
3667
3668   gfc_pop_suppress_errors ();
3669
3670   if (check_specific (isym, expr, error_flag) == FAILURE)
3671     {
3672       if (!error_flag)
3673         gfc_pop_suppress_errors ();
3674       return MATCH_NO;
3675     }
3676
3677   specific = isym;
3678
3679 got_specific:
3680   expr->value.function.isym = specific;
3681   gfc_intrinsic_symbol (expr->symtree->n.sym);
3682
3683   if (!error_flag)
3684     gfc_pop_suppress_errors ();
3685
3686   if (do_simplify (specific, expr) == FAILURE)
3687     return MATCH_ERROR;
3688
3689   /* F95, 7.1.6.1, Initialization expressions
3690      (4) An elemental intrinsic function reference of type integer or
3691          character where each argument is an initialization expression
3692          of type integer or character
3693
3694      F2003, 7.1.7 Initialization expression
3695      (4)   A reference to an elemental standard intrinsic function,
3696            where each argument is an initialization expression  */
3697
3698   if (gfc_init_expr && isym->elemental && flag
3699       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3700                         "as initialization expression with non-integer/non-"
3701                         "character arguments at %L", &expr->where) == FAILURE)
3702     return MATCH_ERROR;
3703
3704   return MATCH_YES;
3705 }
3706
3707
3708 /* See if a CALL statement corresponds to an intrinsic subroutine.
3709    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3710    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3711    correspond).  */
3712
3713 match
3714 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3715 {
3716   gfc_intrinsic_sym *isym;
3717   const char *name;
3718
3719   name = c->symtree->n.sym->name;
3720
3721   isym = gfc_find_subroutine (name);
3722   if (isym == NULL)
3723     return MATCH_NO;
3724
3725   if (!error_flag)
3726     gfc_push_suppress_errors ();
3727
3728   init_arglist (isym);
3729
3730   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3731     goto fail;
3732
3733   if (isym->check.f1 != NULL)
3734     {
3735       if (do_check (isym, c->ext.actual) == FAILURE)
3736         goto fail;
3737     }
3738   else
3739     {
3740       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3741         goto fail;
3742     }
3743
3744   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3745      seen at this point.  */
3746   if (!error_flag)
3747     gfc_pop_suppress_errors ();
3748
3749   c->resolved_isym = isym;
3750   if (isym->resolve.s1 != NULL)
3751     isym->resolve.s1 (c);
3752   else
3753     {
3754       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3755       c->resolved_sym->attr.elemental = isym->elemental;
3756     }
3757
3758   if (gfc_pure (NULL) && !isym->elemental)
3759     {
3760       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3761                  &c->loc);
3762       return MATCH_ERROR;
3763     }
3764
3765   c->resolved_sym->attr.noreturn = isym->noreturn;
3766
3767   return MATCH_YES;
3768
3769 fail:
3770   if (!error_flag)
3771     gfc_pop_suppress_errors ();
3772   return MATCH_NO;
3773 }
3774
3775
3776 /* Call gfc_convert_type() with warning enabled.  */
3777
3778 gfc_try
3779 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3780 {
3781   return gfc_convert_type_warn (expr, ts, eflag, 1);
3782 }
3783
3784
3785 /* Try to convert an expression (in place) from one type to another.
3786    'eflag' controls the behavior on error.
3787
3788    The possible values are:
3789
3790      1 Generate a gfc_error()
3791      2 Generate a gfc_internal_error().
3792
3793    'wflag' controls the warning related to conversion.  */
3794
3795 gfc_try
3796 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3797 {
3798   gfc_intrinsic_sym *sym;
3799   gfc_typespec from_ts;
3800   locus old_where;
3801   gfc_expr *new_expr;
3802   int rank;
3803   mpz_t *shape;
3804
3805   from_ts = expr->ts;           /* expr->ts gets clobbered */
3806
3807   if (ts->type == BT_UNKNOWN)
3808     goto bad;
3809
3810   /* NULL and zero size arrays get their type here.  */
3811   if (expr->expr_type == EXPR_NULL
3812       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3813     {
3814       /* Sometimes the RHS acquire the type.  */
3815       expr->ts = *ts;
3816       return SUCCESS;
3817     }
3818
3819   if (expr->ts.type == BT_UNKNOWN)
3820     goto bad;
3821
3822   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3823       && gfc_compare_types (&expr->ts, ts))
3824     return SUCCESS;
3825
3826   sym = find_conv (&expr->ts, ts);
3827   if (sym == NULL)
3828     goto bad;
3829
3830   /* At this point, a conversion is necessary. A warning may be needed.  */
3831   if ((gfc_option.warn_std & sym->standard) != 0)
3832     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3833                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3834   else if (wflag && gfc_option.warn_conversion)
3835     gfc_warning_now ("Conversion from %s to %s at %L",
3836                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3837
3838   /* Insert a pre-resolved function call to the right function.  */
3839   old_where = expr->where;
3840   rank = expr->rank;
3841   shape = expr->shape;
3842
3843   new_expr = gfc_get_expr ();
3844   *new_expr = *expr;
3845
3846   new_expr = gfc_build_conversion (new_expr);
3847   new_expr->value.function.name = sym->lib_name;
3848   new_expr->value.function.isym = sym;
3849   new_expr->where = old_where;
3850   new_expr->rank = rank;
3851   new_expr->shape = gfc_copy_shape (shape, rank);
3852
3853   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3854   new_expr->symtree->n.sym->ts = *ts;
3855   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3856   new_expr->symtree->n.sym->attr.function = 1;
3857   new_expr->symtree->n.sym->attr.elemental = 1;
3858   new_expr->symtree->n.sym->attr.pure = 1;
3859   new_expr->symtree->n.sym->attr.referenced = 1;
3860   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3861   gfc_commit_symbol (new_expr->symtree->n.sym);
3862
3863   *expr = *new_expr;
3864
3865   gfc_free (new_expr);
3866   expr->ts = *ts;
3867
3868   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3869       && do_simplify (sym, expr) == FAILURE)
3870     {
3871
3872       if (eflag == 2)
3873         goto bad;
3874       return FAILURE;           /* Error already generated in do_simplify() */
3875     }
3876
3877   return SUCCESS;
3878
3879 bad:
3880   if (eflag == 1)
3881     {
3882       gfc_error ("Can't convert %s to %s at %L",
3883                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3884       return FAILURE;
3885     }
3886
3887   gfc_internal_error ("Can't convert %s to %s at %L",
3888                       gfc_typename (&from_ts), gfc_typename (ts),
3889                       &expr->where);
3890   /* Not reached */
3891 }
3892
3893
3894 gfc_try
3895 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
3896 {
3897   gfc_intrinsic_sym *sym;
3898   gfc_typespec from_ts;
3899   locus old_where;
3900   gfc_expr *new_expr;
3901   int rank;
3902   mpz_t *shape;
3903
3904   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
3905   from_ts = expr->ts;           /* expr->ts gets clobbered */
3906
3907   sym = find_char_conv (&expr->ts, ts);
3908   gcc_assert (sym);
3909
3910   /* Insert a pre-resolved function call to the right function.  */
3911   old_where = expr->where;
3912   rank = expr->rank;
3913   shape = expr->shape;
3914
3915   new_expr = gfc_get_expr ();
3916   *new_expr = *expr;
3917
3918   new_expr = gfc_build_conversion (new_expr);
3919   new_expr->value.function.name = sym->lib_name;
3920   new_expr->value.function.isym = sym;
3921   new_expr->where = old_where;
3922   new_expr->rank = rank;
3923   new_expr->shape = gfc_copy_shape (shape, rank);
3924
3925   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3926   new_expr->symtree->n.sym->ts = *ts;
3927   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3928   new_expr->symtree->n.sym->attr.function = 1;
3929   new_expr->symtree->n.sym->attr.elemental = 1;
3930   new_expr->symtree->n.sym->attr.referenced = 1;
3931   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3932   gfc_commit_symbol (new_expr->symtree->n.sym);
3933
3934   *expr = *new_expr;
3935
3936   gfc_free (new_expr);
3937   expr->ts = *ts;
3938
3939   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3940       && do_simplify (sym, expr) == FAILURE)
3941     {
3942       /* Error already generated in do_simplify() */
3943       return FAILURE;
3944     }
3945
3946   return SUCCESS;
3947 }
3948
3949
3950 /* Check if the passed name is name of an intrinsic (taking into account the
3951    current -std=* and -fall-intrinsic settings).  If it is, see if we should
3952    warn about this as a user-procedure having the same name as an intrinsic
3953    (-Wintrinsic-shadow enabled) and do so if we should.  */
3954
3955 void
3956 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
3957 {
3958   gfc_intrinsic_sym* isym;
3959
3960   /* If the warning is disabled, do nothing at all.  */
3961   if (!gfc_option.warn_intrinsic_shadow)
3962     return;
3963
3964   /* Try to find an intrinsic of the same name.  */
3965   if (func)
3966     isym = gfc_find_function (sym->name);
3967   else
3968     isym = gfc_find_subroutine (sym->name);
3969
3970   /* If no intrinsic was found with this name or it's not included in the
3971      selected standard, everything's fine.  */
3972   if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
3973                                              sym->declared_at) == FAILURE)
3974     return;
3975
3976   /* Emit the warning.  */
3977   if (in_module)
3978     gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
3979                  " name.  In order to call the intrinsic, explicit INTRINSIC"
3980                  " declarations may be required.",
3981                  sym->name, &sym->declared_at);
3982   else
3983     gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
3984                  " only be called via an explicit interface or if declared"
3985                  " EXTERNAL.", sym->name, &sym->declared_at);
3986 }