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