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