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