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_1 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
 950              gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
 951              i, BT_INTEGER, di, REQUIRED);
 952
 953   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
 954
 955   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
 956              gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
 957              x, BT_REAL, dr, REQUIRED);
 958
 959   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
 960              NULL, gfc_simplify_acos, gfc_resolve_acos,
 961              x, BT_REAL, dd, REQUIRED);
 962
 963   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
 964
 965   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
 966              gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh,
 967              x, BT_REAL, dr, REQUIRED);
 968
 969   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
 970              NULL, gfc_simplify_acosh, gfc_resolve_acosh,
 971              x, BT_REAL, dd, REQUIRED);
 972
 973   make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU);
 974
 975   add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
 976              NULL, gfc_simplify_adjustl, NULL,
 977              stg, BT_CHARACTER, dc, REQUIRED);
 978
 979   make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
 980
 981   add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
 982              NULL, gfc_simplify_adjustr, NULL,
 983              stg, BT_CHARACTER, dc, REQUIRED);
 984
 985   make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
 986
 987   add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
 988              gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
 989              z, BT_COMPLEX, dz, REQUIRED);
 990
 991   make_alias ("imag", GFC_STD_GNU);
 992   make_alias ("imagpart", GFC_STD_GNU);
 993
 994   add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
 995              NULL, gfc_simplify_aimag, gfc_resolve_aimag,
 996              z, BT_COMPLEX, dd, REQUIRED);
 997
 998   make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
 999
