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,
2471               BT_UNKNOWN, 0, GFC_STD_F95,
2472               gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2473               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2474               gt, BT_INTEGER, di, OPTIONAL);
2475
2476   /* More G77 compatibility garbage.  */
2477   add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2478               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2479               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2480               st, BT_INTEGER, di, OPTIONAL);
2481
2482   add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2483               gfc_check_srand, NULL, gfc_resolve_srand,
2484               c, BT_INTEGER, 4, REQUIRED);
2485
2486   add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2487               gfc_check_exit, NULL, gfc_resolve_exit,
2488               st, BT_INTEGER, di, OPTIONAL);
2489
2490   make_noreturn();
2491
2492   add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2493               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2494               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2495               st, BT_INTEGER, di, OPTIONAL);
2496
2497   add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2498               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2499               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2500
2501   add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2502               gfc_check_flush, NULL, gfc_resolve_flush,
2503               c, BT_INTEGER, di, OPTIONAL);
2504
2505   add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2506               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2507               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2508               st, BT_INTEGER, di, OPTIONAL);
2509
2510   add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2511               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2512               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2513
2514   add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2515               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2516
2517   add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2518               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2519               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2520               whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2521
2522   add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2523               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2524               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2525
2526   add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2527               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2528               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2529
2530   add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2531               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2532               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2533
2534   add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2535               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2536               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2537               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2538
2539   add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2540               gfc_check_perror, NULL, gfc_resolve_perror,
2541               c, BT_CHARACTER, dc, REQUIRED);
2542
2543   add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2544               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2545               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2546               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2547
2548   add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2549               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2550               val, BT_CHARACTER, dc, REQUIRED);
2551
2552   add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2553               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2554               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2555               st, BT_INTEGER, di, OPTIONAL);
2556
2557   add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2558               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2559               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2560               st, BT_INTEGER, di, OPTIONAL);
2561
2562   add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2563               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2564               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2565               st, BT_INTEGER, di, OPTIONAL);
2566
2567   add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2568               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2569               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2570               st, BT_INTEGER, di, OPTIONAL);
2571
2572   add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2573               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2574               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2575               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2576
2577   add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2578               NULL, NULL, gfc_resolve_system_sub,
2579               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2580
2581   add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2582               gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2583               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2584               cm, BT_INTEGER, di, OPTIONAL);
2585
2586   add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2587               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2588               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2589
2590   add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2591               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2592               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2593
2594   add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2595               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2596               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2597 }
2598
2599
2600 /* Add a function to the list of conversion symbols.  */
2601
2602 static void
2603 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2604 {
2605   gfc_typespec from, to;
2606   gfc_intrinsic_sym *sym;
2607
2608   if (sizing == SZ_CONVS)
2609     {
2610       nconv++;
2611       return;
2612     }
2613
2614   gfc_clear_ts (&from);
2615   from.type = from_type;
2616   from.kind = from_kind;
2617
2618   gfc_clear_ts (&to);
2619   to.type = to_type;
2620   to.kind = to_kind;
2621
2622   sym = conversion + nconv;
2623
2624   sym->name = conv_name (&from, &to);
2625   sym->lib_name = sym->name;
2626   sym->simplify.cc = gfc_convert_constant;
2627   sym->standard = standard;
2628   sym->elemental = 1;
2629   sym->conversion = 1;
2630   sym->ts = to;
2631   sym->id = GFC_ISYM_CONVERSION;
2632
2633   nconv++;
2634 }
2635
2636
2637 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2638    functions by looping over the kind tables.  */
2639
2640 static void
2641 add_conversions (void)
2642 {
2643   int i, j;
2644
2645   /* Integer-Integer conversions.  */
2646   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2647     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2648       {
2649         if (i == j)
2650           continue;
2651
2652         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2653                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2654       }
2655
2656   /* Integer-Real/Complex conversions.  */
2657   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2658     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2659       {
2660         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2661                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2662
2663         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2664                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2665
2666         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2667                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2668
2669         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2670                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2671       }
2672
2673   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2674     {
2675       /* Hollerith-Integer conversions.  */
2676       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2677         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2678                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2679       /* Hollerith-Real conversions.  */
2680       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2681         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2682                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2683       /* Hollerith-Complex conversions.  */
2684       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2685         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2686                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2687
2688       /* Hollerith-Character conversions.  */
2689       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2690                   gfc_default_character_kind, GFC_STD_LEGACY);
2691
2692       /* Hollerith-Logical conversions.  */
2693       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2694         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2695                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2696     }
2697
2698   /* Real/Complex - Real/Complex conversions.  */
2699   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2700     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2701       {
2702         if (i != j)
2703           {
2704             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2705                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2706
2707             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2708                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2709           }
2710
2711         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2712                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2713
2714         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2715                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2716       }
2717
2718   /* Logical/Logical kind conversion.  */
2719   for (i = 0; gfc_logical_kinds[i].kind; i++)
2720     for (j = 0; gfc_logical_kinds[j].kind; j++)
2721       {
2722         if (i == j)
2723           continue;
2724
2725         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2726                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2727       }
2728
2729   /* Integer-Logical and Logical-Integer conversions.  */
2730   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2731     for (i=0; gfc_integer_kinds[i].kind; i++)
2732       for (j=0; gfc_logical_kinds[j].kind; j++)
2733         {
2734           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2735                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2736           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2737                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2738         }
2739 }
2740
2741
2742 /* Initialize the table of intrinsics.  */
2743 void
2744 gfc_intrinsic_init_1 (void)
2745 {
2746   int i;
2747
2748   nargs = nfunc = nsub = nconv = 0;
2749
2750   /* Create a namespace to hold the resolved intrinsic symbols.  */
2751   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2752
2753   sizing = SZ_FUNCS;
2754   add_functions ();
2755   sizing = SZ_SUBS;
2756   add_subroutines ();
2757   sizing = SZ_CONVS;
2758   add_conversions ();
2759
2760   functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2761                           + sizeof (gfc_intrinsic_arg) * nargs);
2762
2763   next_sym = functions;
2764   subroutines = functions + nfunc;
2765
2766   conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2767
2768   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2769
2770   sizing = SZ_NOTHING;
2771   nconv = 0;
2772
2773   add_functions ();
2774   add_subroutines ();
2775   add_conversions ();
2776
2777   /* Set the pure flag.  All intrinsic functions are pure, and
2778      intrinsic subroutines are pure if they are elemental.  */
2779
2780   for (i = 0; i < nfunc; i++)
2781     functions[i].pure = 1;
2782
2783   for (i = 0; i < nsub; i++)
2784     subroutines[i].pure = subroutines[i].elemental;
2785 }
2786
2787
2788 void
2789 gfc_intrinsic_done_1 (void)
2790 {
2791   gfc_free (functions);
2792   gfc_free (conversion);
2793   gfc_free_namespace (gfc_intrinsic_namespace);
2794 }
2795
2796
2797 /******** Subroutines to check intrinsic interfaces ***********/
2798
2799 /* Given a formal argument list, remove any NULL arguments that may
2800    have been left behind by a sort against some formal argument list.  */
2801
2802 static void
2803 remove_nullargs (gfc_actual_arglist **ap)
2804 {
2805   gfc_actual_arglist *head, *tail, *next;
2806
2807   tail = NULL;
2808
2809   for (head = *ap; head; head = next)
2810     {
2811       next = head->next;
2812
2813       if (head->expr == NULL && !head->label)
2814         {
2815           head->next = NULL;
2816           gfc_free_actual_arglist (head);
2817         }
2818       else
2819         {
2820           if (tail == NULL)
2821             *ap = head;
2822           else
2823             tail->next = head;
2824
2825           tail = head;
2826           tail->next = NULL;
2827         }
2828     }
2829
2830   if (tail == NULL)
2831     *ap = NULL;
2832 }
2833
2834
2835 /* Given an actual arglist and a formal arglist, sort the actual
2836    arglist so that its arguments are in a one-to-one correspondence
2837    with the format arglist.  Arguments that are not present are given
2838    a blank gfc_actual_arglist structure.  If something is obviously
2839    wrong (say, a missing required argument) we abort sorting and
2840    return FAILURE.  */
2841
2842 static try
2843 sort_actual (const char *name, gfc_actual_arglist **ap,
2844              gfc_intrinsic_arg *formal, locus *where)
2845 {
2846   gfc_actual_arglist *actual, *a;
2847   gfc_intrinsic_arg *f;
2848
2849   remove_nullargs (ap);
2850   actual = *ap;
2851
2852   for (f = formal; f; f = f->next)
2853     f->actual = NULL;
2854
2855   f = formal;
2856   a = actual;
2857
2858   if (f == NULL && a == NULL)   /* No arguments */
2859     return SUCCESS;
2860
2861   for (;;)
2862     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
2863       if (f == NULL)
2864         break;
2865       if (a == NULL)
2866         goto optional;
2867
2868       if (a->name != NULL)
2869         goto keywords;
2870
2871       f->actual = a;
2872
2873       f = f->next;
2874       a = a->next;
2875     }
2876
2877   if (a == NULL)
2878     goto do_sort;
2879
2880   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2881   return FAILURE;
2882
2883 keywords:
2884   /* Associate the remaining actual arguments, all of which have
2885      to be keyword arguments.  */
2886   for (; a; a = a->next)
2887     {
2888       for (f = formal; f; f = f->next)
2889         if (strcmp (a->name, f->name) == 0)
2890           break;
2891
2892       if (f == NULL)
2893         {
2894           if (a->name[0] == '%')
2895             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
2896                        "are not allowed in this context at %L", where);
2897           else
2898             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2899                        a->name, name, where);
2900           return FAILURE;
2901         }
2902
2903       if (f->actual != NULL)
2904         {
2905           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2906                      f->name, name, where);
2907           return FAILURE;
2908         }
2909
2910       f->actual = a;
2911     }
2912
2913 optional:
2914   /* At this point, all unmatched formal args must be optional.  */
2915   for (f = formal; f; f = f->next)
2916     {
2917       if (f->actual == NULL && f->optional == 0)
2918         {
2919           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2920                      f->name, name, where);
2921           return FAILURE;
2922         }
2923     }
2924
2925 do_sort:
2926   /* Using the formal argument list, string the actual argument list
2927      together in a way that corresponds with the formal list.  */
2928   actual = NULL;
2929
2930   for (f = formal; f; f = f->next)
2931     {
2932       if (f->actual && f->actual->label != NULL && f->ts.type)
2933         {
2934           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
2935           return FAILURE;
2936         }
2937
2938       if (f->actual == NULL)
2939         {
2940           a = gfc_get_actual_arglist ();
2941           a->missing_arg_type = f->ts.type;
2942         }
2943       else
2944         a = f->actual;
2945
2946       if (actual == NULL)
2947         *ap = a;
2948       else
2949         actual->next = a;
2950
2951       actual = a;
2952     }
2953   actual->next = NULL;          /* End the sorted argument list.  */
2954
2955   return SUCCESS;
2956 }
2957
2958
2959 /* Compare an actual argument list with an intrinsic's formal argument
2960    list.  The lists are checked for agreement of type.  We don't check
2961    for arrayness here.  */
2962
2963 static try
2964 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
2965                int error_flag)
2966 {
2967   gfc_actual_arglist *actual;
2968   gfc_intrinsic_arg *formal;
2969   int i;
2970
2971   formal = sym->formal;
2972   actual = *ap;
2973
2974   i = 0;
2975   for (; formal; formal = formal->next, actual = actual->next, i++)
2976     {
2977       if (actual->expr == NULL)
2978         continue;
2979
2980       if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2981         {
2982           if (error_flag)
2983             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
2984                        "be %s, not %s", gfc_current_intrinsic_arg[i],
2985                        gfc_current_intrinsic, &actual->expr->where,
2986                        gfc_typename (&formal->ts),
2987                        gfc_typename (&actual->expr->ts));
2988           return FAILURE;
2989         }
2990     }
2991
2992   return SUCCESS;
2993 }
2994
2995
2996 /* Given a pointer to an intrinsic symbol and an expression node that
2997    represent the function call to that subroutine, figure out the type
2998    of the result.  This may involve calling a resolution subroutine.  */
2999
3000 static void
3001 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3002 {
3003   gfc_expr *a1, *a2, *a3, *a4, *a5;
3004   gfc_actual_arglist *arg;
3005
3006   if (specific->resolve.f1 == NULL)
3007     {
3008       if (e->value.function.name == NULL)
3009         e->value.function.name = specific->lib_name;
3010
3011       if (e->ts.type == BT_UNKNOWN)
3012         e->ts = specific->ts;
3013       return;
3014     }
3015
3016   arg = e->value.function.actual;
3017
3018   /* Special case hacks for MIN and MAX.  */
3019   if (specific->resolve.f1m == gfc_resolve_max
3020       || specific->resolve.f1m == gfc_resolve_min)
3021     {
3022       (*specific->resolve.f1m) (e, arg);
3023       return;
3024     }
3025
3026   if (arg == NULL)
3027     {
3028       (*specific->resolve.f0) (e);
3029       return;
3030     }
3031
3032   a1 = arg->expr;
3033   arg = arg->next;
3034
3035   if (arg == NULL)
3036     {
3037       (*specific->resolve.f1) (e, a1);
3038       return;
3039     }
3040
3041   a2 = arg->expr;
3042   arg = arg->next;
3043
3044   if (arg == NULL)
3045     {
3046       (*specific->resolve.f2) (e, a1, a2);
3047       return;
3048     }
3049
3050   a3 = arg->expr;
3051   arg = arg->next;
3052
3053   if (arg == NULL)
3054     {
3055       (*specific->resolve.f3) (e, a1, a2, a3);
3056       return;
3057     }
3058
3059   a4 = arg->expr;
3060   arg = arg->next;
3061
3062   if (arg == NULL)
3063     {
3064       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3065       return;
3066     }
3067
3068   a5 = arg->expr;
3069   arg = arg->next;
3070
3071   if (arg == NULL)
3072     {
3073       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3074       return;
3075     }
3076
3077   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3078 }
3079
3080
3081 /* Given an intrinsic symbol node and an expression node, call the
3082    simplification function (if there is one), perhaps replacing the
3083    expression with something simpler.  We return FAILURE on an error
3084    of the simplification, SUCCESS if the simplification worked, even
3085    if nothing has changed in the expression itself.  */
3086
3087 static try
3088 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3089 {
3090   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3091   gfc_actual_arglist *arg;
3092
3093   /* Max and min require special handling due to the variable number
3094      of args.  */
3095   if (specific->simplify.f1 == gfc_simplify_min)
3096     {
3097       result = gfc_simplify_min (e);
3098       goto finish;
3099     }
3100
3101   if (specific->simplify.f1 == gfc_simplify_max)
3102     {
3103       result = gfc_simplify_max (e);
3104       goto finish;
3105     }
3106
3107   if (specific->simplify.f1 == NULL)
3108     {
3109       result = NULL;
3110       goto finish;
3111     }
3112
3113   arg = e->value.function.actual;
3114
3115   if (arg == NULL)
3116     {
3117       result = (*specific->simplify.f0) ();
3118       goto finish;
3119     }
3120
3121   a1 = arg->expr;
3122   arg = arg->next;
3123
3124   if (specific->simplify.cc == gfc_convert_constant)
3125     {
3126       result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3127       goto finish;
3128     }
3129
3130   /* TODO: Warn if -pedantic and initialization expression and arg
3131      types not integer or character */
3132
3133   if (arg == NULL)
3134     result = (*specific->simplify.f1) (a1);
3135   else
3136     {
3137       a2 = arg->expr;
3138       arg = arg->next;
3139
3140       if (arg == NULL)
3141         result = (*specific->simplify.f2) (a1, a2);
3142       else
3143         {
3144           a3 = arg->expr;
3145           arg = arg->next;
3146
3147           if (arg == NULL)
3148             result = (*specific->simplify.f3) (a1, a2, a3);
3149           else
3150             {
3151               a4 = arg->expr;
3152               arg = arg->next;
3153
3154               if (arg == NULL)
3155                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3156               else
3157                 {
3158                   a5 = arg->expr;
3159                   arg = arg->next;
3160
3161                   if (arg == NULL)
3162                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3163                   else
3164                     gfc_internal_error
3165                       ("do_simplify(): Too many args for intrinsic");
3166                 }
3167             }
3168         }
3169     }
3170
3171 finish:
3172   if (result == &gfc_bad_expr)
3173     return FAILURE;
3174
3175   if (result == NULL)
3176     resolve_intrinsic (specific, e);    /* Must call at run-time */
3177   else
3178     {
3179       result->where = e->where;
3180       gfc_replace_expr (e, result);
3181     }
3182
3183   return SUCCESS;
3184 }
3185
3186
3187 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3188    error messages.  This subroutine returns FAILURE if a subroutine
3189    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3190    list cannot match any intrinsic.  */
3191
3192 static void
3193 init_arglist (gfc_intrinsic_sym *isym)
3194 {
3195   gfc_intrinsic_arg *formal;
3196   int i;
3197
3198   gfc_current_intrinsic = isym->name;
3199
3200   i = 0;
3201   for (formal = isym->formal; formal; formal = formal->next)
3202     {
3203       if (i >= MAX_INTRINSIC_ARGS)
3204         gfc_internal_error ("init_arglist(): too many arguments");
3205       gfc_current_intrinsic_arg[i++] = formal->name;
3206     }
3207 }
3208
3209
3210 /* Given a pointer to an intrinsic symbol and an expression consisting
3211    of a function call, see if the function call is consistent with the
3212    intrinsic's formal argument list.  Return SUCCESS if the expression
3213    and intrinsic match, FAILURE otherwise.  */
3214
3215 static try
3216 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3217 {
3218   gfc_actual_arglist *arg, **ap;
3219   try t;
3220
3221   ap = &expr->value.function.actual;
3222
3223   init_arglist (specific);
3224
3225   /* Don't attempt to sort the argument list for min or max.  */
3226   if (specific->check.f1m == gfc_check_min_max
3227       || specific->check.f1m == gfc_check_min_max_integer
3228       || specific->check.f1m == gfc_check_min_max_real
3229       || specific->check.f1m == gfc_check_min_max_double)
3230     return (*specific->check.f1m) (*ap);
3231
3232   if (sort_actual (specific->name, ap, specific->formal,
3233                    &expr->where) == FAILURE)
3234     return FAILURE;
3235
3236   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3237     /* This is special because we might have to reorder the argument list.  */
3238     t = gfc_check_minloc_maxloc (*ap);
3239   else if (specific->check.f3red == gfc_check_minval_maxval)
3240     /* This is also special because we also might have to reorder the
3241        argument list.  */
3242     t = gfc_check_minval_maxval (*ap);
3243   else if (specific->check.f3red == gfc_check_product_sum)
3244     /* Same here. The difference to the previous case is that we allow a
3245        general numeric type.  */
3246     t = gfc_check_product_sum (*ap);
3247   else
3248      {
3249        if (specific->check.f1 == NULL)
3250          {
3251            t = check_arglist (ap, specific, error_flag);
3252            if (t == SUCCESS)
3253              expr->ts = specific->ts;
3254          }
3255        else
3256          t = do_check (specific, *ap);
3257      }
3258
3259   /* Check conformance of elemental intrinsics.  */
3260   if (t == SUCCESS && specific->elemental)
3261     {
3262       int n = 0;
3263       gfc_expr *first_expr;
3264       arg = expr->value.function.actual;
3265
3266       /* There is no elemental intrinsic without arguments.  */
3267       gcc_assert(arg != NULL);
3268       first_expr = arg->expr;
3269
3270       for ( ; arg && arg->expr; arg = arg->next, n++)
3271         {
3272           char buffer[80];
3273           snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3274                     gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3275                     gfc_current_intrinsic);
3276           if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3277             return FAILURE;
3278         }
3279     }
3280
3281   if (t == FAILURE)
3282     remove_nullargs (ap);
3283
3284   return t;
3285 }
3286
3287
3288 /* Check whether an intrinsic belongs to whatever standard the user
3289    has chosen.  */
3290
3291 static try
3292 check_intrinsic_standard (const char *name, int standard, locus *where)
3293 {
3294   /* Do not warn about GNU-extensions if -std=gnu.  */
3295   if (!gfc_option.warn_nonstd_intrinsics
3296       || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
3297     return SUCCESS;
3298
3299   if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3300                       "in the selected standard", name, where) == FAILURE)
3301     return FAILURE;
3302
3303   return SUCCESS;
3304 }
3305
3306
3307 /* See if a function call corresponds to an intrinsic function call.
3308    We return:
3309
3310     MATCH_YES    if the call corresponds to an intrinsic, simplification
3311                  is done if possible.
3312
3313     MATCH_NO     if the call does not correspond to an intrinsic
3314
3315     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3316                  error during the simplification process.
3317
3318    The error_flag parameter enables an error reporting.  */
3319
3320 match
3321 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3322 {
3323   gfc_intrinsic_sym *isym, *specific;
3324   gfc_actual_arglist *actual;
3325   const char *name;
3326   int flag;
3327
3328   if (expr->value.function.isym != NULL)
3329     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3330            ? MATCH_ERROR : MATCH_YES;
3331
3332   gfc_suppress_error = !error_flag;
3333   flag = 0;
3334
3335   for (actual = expr->value.function.actual; actual; actual = actual->next)
3336     if (actual->expr != NULL)
3337       flag |= (actual->expr->ts.type != BT_INTEGER
3338                && actual->expr->ts.type != BT_CHARACTER);
3339
3340   name = expr->symtree->n.sym->name;
3341
3342   isym = specific = gfc_find_function (name);
3343   if (isym == NULL)
3344     {
3345       gfc_suppress_error = 0;
3346       return MATCH_NO;
3347     }
3348
3349   if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
3350     return MATCH_ERROR;
3351
3352   gfc_current_intrinsic_where = &expr->where;
3353
3354   /* Bypass the generic list for min and max.  */
3355   if (isym->check.f1m == gfc_check_min_max)
3356     {
3357       init_arglist (isym);
3358
3359       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3360         goto got_specific;
3361
3362       gfc_suppress_error = 0;
3363       return MATCH_NO;
3364     }
3365
3366   /* If the function is generic, check all of its specific
3367      incarnations.  If the generic name is also a specific, we check
3368      that name last, so that any error message will correspond to the
3369      specific.  */
3370   gfc_suppress_error = 1;
3371
3372   if (isym->generic)
3373     {
3374       for (specific = isym->specific_head; specific;
3375            specific = specific->next)
3376         {
3377           if (specific == isym)
3378             continue;
3379           if (check_specific (specific, expr, 0) == SUCCESS)
3380             goto got_specific;
3381         }
3382     }
3383
3384   gfc_suppress_error = !error_flag;
3385
3386   if (check_specific (isym, expr, error_flag) == FAILURE)
3387     {
3388       gfc_suppress_error = 0;
3389       return MATCH_NO;
3390     }
3391
3392   specific = isym;
3393
3394 got_specific:
3395   expr->value.function.isym = specific;
3396   gfc_intrinsic_symbol (expr->symtree->n.sym);
3397
3398   gfc_suppress_error = 0;
3399   if (do_simplify (specific, expr) == FAILURE)
3400     return MATCH_ERROR;
3401
3402   /* F95, 7.1.6.1, Initialization expressions
3403      (4) An elemental intrinsic function reference of type integer or
3404          character where each argument is an initialization expression
3405          of type integer or character
3406
3407      F2003, 7.1.7 Initialization expression
3408      (4)   A reference to an elemental standard intrinsic function,
3409            where each argument is an initialization expression  */
3410
3411   if (gfc_init_expr
3412       && isym->elemental
3413       && (expr->ts.type != BT_INTEGER || expr->ts.type != BT_CHARACTER)
3414       && gfc_notify_std (GFC_STD_F2003, "Extension: Evaluation of "
3415                         "nonstandard initialization expression at %L",
3416                         &expr->where) == FAILURE)
3417     return MATCH_ERROR;
3418
3419   return MATCH_YES;
3420 }
3421
3422
3423 /* See if a CALL statement corresponds to an intrinsic subroutine.
3424    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3425    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3426    correspond).  */
3427
3428 match
3429 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3430 {
3431   gfc_intrinsic_sym *isym;
3432   const char *name;
3433
3434   name = c->symtree->n.sym->name;
3435
3436   isym = gfc_find_subroutine (name);
3437   if (isym == NULL)
3438     return MATCH_NO;
3439
3440   if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
3441     return MATCH_ERROR;
3442
3443   gfc_suppress_error = !error_flag;
3444
3445   init_arglist (isym);
3446
3447   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3448     goto fail;
3449
3450   if (isym->check.f1 != NULL)
3451     {
3452       if (do_check (isym, c->ext.actual) == FAILURE)
3453         goto fail;
3454     }
3455   else
3456     {
3457       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3458         goto fail;
3459     }
3460
3461   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3462      seen at this point.  */
3463   gfc_suppress_error = 0;
3464
3465   if (isym->resolve.s1 != NULL)
3466     isym->resolve.s1 (c);
3467   else
3468     c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3469
3470   if (gfc_pure (NULL) && !isym->elemental)
3471     {
3472       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3473                  &c->loc);
3474       return MATCH_ERROR;
3475     }
3476
3477   c->resolved_sym->attr.noreturn = isym->noreturn;
3478
3479   return MATCH_YES;
3480
3481 fail:
3482   gfc_suppress_error = 0;
3483   return MATCH_NO;
3484 }
3485
3486
3487 /* Call gfc_convert_type() with warning enabled.  */
3488
3489 try
3490 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3491 {
3492   return gfc_convert_type_warn (expr, ts, eflag, 1);
3493 }
3494
3495
3496 /* Try to convert an expression (in place) from one type to another.
3497    'eflag' controls the behavior on error.
3498
3499    The possible values are:
3500
3501      1 Generate a gfc_error()
3502      2 Generate a gfc_internal_error().
3503
3504    'wflag' controls the warning related to conversion.  */
3505
3506 try
3507 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3508 {
3509   gfc_intrinsic_sym *sym;
3510   gfc_typespec from_ts;
3511   locus old_where;
3512   gfc_expr *new;
3513   int rank;
3514   mpz_t *shape;
3515
3516   from_ts = expr->ts;           /* expr->ts gets clobbered */
3517
3518   if (ts->type == BT_UNKNOWN)
3519     goto bad;
3520
3521   /* NULL and zero size arrays get their type here.  */
3522   if (expr->expr_type == EXPR_NULL
3523       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3524     {
3525       /* Sometimes the RHS acquire the type.  */
3526       expr->ts = *ts;
3527       return SUCCESS;
3528     }
3529
3530   if (expr->ts.type == BT_UNKNOWN)
3531     goto bad;
3532
3533   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3534       && gfc_compare_types (&expr->ts, ts))
3535     return SUCCESS;
3536
3537   sym = find_conv (&expr->ts, ts);
3538   if (sym == NULL)
3539     goto bad;
3540
3541   /* At this point, a conversion is necessary. A warning may be needed.  */
3542   if ((gfc_option.warn_std & sym->standard) != 0)
3543     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3544                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3545   else if (wflag && gfc_option.warn_conversion)
3546     gfc_warning_now ("Conversion from %s to %s at %L",
3547                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3548
3549   /* Insert a pre-resolved function call to the right function.  */
3550   old_where = expr->where;
3551   rank = expr->rank;
3552   shape = expr->shape;
3553
3554   new = gfc_get_expr ();
3555   *new = *expr;
3556
3557   new = gfc_build_conversion (new);
3558   new->value.function.name = sym->lib_name;
3559   new->value.function.isym = sym;
3560   new->where = old_where;
3561   new->rank = rank;
3562   new->shape = gfc_copy_shape (shape, rank);
3563
3564   gfc_get_ha_sym_tree (sym->name, &new->symtree);
3565   new->symtree->n.sym->ts = *ts;
3566   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3567   new->symtree->n.sym->attr.function = 1;
3568   new->symtree->n.sym->attr.elemental = 1;
3569   new->symtree->n.sym->attr.pure = 1;
3570   new->symtree->n.sym->attr.referenced = 1;
3571   gfc_intrinsic_symbol(new->symtree->n.sym);
3572   gfc_commit_symbol (new->symtree->n.sym);
3573
3574   *expr = *new;
3575
3576   gfc_free (new);
3577   expr->ts = *ts;
3578
3579   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3580       && do_simplify (sym, expr) == FAILURE)
3581     {
3582
3583       if (eflag == 2)
3584         goto bad;
3585       return FAILURE;           /* Error already generated in do_simplify() */
3586     }
3587
3588   return SUCCESS;
3589
3590 bad:
3591   if (eflag == 1)
3592     {
3593       gfc_error ("Can't convert %s to %s at %L",
3594                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3595       return FAILURE;
3596     }
3597
3598   gfc_internal_error ("Can't convert %s to %s at %L",
3599                       gfc_typename (&from_ts), gfc_typename (ts),
3600                       &expr->where);
3601   /* Not reached */
3602 }