gcc/fortran/intrinsic.c

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