1000   add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1001              gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1002              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1003
1004   add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1005              NULL, gfc_simplify_dint, gfc_resolve_dint,
1006              a, BT_REAL, dd, REQUIRED);
1007
1008   make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1009
1010   add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1011              gfc_check_all_any, NULL, gfc_resolve_all,
1012              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1013
1014   make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1015
1016   add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1017              gfc_check_allocated, NULL, NULL,
1018              ar, BT_UNKNOWN, 0, REQUIRED);
1019
1020   make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1021
1022   add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1023              gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1024              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1025
1026   add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1027              NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1028              a, BT_REAL, dd, REQUIRED);
1029
1030   make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1031
1032   add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1033              gfc_check_all_any, NULL, gfc_resolve_any,
1034              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1035
1036   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1037
1038   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1039              gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
1040              x, BT_REAL, dr, REQUIRED);
1041
1042   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1043              NULL, gfc_simplify_asin, gfc_resolve_asin,
1044              x, BT_REAL, dd, REQUIRED);
1045
1046   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1047
1048   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1049              gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh,
1050              x, BT_REAL, dr, REQUIRED);
1051
1052   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1053              NULL, gfc_simplify_asinh, gfc_resolve_asinh,
1054              x, BT_REAL, dd, REQUIRED);
1055
1056   make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU);
1057
1058   add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1059              GFC_STD_F95, gfc_check_associated, NULL, NULL,
1060              pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1061
1062   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1063
1064   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1065              gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
1066              x, BT_REAL, dr, REQUIRED);
1067
1068   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1069              NULL, gfc_simplify_atan, gfc_resolve_atan,
1070              x, BT_REAL, dd, REQUIRED);
1071
1072   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1073
1074   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1075              gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh,
1076              x, BT_REAL, dr, REQUIRED);
1077
1078   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1079              NULL, gfc_simplify_atanh, gfc_resolve_atanh,
1080              x, BT_REAL, dd, REQUIRED);
1081
1082   make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU);
1083
1084   add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1085              gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1086              y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1087
1088   add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1089              NULL, gfc_simplify_atan2, gfc_resolve_atan2,
1090              y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1091
1092   make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1093
1094   /* Bessel and Neumann functions for G77 compatibility.  */
1095   add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1096              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1097              x, BT_REAL, dr, REQUIRED);
1098
1099   add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1100              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1101              x, BT_REAL, dd, REQUIRED);
1102
1103   make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
1104
1105   add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1106              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1107              x, BT_REAL, dr, REQUIRED);
1108
1109   add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1110              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1111              x, BT_REAL, dd, REQUIRED);
1112
1113   make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
1114
1115   add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1116              gfc_check_besn, NULL, gfc_resolve_besn,
1117              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1118
1119   add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1120              gfc_check_besn, NULL, gfc_resolve_besn,
1121              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1122
1123   make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU);
1124
1125   add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1126              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1127              x, BT_REAL, dr, REQUIRED);
1128
1129   add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1130              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1131              x, BT_REAL, dd, REQUIRED);
1132
1133   make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
1134
1135   add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1136              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1137              x, BT_REAL, dr, REQUIRED);
1138
1139   add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1140              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1141              x, BT_REAL, dd, REQUIRED);
1142
1143   make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
1144
1145   add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1146              gfc_check_besn, NULL, gfc_resolve_besn,
1147              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1148
1149   add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1150              gfc_check_besn, NULL, gfc_resolve_besn,
1151              n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1152
1153   make_generic ("besyn", GFC_ISYM_YN, GFC_STD_GNU);
1154
1155   add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1156              gfc_check_i, gfc_simplify_bit_size, NULL,
1157              i, BT_INTEGER, di, REQUIRED);
1158
1159   make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1160
1161   add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1162              gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1163              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1164
1165   make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1166
1167   add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1168              gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1169              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1170
1171   make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1172
1173   add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1174              gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1175              i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1176
1177   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1178
1179   add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1180              GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1181              nm, BT_CHARACTER, dc, REQUIRED);
1182
1183   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1184
1185   add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1186              gfc_check_chmod, NULL, gfc_resolve_chmod,
1187              nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1188
1189   make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1190
1191   add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1192              gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1193              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1194              kind, BT_INTEGER, di, OPTIONAL);
1195
1196   make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1197
1198   add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1199              ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1200
1201   make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1202                 GFC_STD_F2003);
1203
1204   add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1205              gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1206              x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1207
1208   make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1209
1210   /* Making dcmplx a specific of cmplx causes cmplx to return a double
1211      complex instead of the default complex.  */
1212
1213   add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1214              gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1215              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1216
1217   make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1218
1219   add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1220              gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1221              z, BT_COMPLEX, dz, REQUIRED);
1222
1223   add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1224              NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1225              z, BT_COMPLEX, dd, REQUIRED);
1226
1227   make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1228
1229   add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1230              gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1231              x, BT_REAL, dr, REQUIRED);
1232
1233   add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1234              gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1235              x, BT_REAL, dd, REQUIRED);
1236
1237   add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1238              NULL, gfc_simplify_cos, gfc_resolve_cos,
1239              x, BT_COMPLEX, dz, REQUIRED);
1240
1241   add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1242              NULL, gfc_simplify_cos, gfc_resolve_cos,
1243              x, BT_COMPLEX, dd, REQUIRED);
1244
1245   make_alias ("cdcos", GFC_STD_GNU);
1246
1247   make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1248
1249   add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1250              gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh,
1251              x, BT_REAL, dr, REQUIRED);
1252
1253   add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1254              NULL, gfc_simplify_cosh, gfc_resolve_cosh,
1255              x, BT_REAL, dd, REQUIRED);
1256
1257   make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1258
1259   add_sym_2 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1260              gfc_check_count, NULL, gfc_resolve_count,
1261              msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1262
1263   make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1264
1265   add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1266              gfc_check_cshift, NULL, gfc_resolve_cshift,
1267              ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1268              dm, BT_INTEGER, ii, OPTIONAL);
1269
1270   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1271
1272   add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1273               gfc_check_ctime, NULL, gfc_resolve_ctime,
1274               tm, BT_INTEGER, di, REQUIRED);
1275
1276   make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1277
1278   add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1279              gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1280              a, BT_REAL, dr, REQUIRED);
1281
1282   make_alias ("dfloat", GFC_STD_GNU);
1283
1284   make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1285
1286   add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1287              gfc_check_digits, gfc_simplify_digits, NULL,
1288              x, BT_UNKNOWN, dr, REQUIRED);
1289
1290   make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1291
1292   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1293              gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1294              x, BT_REAL, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1295
1296   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1297              NULL, gfc_simplify_dim, gfc_resolve_dim,
1298              x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1299
1300   add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1301              NULL, gfc_simplify_dim, gfc_resolve_dim,
1302              x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1303
1304   make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1305
1306   add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1307              GFC_STD_F95, gfc_check_dot_product, NULL, gfc_resolve_dot_product,
1308              va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1309
1310   make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1311
1312   add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1313              NULL, gfc_simplify_dprod, gfc_resolve_dprod,
1314              x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1315
1316   make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1317
1318   add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1319              NULL, NULL, NULL,
1320              a, BT_COMPLEX, dd, REQUIRED);
1321
1322   make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1323
1324   add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1325              gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1326              ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1327              bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1328
1329   make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1330
1331   add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1332              gfc_check_x, gfc_simplify_epsilon, NULL,
1333              x, BT_REAL, dr, REQUIRED);
1334
1335   make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1336
1337   /* G77 compatibility for the ERF() and ERFC() functions.  */
1338   add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1339              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1340              x, BT_REAL, dr, REQUIRED);
1341
1342   add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1343              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1344              x, BT_REAL, dd, REQUIRED);
1345
1346   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
1347
1348   add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1349              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1350              x, BT_REAL, dr, REQUIRED);
1351
1352   add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1353              gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1354              x, BT_REAL, dd, REQUIRED);
1355
1356   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
1357
1358   /* G77 compatibility */
1359   add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4,  GFC_STD_GNU,
1360              gfc_check_etime, NULL, NULL,
1361              x, BT_REAL, 4, REQUIRED);
1362
1363   make_alias ("dtime", GFC_STD_GNU);
1364
1365   make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1366
1367   add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
1368              gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1369              x, BT_REAL, dr, REQUIRED);
1370
1371   add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1372              NULL, gfc_simplify_exp, gfc_resolve_exp,
1373              x, BT_REAL, dd, REQUIRED);
1374
1375   add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1376              NULL, gfc_simplify_exp, gfc_resolve_exp,
1377              x, BT_COMPLEX, dz, REQUIRED);
1378
1379   add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1380              NULL, gfc_simplify_exp, gfc_resolve_exp,
1381              x, BT_COMPLEX, dd, REQUIRED);
1382
1383   make_alias ("cdexp", GFC_STD_GNU);
1384
1385   make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1386
1387   add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1388              gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1389              x, BT_REAL, dr, REQUIRED);
1390
1391   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1392
1393   add_sym_0 ("fdate",  GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1394              NULL, NULL, gfc_resolve_fdate);
1395
1396   make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1397
1398   add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1399              gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1400              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1401
1402   make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1403
1404   /* G77 compatible fnum */
1405   add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1406              gfc_check_fnum, NULL, gfc_resolve_fnum,
1407              ut, BT_INTEGER, di, REQUIRED);
1408
1409   make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1410
1411   add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1412              gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1413              x, BT_REAL, dr, REQUIRED);
1414
1415   make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1416
1417   add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1418              gfc_check_fstat, NULL, gfc_resolve_fstat,
1419              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1420
1421   make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1422
1423   add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1424              gfc_check_ftell, NULL, gfc_resolve_ftell,
1425              ut, BT_INTEGER, di, REQUIRED);
1426
1427   make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1428
1429   add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1430              gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1431              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1432
1433   make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1434
1435   add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1436              gfc_check_fgetput, NULL, gfc_resolve_fget,
1437              c, BT_CHARACTER, dc, REQUIRED);
1438
1439   make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1440
1441   add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1442              gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1443              ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1444
1445   make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1446
1447   add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1448              gfc_check_fgetput, NULL, gfc_resolve_fput,
1449              c, BT_CHARACTER, dc, REQUIRED);
1450
1451   make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1452
1453   /* Unix IDs (g77 compatibility)  */
1454   add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,  GFC_STD_GNU,
1455              NULL, NULL, gfc_resolve_getcwd,
1456              c, BT_CHARACTER, dc, REQUIRED);
1457
1458   make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1459
1460   add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1461              NULL, NULL, gfc_resolve_getgid);
1462
1463   make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1464
1465   add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1466              NULL, NULL, gfc_resolve_getpid);
1467
1468   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1469
1470   add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1471              NULL, NULL, gfc_resolve_getuid);
1472
1473   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1474
1475   add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1476              gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1477              a, BT_CHARACTER, dc, REQUIRED);
1478
1479   make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1480
1481   add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1482              gfc_check_huge, gfc_simplify_huge, NULL,
1483              x, BT_UNKNOWN, dr, REQUIRED);
1484
1485   make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1486
1487   add_sym_1 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1488              gfc_check_ichar_iachar, gfc_simplify_iachar, NULL,
1489              c, BT_CHARACTER, dc, REQUIRED);
1490
1491   make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1492
1493   add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1494              gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1495              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1496
1497   make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1498
1499   add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1500              gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1501              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1502
1503   make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1504
1505   add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1506              NULL, NULL, NULL);
1507
1508   make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1509
1510   add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1511              gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1512              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1513
1514   make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1515
1516   add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1517              gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1518              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1519              ln, BT_INTEGER, di, REQUIRED);
1520
1521   make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1522
1523   add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1524              gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1525              i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1526
1527   make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1528
1529   add_sym_1 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1530              gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1531              c, BT_CHARACTER, dc, REQUIRED);
1532
1533   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1534
1535   add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1536              gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1537              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1538
1539   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1540
1541   add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1542              gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1543              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1544
1545   make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1546
1547   add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1548              NULL, NULL, gfc_resolve_ierrno);
1549
1550   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1551
1552   /* The resolution function for INDEX is called gfc_resolve_index_func
1553      because the name gfc_resolve_index is already used in resolve.c.  */
1554   add_sym_3 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1555              gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1556              stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1557              bck, BT_LOGICAL, dl, OPTIONAL);
1558
1559   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1560
1561   add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1562              gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1563              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1564
1565   add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1566              NULL, gfc_simplify_ifix, NULL,
1567              a, BT_REAL, dr, REQUIRED);
1568
1569   add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1570              NULL, gfc_simplify_idint, NULL,
1571              a, BT_REAL, dd, REQUIRED);
1572
1573   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1574
1575   add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1576              gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1577              a, BT_REAL, dr, REQUIRED);
1578
1579   make_alias ("short", GFC_STD_GNU);
1580
1581   make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1582
1583   add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1584              gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1585              a, BT_REAL, dr, REQUIRED);
1586
1587   make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1588
1589   add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1590              gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1591              a, BT_REAL, dr, REQUIRED);
1592
1593   make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1594
1595   add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1596              gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1597              i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1598
1599   make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1600
1601   add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1602              gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1603              i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1604
1605   make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1606
1607   /* The following function is for G77 compatibility.  */
1608   add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1609              gfc_check_irand, NULL, NULL,
1610              i, BT_INTEGER, 4, OPTIONAL);
1611
1612   make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1613
1614   add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1615              gfc_check_isatty, NULL, gfc_resolve_isatty,
1616              ut, BT_INTEGER, di, REQUIRED);
1617
1618   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1619
1620   add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL,
1621              dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL,
1622              x, BT_REAL, 0, REQUIRED);
1623
1624   make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1625
1626   add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1627              gfc_check_ishft, NULL, gfc_resolve_rshift,
1628              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1629
1630   make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1631
1632   add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1633              gfc_check_ishft, NULL, gfc_resolve_lshift,
1634              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1635
1636   make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1637
1638   add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1639              gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1640              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1641
1642   make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1643
1644   add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1645              gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1646              i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1647              sz, BT_INTEGER, di, OPTIONAL);
1648
1649   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1650
1651   add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1652              gfc_check_kill, NULL, gfc_resolve_kill,
1653              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1654
1655   make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1656
1657   add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1658              gfc_check_kind, gfc_simplify_kind, NULL,
1659              x, BT_REAL, dr, REQUIRED);
1660
1661   make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1662
1663   add_sym_2 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1664              gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1665              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL);
1666
1667   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1668
1669   add_sym_1 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1670              NULL, gfc_simplify_len, gfc_resolve_len,
1671              stg, BT_CHARACTER, dc, REQUIRED);
1672
1673   make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1674
1675   add_sym_1 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1676              NULL, gfc_simplify_len_trim, gfc_resolve_len_trim,
1677              stg, BT_CHARACTER, dc, REQUIRED);
1678
1679   make_alias ("lnblnk", GFC_STD_GNU);
1680
1681   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1682
1683   add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1684              NULL, gfc_simplify_lge, NULL,
1685              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1686
1687   make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1688
1689   add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1690              NULL, gfc_simplify_lgt, NULL,
1691              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1692
1693   make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1694
1695   add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1696              NULL, gfc_simplify_lle, NULL,
1697              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1698
1699   make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1700
1701   add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1702              NULL, gfc_simplify_llt, NULL,
1703              sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1704
1705   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1706
1707   add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1708              gfc_check_link, NULL, gfc_resolve_link,
1709              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
1710
1711   make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1712
1713   add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1714              gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1715              x, BT_REAL, dr, REQUIRED);
1716
1717   add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1718              NULL, gfc_simplify_log, gfc_resolve_log,
1719              x, BT_REAL, dr, REQUIRED);
1720
1721   add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1722              NULL, gfc_simplify_log, gfc_resolve_log,
1723              x, BT_REAL, dd, REQUIRED);
1724
1725   add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1726              NULL, gfc_simplify_log, gfc_resolve_log,
1727              x, BT_COMPLEX, dz, REQUIRED);
1728
1729   add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
1730              NULL, gfc_simplify_log, gfc_resolve_log,
1731              x, BT_COMPLEX, dd, REQUIRED);
1732
1733   make_alias ("cdlog", GFC_STD_GNU);
1734
1735   make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
1736
1737   add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1738              gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1739              x, BT_REAL, dr, REQUIRED);
1740
1741   add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1742              NULL, gfc_simplify_log10, gfc_resolve_log10,
1743              x, BT_REAL, dr, REQUIRED);
1744
1745   add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1746              NULL, gfc_simplify_log10, gfc_resolve_log10,
1747              x, BT_REAL, dd, REQUIRED);
1748
1749   make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
1750
1751   add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1752              gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1753              l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1754
1755   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
1756
1757   add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1758              gfc_check_stat, NULL, gfc_resolve_lstat,
1759              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1760
1761   make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
1762
1763   add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1764              gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di,
1765              REQUIRED);
1766
1767   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1768
1769   add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1770              gfc_check_matmul, NULL, gfc_resolve_matmul,
1771              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1772
1773   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1774
1775   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1776      int(max).  The max function must take at least two arguments.  */
1777
1778   add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1779              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1780              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1781
1782   add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1783              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1784              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1785
1786   add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1787              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1788              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1789
1790   add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1791              gfc_check_min_max_real, gfc_simplify_max, NULL,
1792              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1793
1794   add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1795              gfc_check_min_max_real, gfc_simplify_max, NULL,
1796              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1797
1798   add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1799              gfc_check_min_max_double, gfc_simplify_max, NULL,
1800              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1801
1802   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1803
1804   add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1805              GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1806              x, BT_UNKNOWN, dr, REQUIRED);
1807
1808   make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
1809
1810   add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1811                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1812                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1813                msk, BT_LOGICAL, dl, OPTIONAL);
1814
1815   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1816
1817   add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1818                 gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
1819                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1820                 msk, BT_LOGICAL, dl, OPTIONAL);
1821
1822   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1823
1824   add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1825              NULL, NULL, gfc_resolve_mclock);
1826
1827   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1828
1829   add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1830              NULL, NULL, gfc_resolve_mclock8);
1831
1832   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1833
1834   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1835              gfc_check_merge, NULL, gfc_resolve_merge,
1836              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1837              msk, BT_LOGICAL, dl, REQUIRED);
1838
1839   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1840
1841   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1842      int(min).  */
1843
1844   add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1845               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1846               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1847
1848   add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1849               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1850               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1851
1852   add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1853               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1854               a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1855
1856   add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1857               gfc_check_min_max_real, gfc_simplify_min, NULL,
1858               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1859
1860   add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1861               gfc_check_min_max_real, gfc_simplify_min, NULL,
1862               a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1863
1864   add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1865               gfc_check_min_max_double, gfc_simplify_min, NULL,
1866               a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1867
1868   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
1869
1870   add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1871              GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
1872              x, BT_UNKNOWN, dr, REQUIRED);
1873
1874   make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
1875
1876   add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1877                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
1878                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1879                msk, BT_LOGICAL, dl, OPTIONAL);
1880
1881   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
1882
1883   add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1884                 gfc_check_minval_maxval, NULL, gfc_resolve_minval,
1885                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1886                 msk, BT_LOGICAL, dl, OPTIONAL);
1887
1888   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
1889
1890   add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1891              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1892              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
1893
1894   add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1895              NULL, gfc_simplify_mod, gfc_resolve_mod,
1896              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
1897
1898   add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1899              NULL, gfc_simplify_mod, gfc_resolve_mod,
1900              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
1901
1902   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
1903
1904   add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
1905              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1906              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
1907
1908   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
1909
1910   add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1911              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1912              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
1913
1914   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
1915
1916   add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
1917              GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
1918              a, BT_CHARACTER, dc, REQUIRED);
1919
1920   make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
1921
1922   add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1923              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1924              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1925
1926   add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1927              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1928              a, BT_REAL, dd, REQUIRED);
1929
1930   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
1931
1932   add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1933              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1934              i, BT_INTEGER, di, REQUIRED);
1935
1936   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
1937
1938   add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1939              gfc_check_null, gfc_simplify_null, NULL,
1940              mo, BT_INTEGER, di, OPTIONAL);
1941
1942   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
1943
1944   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1945              gfc_check_pack, NULL, gfc_resolve_pack,
1946              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
1947              v, BT_REAL, dr, OPTIONAL);
1948
1949   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
1950
1951   add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1952              gfc_check_precision, gfc_simplify_precision, NULL,
1953              x, BT_UNKNOWN, 0, REQUIRED);
1954
1955   make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
1956
1957   add_sym_1 ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1958              gfc_check_present, NULL, NULL,
1959              a, BT_REAL, dr, REQUIRED);
1960
1961   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
1962
1963   add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1964                 gfc_check_product_sum, NULL, gfc_resolve_product,
1965                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1966                 msk, BT_LOGICAL, dl, OPTIONAL);
1967
1968   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
1969
1970   add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1971              gfc_check_radix, gfc_simplify_radix, NULL,
1972              x, BT_UNKNOWN, 0, REQUIRED);
1973
1974   make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
1975
1976   /* The following function is for G77 compatibility.  */
1977   add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1978              gfc_check_rand, NULL, NULL,
1979              i, BT_INTEGER, 4, OPTIONAL);
1980
1981   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
1982      use slightly different shoddy multiplicative congruential PRNG.  */
1983   make_alias ("ran", GFC_STD_GNU);
1984
1985   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
1986
1987   add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1988              gfc_check_range, gfc_simplify_range, NULL,
1989              x, BT_REAL, dr, REQUIRED);
1990
1991   make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
1992
1993   add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1994              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1995              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1996
1997   /* This provides compatibility with g77.  */
1998   add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1999              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2000              a, BT_UNKNOWN, dr, REQUIRED);
2001
2002   add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2003              gfc_check_i, gfc_simplify_float, NULL,
2004              a, BT_INTEGER, di, REQUIRED);
2005
2006   add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2007              NULL, gfc_simplify_sngl, NULL,
2008              a, BT_REAL, dd, REQUIRED);
2009
2010   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2011
2012   add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2013              gfc_check_rename, NULL, gfc_resolve_rename,
2014              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2015
2016   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2017
2018   add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2019              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2020              stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2021
2022   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2023
2024   add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2025              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2026              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2027              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2028
2029   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2030
2031   add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2032              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2033              x, BT_REAL, dr, REQUIRED);
2034
2035   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2036
2037   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2038              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2039              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2040
2041   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2042
2043   add_sym_3 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2044              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2045              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2046              bck, BT_LOGICAL, dl, OPTIONAL);
2047
2048   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2049
2050   /* Added for G77 compatibility garbage.  */
2051   add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2052              NULL, NULL, NULL);
2053
2054   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2055
2056   /* Added for G77 compatibility.  */
2057   add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2058              gfc_check_secnds, NULL, gfc_resolve_secnds,
2059              x, BT_REAL, dr, REQUIRED);
2060
2061   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2062
2063   add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2064              GFC_STD_F95, gfc_check_selected_int_kind,
2065              gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2066
2067   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2068
2069   add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2070              GFC_STD_F95, gfc_check_selected_real_kind,
2071              gfc_simplify_selected_real_kind, NULL,
2072              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2073
2074   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2075
2076   add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2077              gfc_check_set_exponent, gfc_simplify_set_exponent,
2078              gfc_resolve_set_exponent,
2079              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2080
2081   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2082
2083   add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2084              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2085              src, BT_REAL, dr, REQUIRED);
2086
2087   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2088
2089   add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2090              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2091              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2092
2093   add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2094              NULL, gfc_simplify_sign, gfc_resolve_sign,
2095              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2096
2097   add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2098              NULL, gfc_simplify_sign, gfc_resolve_sign,
2099              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2100
2101   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2102
2103   add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2104              gfc_check_signal, NULL, gfc_resolve_signal,
2105              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2106
2107   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2108
2109   add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2110              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2111              x, BT_REAL, dr, REQUIRED);
2112
2113   add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2114              NULL, gfc_simplify_sin, gfc_resolve_sin,
2115              x, BT_REAL, dd, REQUIRED);
2116
2117   add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2118              NULL, gfc_simplify_sin, gfc_resolve_sin,
2119              x, BT_COMPLEX, dz, REQUIRED);
2120
2121   add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2122              NULL, gfc_simplify_sin, gfc_resolve_sin,
2123              x, BT_COMPLEX, dd, REQUIRED);
2124
2125   make_alias ("cdsin", GFC_STD_GNU);
2126
2127   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2128
2129   add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2130              gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2131              x, BT_REAL, dr, REQUIRED);
2132
2133   add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2134              NULL, gfc_simplify_sinh, gfc_resolve_sinh,
2135              x, BT_REAL, dd, REQUIRED);
2136
2137   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2138
2139   add_sym_2 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2140              gfc_check_size, gfc_simplify_size, NULL,
2141              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2142
2143   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2144
2145   add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2146              GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2147              i, BT_UNKNOWN, 0, REQUIRED);
2148
2149   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2150
2151   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2152              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2153              x, BT_REAL, dr, REQUIRED);
2154
2155   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2156
2157   add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2158              gfc_check_spread, NULL, gfc_resolve_spread,
2159              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2160              ncopies, BT_INTEGER, di, REQUIRED);
2161
2162   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2163
2164   add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2165              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2166              x, BT_REAL, dr, REQUIRED);
2167
2168   add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2169              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2170              x, BT_REAL, dd, REQUIRED);
2171
2172   add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2173              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2174              x, BT_COMPLEX, dz, REQUIRED);
2175
2176   add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2177              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2178              x, BT_COMPLEX, dd, REQUIRED);
2179
2180   make_alias ("cdsqrt", GFC_STD_GNU);
2181
2182   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2183
2184   add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2185              gfc_check_stat, NULL, gfc_resolve_stat,
2186              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2187
2188   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2189
2190   add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2191                 gfc_check_product_sum, NULL, gfc_resolve_sum,
2192                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2193                 msk, BT_LOGICAL, dl, OPTIONAL);
2194
2195   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2196
2197   add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2198              gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2199              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2200
2201   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2202
2203   add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2204              NULL, NULL, NULL,
2205              c, BT_CHARACTER, dc, REQUIRED);
2206
2207   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2208
2209   add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2210              gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2211              x, BT_REAL, dr, REQUIRED);
2212
2213   add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2214              NULL, gfc_simplify_tan, gfc_resolve_tan,
2215              x, BT_REAL, dd, REQUIRED);
2216
2217   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2218
2219   add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2220              gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2221              x, BT_REAL, dr, REQUIRED);
2222
2223   add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2224              NULL, gfc_simplify_tanh, gfc_resolve_tanh,
2225              x, BT_REAL, dd, REQUIRED);
2226
2227   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2228
2229   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2230              NULL, NULL, gfc_resolve_time);
2231
2232   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2233
2234   add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2235              NULL, NULL, gfc_resolve_time8);
2236
2237   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2238
2239   add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2240              gfc_check_x, gfc_simplify_tiny, NULL,
2241              x, BT_REAL, dr, REQUIRED);
2242
2243   make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2244
2245   add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2246              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2247              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2248              sz, BT_INTEGER, di, OPTIONAL);
2249
2250   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2251
2252   add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2253              gfc_check_transpose, NULL, gfc_resolve_transpose,
2254              m, BT_REAL, dr, REQUIRED);
2255
2256   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2257
2258   add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2259              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2260              stg, BT_CHARACTER, dc, REQUIRED);
2261
2262   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2263
2264   add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2265              gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2266              ut, BT_INTEGER, di, REQUIRED);
2267
2268   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2269
2270   add_sym_2 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2271              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2272              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2273
2274   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2275
2276   /* g77 compatibility for UMASK.  */
2277   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2278              gfc_check_umask, NULL, gfc_resolve_umask,
2279              a, BT_INTEGER, di, REQUIRED);
2280
2281   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2282
2283   /* g77 compatibility for UNLINK.  */
2284   add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2285              gfc_check_unlink, NULL, gfc_resolve_unlink,
2286              a, BT_CHARACTER, dc, REQUIRED);
2287
2288   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2289
2290   add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2291              gfc_check_unpack, NULL, gfc_resolve_unpack,
2292              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2293              f, BT_REAL, dr, REQUIRED);
2294
2295   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2296
2297   add_sym_3 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2298              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2299              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2300              bck, BT_LOGICAL, dl, OPTIONAL);
2301
2302   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2303
2304   add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
2305              gfc_check_loc, NULL, gfc_resolve_loc,
2306              ar, BT_UNKNOWN, 0, REQUIRED);
2307
2308   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2309 }
2310
2311
2312 /* Add intrinsic subroutines.  */
2313
2314 static void
2315 add_subroutines (void)
2316 {
2317   /* Argument names as in the standard (to be used as argument keywords).  */
2318   const char
2319     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2320     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2321     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2322     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2323     *com = "command", *length = "length", *st = "status",
2324     *val = "value", *num = "number", *name = "name",
2325     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2326     *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2327     *whence = "whence";
2328
2329   int di, dr, dc, dl, ii;
2330
2331   di = gfc_default_integer_kind;
2332   dr = gfc_default_real_kind;
2333   dc = gfc_default_character_kind;
2334   dl = gfc_default_logical_kind;
2335   ii = gfc_index_integer_kind;
2336
2337   add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2338
2339   make_noreturn();
2340
2341   add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2342               gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2343               tm, BT_REAL, dr, REQUIRED);
2344
2345   /* More G77 compatibility garbage.  */
2346   add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2347               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2348               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2349
2350   add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2351               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2352               vl, BT_INTEGER, 4, REQUIRED);
2353
2354   add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2355               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2356               vl, BT_INTEGER, 4, REQUIRED);
2357
2358   add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2359               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2360               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2361
2362   add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2363               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2364               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2365
2366   add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2367               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2368               tm, BT_REAL, dr, REQUIRED);
2369
2370   add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2371               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2372               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2373
2374   add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2375               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2376               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2377               st, BT_INTEGER, di, OPTIONAL);
2378
2379   add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2380               gfc_check_date_and_time, NULL, NULL,
2381               dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2382               zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2383
2384   /* More G77 compatibility garbage.  */
2385   add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2386               gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2387               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2388
2389   add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2390               gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2391               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2392
2393   add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2394               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2395               dt, BT_CHARACTER, dc, REQUIRED);
2396
2397   add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2398               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2399               dc, REQUIRED);
2400
2401   add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2402               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2403               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2404
2405   add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2406               NULL, NULL, NULL,
2407               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2408               REQUIRED);
2409
2410   add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2411               NULL, NULL, gfc_resolve_getarg,
2412               c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2413
2414   add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2415               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2416               dc, REQUIRED);
2417
2418   /* F2003 commandline routines.  */
2419
2420   add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2421               NULL, NULL, gfc_resolve_get_command,
2422               com, BT_CHARACTER, dc, OPTIONAL,
2423               length, BT_INTEGER, di, OPTIONAL,
2424               st, BT_INTEGER, di, OPTIONAL);
2425
2426   add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2427               NULL, NULL, gfc_resolve_get_command_argument,
2428               num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2429               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2430
2431   /* F2003 subroutine to get environment variables.  */
2432
2433   add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2434               NULL, NULL, gfc_resolve_get_environment_variable,
2435               name, BT_CHARACTER, dc, REQUIRED,
2436               val, BT_CHARACTER, dc, OPTIONAL,
2437               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2438               trim_name, BT_LOGICAL, dl, OPTIONAL);
2439
2440   add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2441               gfc_check_move_alloc, NULL, NULL,
2442               f, BT_UNKNOWN, 0, REQUIRED,
2443               t, BT_UNKNOWN, 0, REQUIRED);
2444
2445   add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2446               gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2447               f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2448               ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2449               tp, BT_INTEGER, di, REQUIRED);
2450
2451   add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2452               gfc_check_random_number, NULL, gfc_resolve_random_number,
2453               h, BT_REAL, dr, REQUIRED);
2454
2455   add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2456               gfc_check_random_seed, NULL, NULL,
2457               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2458               gt, BT_INTEGER, di, OPTIONAL);
2459
2460   /* More G77 compatibility garbage.  */
2461   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2462               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2463               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2464               st, BT_INTEGER, di, OPTIONAL);
2465
2466   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2467               gfc_check_srand, NULL, gfc_resolve_srand,
2468               c, BT_INTEGER, 4, REQUIRED);
2469
2470   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2471               gfc_check_exit, NULL, gfc_resolve_exit,
2472               st, BT_INTEGER, di, OPTIONAL);
2473
2474   make_noreturn();
2475
2476   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2477               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2478               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2479               st, BT_INTEGER, di, OPTIONAL);
2480
2481   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2482               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2483               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2484
2485   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2486               gfc_check_flush, NULL, gfc_resolve_flush,
2487               c, BT_INTEGER, di, OPTIONAL);
2488
2489   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2490               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2491               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2492               st, BT_INTEGER, di, OPTIONAL);
2493
2494   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2495               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2496               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2497
2498   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2499               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2500
2501   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2502               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2503               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2504               whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2505
2506   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2507               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2508               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2509
2510   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2511               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2512               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2513
2514   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2515               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2516               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2517
2518   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2519               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2520               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2521               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2522
2523   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2524               gfc_check_perror, NULL, gfc_resolve_perror,
2525               c, BT_CHARACTER, dc, REQUIRED);
2526
2527   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2528               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2529               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2530               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2531
2532   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2533               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2534               val, BT_CHARACTER, dc, REQUIRED);
2535
2536   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2537               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2538               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2539               st, BT_INTEGER, di, OPTIONAL);
2540
2541   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2542               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2543               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2544               st, BT_INTEGER, di, OPTIONAL);
2545
2546   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2547               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2548               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2549               st, BT_INTEGER, di, OPTIONAL);
2550
2551   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2552               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2553               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2554               st, BT_INTEGER, di, OPTIONAL);
2555
2556   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2557               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2558               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2559               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2560
2561   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2562               NULL, NULL, gfc_resolve_system_sub,
2563               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2564
2565   add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2566               gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2567               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2568               cm, BT_INTEGER, di, OPTIONAL);
2569
2570   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2571               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2572               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2573
2574   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2575               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2576               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2577
2578   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2579               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2580               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2581 }
2582
2583
2584 /* Add a function to the list of conversion symbols.  */
2585
2586 static void
2587 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2588 {
2589   gfc_typespec from, to;
2590   gfc_intrinsic_sym *sym;
2591
2592   if (sizing == SZ_CONVS)
2593     {
2594       nconv++;
2595       return;
2596     }
2597
2598   gfc_clear_ts (&from);
2599   from.type = from_type;
2600   from.kind = from_kind;
2601
2602   gfc_clear_ts (&to);
2603   to.type = to_type;
2604   to.kind = to_kind;
2605
2606   sym = conversion + nconv;
2607
2608   sym->name = conv_name (&from, &to);
2609   sym->lib_name = sym->name;
2610   sym->simplify.cc = gfc_convert_constant;
2611   sym->standard = standard;
2612   sym->elemental = 1;
2613   sym->conversion = 1;
2614   sym->ts = to;
2615   sym->id = GFC_ISYM_CONVERSION;
2616
2617   nconv++;
2618 }
2619
2620
2621 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2622    functions by looping over the kind tables.  */
2623
2624 static void
2625 add_conversions (void)
2626 {
2627   int i, j;
2628
2629   /* Integer-Integer conversions.  */
2630   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2631     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2632       {
2633         if (i == j)
2634           continue;
2635
2636         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2637                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2638       }
2639
2640   /* Integer-Real/Complex conversions.  */
2641   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2642     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2643       {
2644         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2645                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2646
2647         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2648                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2649
2650         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2651                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2652
2653         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2654                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2655       }
2656
2657   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2658     {
2659       /* Hollerith-Integer conversions.  */
2660       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2661         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2662                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2663       /* Hollerith-Real conversions.  */
2664       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2665         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2666                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2667       /* Hollerith-Complex conversions.  */
2668       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2669         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2670                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2671
2672       /* Hollerith-Character conversions.  */
2673       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2674                   gfc_default_character_kind, GFC_STD_LEGACY);
2675
2676       /* Hollerith-Logical conversions.  */
2677       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2678         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2679                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2680     }
2681
2682   /* Real/Complex - Real/Complex conversions.  */
2683   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2684     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2685       {
2686         if (i != j)
2687           {
2688             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2689                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2690
2691             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2692                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2693           }
2694
2695         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2696                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2697
2698         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2699                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2700       }
2701
2702   /* Logical/Logical kind conversion.  */
2703   for (i = 0; gfc_logical_kinds[i].kind; i++)
2704     for (j = 0; gfc_logical_kinds[j].kind; j++)
2705       {
2706         if (i == j)
2707           continue;
2708
2709         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2710                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2711       }
2712
2713   /* Integer-Logical and Logical-Integer conversions.  */
2714   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2715     for (i=0; gfc_integer_kinds[i].kind; i++)
2716       for (j=0; gfc_logical_kinds[j].kind; j++)
2717         {
2718           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2719                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2720           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2721                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2722         }
2723 }
2724
2725
2726 /* Initialize the table of intrinsics.  */
2727 void
2728 gfc_intrinsic_init_1 (void)
2729 {
2730   int i;
2731
2732   nargs = nfunc = nsub = nconv = 0;
2733
2734   /* Create a namespace to hold the resolved intrinsic symbols.  */
2735   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2736
2737   sizing = SZ_FUNCS;
2738   add_functions ();
2739   sizing = SZ_SUBS;
2740   add_subroutines ();
2741   sizing = SZ_CONVS;
2742   add_conversions ();
2743
2744   functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2745                           + sizeof (gfc_intrinsic_arg) * nargs);
2746
2747   next_sym = functions;
2748   subroutines = functions + nfunc;
2749
2750   conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2751
2752   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2753
2754   sizing = SZ_NOTHING;
2755   nconv = 0;
2756
2757   add_functions ();
2758   add_subroutines ();
2759   add_conversions ();
2760
2761   /* Set the pure flag.  All intrinsic functions are pure, and
2762      intrinsic subroutines are pure if they are elemental.  */
2763
2764   for (i = 0; i < nfunc; i++)
2765     functions[i].pure = 1;
2766
2767   for (i = 0; i < nsub; i++)
2768     subroutines[i].pure = subroutines[i].elemental;
2769 }
2770
2771
2772 void
2773 gfc_intrinsic_done_1 (void)
2774 {
2775   gfc_free (functions);
2776   gfc_free (conversion);
2777   gfc_free_namespace (gfc_intrinsic_namespace);
2778 }
2779
2780
2781 /******** Subroutines to check intrinsic interfaces ***********/
2782
2783 /* Given a formal argument list, remove any NULL arguments that may
2784    have been left behind by a sort against some formal argument list.  */
2785
2786 static void
2787 remove_nullargs (gfc_actual_arglist **ap)
2788 {
2789   gfc_actual_arglist *head, *tail, *next;
2790
2791   tail = NULL;
2792
2793   for (head = *ap; head; head = next)
2794     {
2795       next = head->next;
2796
2797       if (head->expr == NULL && !head->label)
2798         {
2799           head->next = NULL;
2800           gfc_free_actual_arglist (head);
2801         }
2802       else
2803         {
2804           if (tail == NULL)
2805             *ap = head;
2806           else
2807             tail->next = head;
2808
2809           tail = head;
2810           tail->next = NULL;
2811         }
2812     }
2813
2814   if (tail == NULL)
2815     *ap = NULL;
2816 }
2817
2818
2819 /* Given an actual arglist and a formal arglist, sort the actual
2820    arglist so that its arguments are in a one-to-one correspondence
2821    with the format arglist.  Arguments that are not present are given
2822    a blank gfc_actual_arglist structure.  If something is obviously
2823    wrong (say, a missing required argument) we abort sorting and
2824    return FAILURE.  */
2825
2826 static try
2827 sort_actual (const char *name, gfc_actual_arglist **ap,
2828              gfc_intrinsic_arg *formal, locus *where)
2829 {
2830   gfc_actual_arglist *actual, *a;
2831   gfc_intrinsic_arg *f;
2832
2833   remove_nullargs (ap);
2834   actual = *ap;
2835
2836   for (f = formal; f; f = f->next)
2837     f->actual = NULL;
2838
2839   f = formal;
2840   a = actual;
2841
2842   if (f == NULL && a == NULL)   /* No arguments */
2843     return SUCCESS;
2844
2845   for (;;)
2846     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
2847       if (f == NULL)
2848         break;
2849       if (a == NULL)
2850         goto optional;
2851
2852       if (a->name != NULL)
2853         goto keywords;
2854
2855       f->actual = a;
2856
2857       f = f->next;
2858       a = a->next;
2859     }
2860
2861   if (a == NULL)
2862     goto do_sort;
2863
2864   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2865   return FAILURE;
2866
2867 keywords:
2868   /* Associate the remaining actual arguments, all of which have
2869      to be keyword arguments.  */
2870   for (; a; a = a->next)
2871     {
2872       for (f = formal; f; f = f->next)
2873         if (strcmp (a->name, f->name) == 0)
2874           break;
2875
2876       if (f == NULL)
2877         {
2878           if (a->name[0] == '%')
2879             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
2880                        "are not allowed in this context at %L", where);
2881           else
2882             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2883                        a->name, name, where);
2884           return FAILURE;
2885         }
2886
2887       if (f->actual != NULL)
2888         {
2889           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2890                      f->name, name, where);
2891           return FAILURE;
2892         }
2893
2894       f->actual = a;
2895     }
2896
2897 optional:
2898   /* At this point, all unmatched formal args must be optional.  */
2899   for (f = formal; f; f = f->next)
2900     {
2901       if (f->actual == NULL && f->optional == 0)
2902         {
2903           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2904                      f->name, name, where);
2905           return FAILURE;
2906         }
2907     }
2908
2909 do_sort:
2910   /* Using the formal argument list, string the actual argument list
2911      together in a way that corresponds with the formal list.  */
2912   actual = NULL;
2913
2914   for (f = formal; f; f = f->next)
2915     {
2916       if (f->actual && f->actual->label != NULL && f->ts.type)
2917         {
2918           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
2919           return FAILURE;
2920         }
2921
2922       if (f->actual == NULL)
2923         {
2924           a = gfc_get_actual_arglist ();
2925           a->missing_arg_type = f->ts.type;
2926         }
2927       else
2928         a = f->actual;
2929
2930       if (actual == NULL)
2931         *ap = a;
2932       else
2933         actual->next = a;
2934
2935       actual = a;
2936     }
2937   actual->next = NULL;          /* End the sorted argument list.  */
2938
2939   return SUCCESS;
2940 }
2941
2942
2943 /* Compare an actual argument list with an intrinsic's formal argument
2944    list.  The lists are checked for agreement of type.  We don't check
2945    for arrayness here.  */
2946
2947 static try
2948 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
2949                int error_flag)
2950 {
2951   gfc_actual_arglist *actual;
2952   gfc_intrinsic_arg *formal;
2953   int i;
2954
2955   formal = sym->formal;
2956   actual = *ap;
2957
2958   i = 0;
2959   for (; formal; formal = formal->next, actual = actual->next, i++)
2960     {
2961       if (actual->expr == NULL)
2962         continue;
2963
2964       if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2965         {
2966           if (error_flag)
2967             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
2968                        "be %s, not %s", gfc_current_intrinsic_arg[i],
2969                        gfc_current_intrinsic, &actual->expr->where,
2970                        gfc_typename (&formal->ts),
2971                        gfc_typename (&actual->expr->ts));
2972           return FAILURE;
2973         }
2974     }
2975
2976   return SUCCESS;
2977 }
2978
2979
2980 /* Given a pointer to an intrinsic symbol and an expression node that
2981    represent the function call to that subroutine, figure out the type
2982    of the result.  This may involve calling a resolution subroutine.  */
2983
2984 static void
2985 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
2986 {
2987   gfc_expr *a1, *a2, *a3, *a4, *a5;
2988   gfc_actual_arglist *arg;
2989
2990   if (specific->resolve.f1 == NULL)
2991     {
2992       if (e->value.function.name == NULL)
2993         e->value.function.name = specific->lib_name;
2994
2995       if (e->ts.type == BT_UNKNOWN)
2996         e->ts = specific->ts;
2997       return;
2998     }
2999
3000   arg = e->value.function.actual;
3001
3002   /* Special case hacks for MIN and MAX.  */
3003   if (specific->resolve.f1m == gfc_resolve_max
3004       || specific->resolve.f1m == gfc_resolve_min)
3005     {
3006       (*specific->resolve.f1m) (e, arg);
3007       return;
3008     }
3009
3010   if (arg == NULL)
3011     {
3012       (*specific->resolve.f0) (e);
3013       return;
3014     }
3015
3016   a1 = arg->expr;
3017   arg = arg->next;
3018
3019   if (arg == NULL)
3020     {
3021       (*specific->resolve.f1) (e, a1);
3022       return;
3023     }
3024
3025   a2 = arg->expr;
3026   arg = arg->next;
3027
3028   if (arg == NULL)
3029     {
3030       (*specific->resolve.f2) (e, a1, a2);
3031       return;
3032     }
3033
3034   a3 = arg->expr;
3035   arg = arg->next;
3036
3037   if (arg == NULL)
3038     {
3039       (*specific->resolve.f3) (e, a1, a2, a3);
3040       return;
3041     }
3042
3043   a4 = arg->expr;
3044   arg = arg->next;
3045
3046   if (arg == NULL)
3047     {
3048       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3049       return;
3050     }
3051
3052   a5 = arg->expr;
3053   arg = arg->next;
3054
3055   if (arg == NULL)
3056     {
3057       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3058       return;
3059     }
3060
3061   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3062 }
3063
3064
3065 /* Given an intrinsic symbol node and an expression node, call the
3066    simplification function (if there is one), perhaps replacing the
3067    expression with something simpler.  We return FAILURE on an error
3068    of the simplification, SUCCESS if the simplification worked, even
3069    if nothing has changed in the expression itself.  */
3070
3071 static try
3072 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3073 {
3074   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3075   gfc_actual_arglist *arg;
3076
3077   /* Max and min require special handling due to the variable number
3078      of args.  */
3079   if (specific->simplify.f1 == gfc_simplify_min)
3080     {
3081       result = gfc_simplify_min (e);
3082       goto finish;
3083     }
3084
3085   if (specific->simplify.f1 == gfc_simplify_max)
3086     {
3087       result = gfc_simplify_max (e);
3088       goto finish;
3089     }
3090
3091   if (specific->simplify.f1 == NULL)
3092     {
3093       result = NULL;
3094       goto finish;
3095     }
3096
3097   arg = e->value.function.actual;
3098
3099   if (arg == NULL)
3100     {
3101       result = (*specific->simplify.f0) ();
3102       goto finish;
3103     }
3104
3105   a1 = arg->expr;
3106   arg = arg->next;
3107
3108   if (specific->simplify.cc == gfc_convert_constant)
3109     {
3110       result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3111       goto finish;
3112     }
3113
3114   /* TODO: Warn if -pedantic and initialization expression and arg
3115      types not integer or character */
3116
3117   if (arg == NULL)
3118     result = (*specific->simplify.f1) (a1);
3119   else
3120     {
3121       a2 = arg->expr;
3122       arg = arg->next;
3123
3124       if (arg == NULL)
3125         result = (*specific->simplify.f2) (a1, a2);
3126       else
3127         {
3128           a3 = arg->expr;
3129           arg = arg->next;
3130
3131           if (arg == NULL)
3132             result = (*specific->simplify.f3) (a1, a2, a3);
3133           else
3134             {
3135               a4 = arg->expr;
3136               arg = arg->next;
3137
3138               if (arg == NULL)
3139                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3140               else
3141                 {
3142                   a5 = arg->expr;
3143                   arg = arg->next;
3144
3145                   if (arg == NULL)
3146                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3147                   else
3148                     gfc_internal_error
3149                       ("do_simplify(): Too many args for intrinsic");
3150                 }
3151             }
3152         }
3153     }
3154
3155 finish:
3156   if (result == &gfc_bad_expr)
3157     return FAILURE;
3158
3159   if (result == NULL)
3160     resolve_intrinsic (specific, e);    /* Must call at run-time */
3161   else
3162     {
3163       result->where = e->where;
3164       gfc_replace_expr (e, result);
3165     }
3166
3167   return SUCCESS;
3168 }
3169
3170
3171 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3172    error messages.  This subroutine returns FAILURE if a subroutine
3173    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3174    list cannot match any intrinsic.  */
3175
3176 static void
3177 init_arglist (gfc_intrinsic_sym *isym)
3178 {
3179   gfc_intrinsic_arg *formal;
3180   int i;
3181
3182   gfc_current_intrinsic = isym->name;
3183
3184   i = 0;
3185   for (formal = isym->formal; formal; formal = formal->next)
3186     {
3187       if (i >= MAX_INTRINSIC_ARGS)
3188         gfc_internal_error ("init_arglist(): too many arguments");
3189       gfc_current_intrinsic_arg[i++] = formal->name;
3190     }
3191 }
3192
3193
3194 /* Given a pointer to an intrinsic symbol and an expression consisting
3195    of a function call, see if the function call is consistent with the
3196    intrinsic's formal argument list.  Return SUCCESS if the expression
3197    and intrinsic match, FAILURE otherwise.  */
3198
3199 static try
3200 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3201 {
3202   gfc_actual_arglist *arg, **ap;
3203   try t;
3204
3205   ap = &expr->value.function.actual;
3206
3207   init_arglist (specific);
3208
3209   /* Don't attempt to sort the argument list for min or max.  */
3210   if (specific->check.f1m == gfc_check_min_max
3211       || specific->check.f1m == gfc_check_min_max_integer
3212       || specific->check.f1m == gfc_check_min_max_real
3213       || specific->check.f1m == gfc_check_min_max_double)
3214     return (*specific->check.f1m) (*ap);
3215
3216   if (sort_actual (specific->name, ap, specific->formal,
3217                    &expr->where) == FAILURE)
3218     return FAILURE;
3219
3220   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3221     /* This is special because we might have to reorder the argument list.  */
3222     t = gfc_check_minloc_maxloc (*ap);
3223   else if (specific->check.f3red == gfc_check_minval_maxval)
3224     /* This is also special because we also might have to reorder the
3225        argument list.  */
3226     t = gfc_check_minval_maxval (*ap);
3227   else if (specific->check.f3red == gfc_check_product_sum)
3228     /* Same here. The difference to the previous case is that we allow a
3229        general numeric type.  */
3230     t = gfc_check_product_sum (*ap);
3231   else
3232      {
3233        if (specific->check.f1 == NULL)
3234          {
3235            t = check_arglist (ap, specific, error_flag);
3236            if (t == SUCCESS)
3237              expr->ts = specific->ts;
3238          }
3239        else
3240          t = do_check (specific, *ap);
3241      }
3242
3243   /* Check conformance of elemental intrinsics.  */
3244   if (t == SUCCESS && specific->elemental)
3245     {
3246       int n = 0;
3247       gfc_expr *first_expr;
3248       arg = expr->value.function.actual;
3249
3250       /* There is no elemental intrinsic without arguments.  */
3251       gcc_assert(arg != NULL);
3252       first_expr = arg->expr;
3253
3254       for ( ; arg && arg->expr; arg = arg->next, n++)
3255         {
3256           char buffer[80];
3257           snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3258                     gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3259                     gfc_current_intrinsic);
3260           if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3261             return FAILURE;
3262         }
3263     }
3264
3265   if (t == FAILURE)
3266     remove_nullargs (ap);
3267
3268   return t;
3269 }
3270
3271
3272 /* Check whether an intrinsic belongs to whatever standard the user
3273    has chosen.  */
3274
3275 static try
3276 check_intrinsic_standard (const char *name, int standard, locus *where)
3277 {
3278   /* Do not warn about GNU-extensions if -std=gnu.  */
3279   if (!gfc_option.warn_nonstd_intrinsics
3280       || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
3281     return SUCCESS;
3282
3283   if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3284                       "in the selected standard", name, where) == FAILURE)
3285     return FAILURE;
3286
3287   return SUCCESS;
3288 }
3289
3290
3291 /* See if a function call corresponds to an intrinsic function call.
3292    We return:
3293
3294     MATCH_YES    if the call corresponds to an intrinsic, simplification
3295                  is done if possible.
3296
3297     MATCH_NO     if the call does not correspond to an intrinsic
3298
3299     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3300                  error during the simplification process.
3301
3302    The error_flag parameter enables an error reporting.  */
3303
3304 match
3305 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3306 {
3307   gfc_intrinsic_sym *isym, *specific;
3308   gfc_actual_arglist *actual;
3309   const char *name;
3310   int flag;
3311
3312   if (expr->value.function.isym != NULL)
3313     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3314            ? MATCH_ERROR : MATCH_YES;
3315
3316   gfc_suppress_error = !error_flag;
3317   flag = 0;
3318
3319   for (actual = expr->value.function.actual; actual; actual = actual->next)
3320     if (actual->expr != NULL)
3321       flag |= (actual->expr->ts.type != BT_INTEGER
3322                && actual->expr->ts.type != BT_CHARACTER);
3323
3324   name = expr->symtree->n.sym->name;
3325
3326   isym = specific = gfc_find_function (name);
3327   if (isym == NULL)
3328     {
3329       gfc_suppress_error = 0;
3330       return MATCH_NO;
3331     }
3332
3333   if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
3334     return MATCH_ERROR;
3335
3336   gfc_current_intrinsic_where = &expr->where;
3337
3338   /* Bypass the generic list for min and max.  */
3339   if (isym->check.f1m == gfc_check_min_max)
3340     {
3341       init_arglist (isym);
3342
3343       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3344         goto got_specific;
3345
3346       gfc_suppress_error = 0;
3347       return MATCH_NO;
3348     }
3349
3350   /* If the function is generic, check all of its specific
3351      incarnations.  If the generic name is also a specific, we check
3352      that name last, so that any error message will correspond to the
3353      specific.  */
3354   gfc_suppress_error = 1;
3355
3356   if (isym->generic)
3357     {
3358       for (specific = isym->specific_head; specific;
3359            specific = specific->next)
3360         {
3361           if (specific == isym)
3362             continue;
3363           if (check_specific (specific, expr, 0) == SUCCESS)
3364             goto got_specific;
3365         }
3366     }
3367
3368   gfc_suppress_error = !error_flag;
3369
3370   if (check_specific (isym, expr, error_flag) == FAILURE)
3371     {
3372       gfc_suppress_error = 0;
3373       return MATCH_NO;
3374     }
3375
3376   specific = isym;
3377
3378 got_specific:
3379   expr->value.function.isym = specific;
3380   gfc_intrinsic_symbol (expr->symtree->n.sym);
3381
3382   gfc_suppress_error = 0;
3383   if (do_simplify (specific, expr) == FAILURE)
3384     return MATCH_ERROR;
3385
3386   /* F95, 7.1.6.1, Initialization expressions
3387      (4) An elemental intrinsic function reference of type integer or
3388          character where each argument is an initialization expression
3389          of type integer or character
3390
3391      F2003, 7.1.7 Initialization expression
3392      (4)   A reference to an elemental standard intrinsic function,
3393            where each argument is an initialization expression  */
3394
3395   if (gfc_init_expr
3396       && isym->elemental
3397       && (expr->ts.type != BT_INTEGER || expr->ts.type != BT_CHARACTER)
3398       && gfc_notify_std (GFC_STD_F2003, "Extension: Evaluation of "
3399                         "nonstandard initialization expression at %L",
3400                         &expr->where) == FAILURE)
3401     return MATCH_ERROR;
3402
3403   return MATCH_YES;
3404 }
3405
3406
3407 /* See if a CALL statement corresponds to an intrinsic subroutine.
3408    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3409    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3410    correspond).  */
3411
3412 match
3413 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3414 {
3415   gfc_intrinsic_sym *isym;
3416   const char *name;
3417
3418   name = c->symtree->n.sym->name;
3419
3420   isym = gfc_find_subroutine (name);
3421   if (isym == NULL)
3422     return MATCH_NO;
3423
3424   if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
3425     return MATCH_ERROR;
3426
3427   gfc_suppress_error = !error_flag;
3428
3429   init_arglist (isym);
3430
3431   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3432     goto fail;
3433
3434   if (isym->check.f1 != NULL)
3435     {
3436       if (do_check (isym, c->ext.actual) == FAILURE)
3437         goto fail;
3438     }
3439   else
3440     {
3441       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3442         goto fail;
3443     }
3444
3445   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3446      seen at this point.  */
3447   gfc_suppress_error = 0;
3448
3449   if (isym->resolve.s1 != NULL)
3450     isym->resolve.s1 (c);
3451   else
3452     c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3453
3454   if (gfc_pure (NULL) && !isym->elemental)
3455     {
3456       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3457                  &c->loc);
3458       return MATCH_ERROR;
3459     }
3460
3461   c->resolved_sym->attr.noreturn = isym->noreturn;
3462
3463   return MATCH_YES;
3464
3465 fail:
3466   gfc_suppress_error = 0;
3467   return MATCH_NO;
3468 }
3469
3470
3471 /* Call gfc_convert_type() with warning enabled.  */
3472
3473 try
3474 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3475 {
3476   return gfc_convert_type_warn (expr, ts, eflag, 1);
3477 }
3478
3479
3480 /* Try to convert an expression (in place) from one type to another.
3481    'eflag' controls the behavior on error.
3482
3483    The possible values are:
3484
3485      1 Generate a gfc_error()
3486      2 Generate a gfc_internal_error().
3487
3488    'wflag' controls the warning related to conversion.  */
3489
3490 try
3491 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3492 {
3493   gfc_intrinsic_sym *sym;
3494   gfc_typespec from_ts;
3495   locus old_where;
3496   gfc_expr *new;
3497   int rank;
3498   mpz_t *shape;
3499
3500   from_ts = expr->ts;           /* expr->ts gets clobbered */
3501
3502   if (ts->type == BT_UNKNOWN)
3503     goto bad;
3504
3505   /* NULL and zero size arrays get their type here.  */
3506   if (expr->expr_type == EXPR_NULL
3507       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3508     {
3509       /* Sometimes the RHS acquire the type.  */
3510       expr->ts = *ts;
3511       return SUCCESS;
3512     }
3513
3514   if (expr->ts.type == BT_UNKNOWN)
3515     goto bad;
3516
3517   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3518       && gfc_compare_types (&expr->ts, ts))
3519     return SUCCESS;
3520
3521   sym = find_conv (&expr->ts, ts);
3522   if (sym == NULL)
3523     goto bad;
3524
3525   /* At this point, a conversion is necessary. A warning may be needed.  */
3526   if ((gfc_option.warn_std & sym->standard) != 0)
3527     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3528                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3529   else if (wflag && gfc_option.warn_conversion)
3530     gfc_warning_now ("Conversion from %s to %s at %L",
3531                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3532
3533   /* Insert a pre-resolved function call to the right function.  */
3534   old_where = expr->where;
3535   rank = expr->rank;
3536   shape = expr->shape;
3537
3538   new = gfc_get_expr ();
3539   *new = *expr;
3540
3541   new = gfc_build_conversion (new);
3542   new->value.function.name = sym->lib_name;
3543   new->value.function.isym = sym;
3544   new->where = old_where;
3545   new->rank = rank;
3546   new->shape = gfc_copy_shape (shape, rank);
3547
3548   gfc_get_ha_sym_tree (sym->name, &new->symtree);
3549   new->symtree->n.sym->ts = *ts;
3550   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3551   new->symtree->n.sym->attr.function = 1;
3552   new->symtree->n.sym->attr.elemental = 1;
3553   new->symtree->n.sym->attr.pure = 1;
3554   new->symtree->n.sym->attr.referenced = 1;
3555   gfc_intrinsic_symbol(new->symtree->n.sym);
3556   gfc_commit_symbol (new->symtree->n.sym);
3557
3558   *expr = *new;
3559
3560   gfc_free (new);
3561   expr->ts = *ts;
3562
3563   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3564       && do_simplify (sym, expr) == FAILURE)
3565     {
3566
3567       if (eflag == 2)
3568         goto bad;
3569       return FAILURE;           /* Error already generated in do_simplify() */
3570     }
3571
3572   return SUCCESS;
3573
3574 bad:
3575   if (eflag == 1)
3576     {
3577       gfc_error ("Can't convert %s to %s at %L",
3578                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3579       return FAILURE;
3580     }
3581
3582   gfc_internal_error ("Can't convert %s to %s at %L",
3583                       gfc_typename (&from_ts), gfc_typename (ts),
3584                       &expr->where);
3585   /* Not reached */
3586 }