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