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