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