gcc/fortran/intrinsic.c

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