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