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 klass
  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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 klass 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 = XCNEWVEC (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 = XCNEWVAR (struct gfc_intrinsic_sym,
2909                         sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2910                         + sizeof (gfc_intrinsic_arg) * nargs);
2911
2912   next_sym = functions;
2913   subroutines = functions + nfunc;
2914
2915   conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
2916
2917   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2918
2919   sizing = SZ_NOTHING;
2920   nconv = 0;
2921
2922   add_functions ();
2923   add_subroutines ();
2924   add_conversions ();
2925
2926   /* Character conversion intrinsics need to be treated separately.  */
2927   add_char_conversions ();
2928
2929   /* Set the pure flag.  All intrinsic functions are pure, and
2930      intrinsic subroutines are pure if they are elemental.  */
2931
2932   for (i = 0; i < nfunc; i++)
2933     functions[i].pure = 1;
2934
2935   for (i = 0; i < nsub; i++)
2936     subroutines[i].pure = subroutines[i].elemental;
2937 }
2938
2939
2940 void
2941 gfc_intrinsic_done_1 (void)
2942 {
2943   gfc_free (functions);
2944   gfc_free (conversion);
2945   gfc_free (char_conversions);
2946   gfc_free_namespace (gfc_intrinsic_namespace);
2947 }
2948
2949
2950 /******** Subroutines to check intrinsic interfaces ***********/
2951
2952 /* Given a formal argument list, remove any NULL arguments that may
2953    have been left behind by a sort against some formal argument list.  */
2954
2955 static void
2956 remove_nullargs (gfc_actual_arglist **ap)
2957 {
2958   gfc_actual_arglist *head, *tail, *next;
2959
2960   tail = NULL;
2961
2962   for (head = *ap; head; head = next)
2963     {
2964       next = head->next;
2965
2966       if (head->expr == NULL && !head->label)
2967         {
2968           head->next = NULL;
2969           gfc_free_actual_arglist (head);
2970         }
2971       else
2972         {
2973           if (tail == NULL)
2974             *ap = head;
2975           else
2976             tail->next = head;
2977
2978           tail = head;
2979           tail->next = NULL;
2980         }
2981     }
2982
2983   if (tail == NULL)
2984     *ap = NULL;
2985 }
2986
2987
2988 /* Given an actual arglist and a formal arglist, sort the actual
2989    arglist so that its arguments are in a one-to-one correspondence
2990    with the format arglist.  Arguments that are not present are given
2991    a blank gfc_actual_arglist structure.  If something is obviously
2992    wrong (say, a missing required argument) we abort sorting and
2993    return FAILURE.  */
2994
2995 static try
2996 sort_actual (const char *name, gfc_actual_arglist **ap,
2997              gfc_intrinsic_arg *formal, locus *where)
2998 {
2999   gfc_actual_arglist *actual, *a;
3000   gfc_intrinsic_arg *f;
3001
3002   remove_nullargs (ap);
3003   actual = *ap;
3004
3005   for (f = formal; f; f = f->next)
3006     f->actual = NULL;
3007
3008   f = formal;
3009   a = actual;
3010
3011   if (f == NULL && a == NULL)   /* No arguments */
3012     return SUCCESS;
3013
3014   for (;;)
3015     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
3016       if (f == NULL)
3017         break;
3018       if (a == NULL)
3019         goto optional;
3020
3021       if (a->name != NULL)
3022         goto keywords;
3023
3024       f->actual = a;
3025
3026       f = f->next;
3027       a = a->next;
3028     }
3029
3030   if (a == NULL)
3031     goto do_sort;
3032
3033   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3034   return FAILURE;
3035
3036 keywords:
3037   /* Associate the remaining actual arguments, all of which have
3038      to be keyword arguments.  */
3039   for (; a; a = a->next)
3040     {
3041       for (f = formal; f; f = f->next)
3042         if (strcmp (a->name, f->name) == 0)
3043           break;
3044
3045       if (f == NULL)
3046         {
3047           if (a->name[0] == '%')
3048             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3049                        "are not allowed in this context at %L", where);
3050           else
3051             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3052                        a->name, name, where);
3053           return FAILURE;
3054         }
3055
3056       if (f->actual != NULL)
3057         {
3058           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3059                      f->name, name, where);
3060           return FAILURE;
3061         }
3062
3063       f->actual = a;
3064     }
3065
3066 optional:
3067   /* At this point, all unmatched formal args must be optional.  */
3068   for (f = formal; f; f = f->next)
3069     {
3070       if (f->actual == NULL && f->optional == 0)
3071         {
3072           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3073                      f->name, name, where);
3074           return FAILURE;
3075         }
3076     }
3077
3078 do_sort:
3079   /* Using the formal argument list, string the actual argument list
3080      together in a way that corresponds with the formal list.  */
3081   actual = NULL;
3082
3083   for (f = formal; f; f = f->next)
3084     {
3085       if (f->actual && f->actual->label != NULL && f->ts.type)
3086         {
3087           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3088           return FAILURE;
3089         }
3090
3091       if (f->actual == NULL)
3092         {
3093           a = gfc_get_actual_arglist ();
3094           a->missing_arg_type = f->ts.type;
3095         }
3096       else
3097         a = f->actual;
3098
3099       if (actual == NULL)
3100         *ap = a;
3101       else
3102         actual->next = a;
3103
3104       actual = a;
3105     }
3106   actual->next = NULL;          /* End the sorted argument list.  */
3107
3108   return SUCCESS;
3109 }
3110
3111
3112 /* Compare an actual argument list with an intrinsic's formal argument
3113    list.  The lists are checked for agreement of type.  We don't check
3114    for arrayness here.  */
3115
3116 static try
3117 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3118                int error_flag)
3119 {
3120   gfc_actual_arglist *actual;
3121   gfc_intrinsic_arg *formal;
3122   int i;
3123
3124   formal = sym->formal;
3125   actual = *ap;
3126
3127   i = 0;
3128   for (; formal; formal = formal->next, actual = actual->next, i++)
3129     {
3130       gfc_typespec ts;
3131
3132       if (actual->expr == NULL)
3133         continue;
3134
3135       ts = formal->ts;
3136
3137       /* A kind of 0 means we don't check for kind.  */
3138       if (ts.kind == 0)
3139         ts.kind = actual->expr->ts.kind;
3140
3141       if (!gfc_compare_types (&ts, &actual->expr->ts))
3142         {
3143           if (error_flag)
3144             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3145                        "be %s, not %s", gfc_current_intrinsic_arg[i],
3146                        gfc_current_intrinsic, &actual->expr->where,
3147                        gfc_typename (&formal->ts),
3148                        gfc_typename (&actual->expr->ts));
3149           return FAILURE;
3150         }
3151     }
3152
3153   return SUCCESS;
3154 }
3155
3156
3157 /* Given a pointer to an intrinsic symbol and an expression node that
3158    represent the function call to that subroutine, figure out the type
3159    of the result.  This may involve calling a resolution subroutine.  */
3160
3161 static void
3162 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3163 {
3164   gfc_expr *a1, *a2, *a3, *a4, *a5;
3165   gfc_actual_arglist *arg;
3166
3167   if (specific->resolve.f1 == NULL)
3168     {
3169       if (e->value.function.name == NULL)
3170         e->value.function.name = specific->lib_name;
3171
3172       if (e->ts.type == BT_UNKNOWN)
3173         e->ts = specific->ts;
3174       return;
3175     }
3176
3177   arg = e->value.function.actual;
3178
3179   /* Special case hacks for MIN and MAX.  */
3180   if (specific->resolve.f1m == gfc_resolve_max
3181       || specific->resolve.f1m == gfc_resolve_min)
3182     {
3183       (*specific->resolve.f1m) (e, arg);
3184       return;
3185     }
3186
3187   if (arg == NULL)
3188     {
3189       (*specific->resolve.f0) (e);
3190       return;
3191     }
3192
3193   a1 = arg->expr;
3194   arg = arg->next;
3195
3196   if (arg == NULL)
3197     {
3198       (*specific->resolve.f1) (e, a1);
3199       return;
3200     }
3201
3202   a2 = arg->expr;
3203   arg = arg->next;
3204
3205   if (arg == NULL)
3206     {
3207       (*specific->resolve.f2) (e, a1, a2);
3208       return;
3209     }
3210
3211   a3 = arg->expr;
3212   arg = arg->next;
3213
3214   if (arg == NULL)
3215     {
3216       (*specific->resolve.f3) (e, a1, a2, a3);
3217       return;
3218     }
3219
3220   a4 = arg->expr;
3221   arg = arg->next;
3222
3223   if (arg == NULL)
3224     {
3225       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3226       return;
3227     }
3228
3229   a5 = arg->expr;
3230   arg = arg->next;
3231
3232   if (arg == NULL)
3233     {
3234       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3235       return;
3236     }
3237
3238   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3239 }
3240
3241
3242 /* Given an intrinsic symbol node and an expression node, call the
3243    simplification function (if there is one), perhaps replacing the
3244    expression with something simpler.  We return FAILURE on an error
3245    of the simplification, SUCCESS if the simplification worked, even
3246    if nothing has changed in the expression itself.  */
3247
3248 static try
3249 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3250 {
3251   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3252   gfc_actual_arglist *arg;
3253
3254   /* Max and min require special handling due to the variable number
3255      of args.  */
3256   if (specific->simplify.f1 == gfc_simplify_min)
3257     {
3258       result = gfc_simplify_min (e);
3259       goto finish;
3260     }
3261
3262   if (specific->simplify.f1 == gfc_simplify_max)
3263     {
3264       result = gfc_simplify_max (e);
3265       goto finish;
3266     }
3267
3268   if (specific->simplify.f1 == NULL)
3269     {
3270       result = NULL;
3271       goto finish;
3272     }
3273
3274   arg = e->value.function.actual;
3275
3276   if (arg == NULL)
3277     {
3278       result = (*specific->simplify.f0) ();
3279       goto finish;
3280     }
3281
3282   a1 = arg->expr;
3283   arg = arg->next;
3284
3285   if (specific->simplify.cc == gfc_convert_constant
3286       || specific->simplify.cc == gfc_convert_char_constant)
3287     {
3288       result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3289       goto finish;
3290     }
3291
3292   /* TODO: Warn if -pedantic and initialization expression and arg
3293      types not integer or character */
3294
3295   if (arg == NULL)
3296     result = (*specific->simplify.f1) (a1);
3297   else
3298     {
3299       a2 = arg->expr;
3300       arg = arg->next;
3301
3302       if (arg == NULL)
3303         result = (*specific->simplify.f2) (a1, a2);
3304       else
3305         {
3306           a3 = arg->expr;
3307           arg = arg->next;
3308
3309           if (arg == NULL)
3310             result = (*specific->simplify.f3) (a1, a2, a3);
3311           else
3312             {
3313               a4 = arg->expr;
3314               arg = arg->next;
3315
3316               if (arg == NULL)
3317                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3318               else
3319                 {
3320                   a5 = arg->expr;
3321                   arg = arg->next;
3322
3323                   if (arg == NULL)
3324                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3325                   else
3326                     gfc_internal_error
3327                       ("do_simplify(): Too many args for intrinsic");
3328                 }
3329             }
3330         }
3331     }
3332
3333 finish:
3334   if (result == &gfc_bad_expr)
3335     return FAILURE;
3336
3337   if (result == NULL)
3338     resolve_intrinsic (specific, e);    /* Must call at run-time */
3339   else
3340     {
3341       result->where = e->where;
3342       gfc_replace_expr (e, result);
3343     }
3344
3345   return SUCCESS;
3346 }
3347
3348
3349 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3350    error messages.  This subroutine returns FAILURE if a subroutine
3351    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3352    list cannot match any intrinsic.  */
3353
3354 static void
3355 init_arglist (gfc_intrinsic_sym *isym)
3356 {
3357   gfc_intrinsic_arg *formal;
3358   int i;
3359
3360   gfc_current_intrinsic = isym->name;
3361
3362   i = 0;
3363   for (formal = isym->formal; formal; formal = formal->next)
3364     {
3365       if (i >= MAX_INTRINSIC_ARGS)
3366         gfc_internal_error ("init_arglist(): too many arguments");
3367       gfc_current_intrinsic_arg[i++] = formal->name;
3368     }
3369 }
3370
3371
3372 /* Given a pointer to an intrinsic symbol and an expression consisting
3373    of a function call, see if the function call is consistent with the
3374    intrinsic's formal argument list.  Return SUCCESS if the expression
3375    and intrinsic match, FAILURE otherwise.  */
3376
3377 static try
3378 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3379 {
3380   gfc_actual_arglist *arg, **ap;
3381   try t;
3382
3383   ap = &expr->value.function.actual;
3384
3385   init_arglist (specific);
3386
3387   /* Don't attempt to sort the argument list for min or max.  */
3388   if (specific->check.f1m == gfc_check_min_max
3389       || specific->check.f1m == gfc_check_min_max_integer
3390       || specific->check.f1m == gfc_check_min_max_real
3391       || specific->check.f1m == gfc_check_min_max_double)
3392     return (*specific->check.f1m) (*ap);
3393
3394   if (sort_actual (specific->name, ap, specific->formal,
3395                    &expr->where) == FAILURE)
3396     return FAILURE;
3397
3398   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3399     /* This is special because we might have to reorder the argument list.  */
3400     t = gfc_check_minloc_maxloc (*ap);
3401   else if (specific->check.f3red == gfc_check_minval_maxval)
3402     /* This is also special because we also might have to reorder the
3403        argument list.  */
3404     t = gfc_check_minval_maxval (*ap);
3405   else if (specific->check.f3red == gfc_check_product_sum)
3406     /* Same here. The difference to the previous case is that we allow a
3407        general numeric type.  */
3408     t = gfc_check_product_sum (*ap);
3409   else
3410      {
3411        if (specific->check.f1 == NULL)
3412          {
3413            t = check_arglist (ap, specific, error_flag);
3414            if (t == SUCCESS)
3415              expr->ts = specific->ts;
3416          }
3417        else
3418          t = do_check (specific, *ap);
3419      }
3420
3421   /* Check conformance of elemental intrinsics.  */
3422   if (t == SUCCESS && specific->elemental)
3423     {
3424       int n = 0;
3425       gfc_expr *first_expr;
3426       arg = expr->value.function.actual;
3427
3428       /* There is no elemental intrinsic without arguments.  */
3429       gcc_assert(arg != NULL);
3430       first_expr = arg->expr;
3431
3432       for ( ; arg && arg->expr; arg = arg->next, n++)
3433         {
3434           char buffer[80];
3435           snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3436                     gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3437                     gfc_current_intrinsic);
3438           if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3439             return FAILURE;
3440         }
3441     }
3442
3443   if (t == FAILURE)
3444     remove_nullargs (ap);
3445
3446   return t;
3447 }
3448
3449
3450 /* Check whether an intrinsic belongs to whatever standard the user
3451    has chosen.  */
3452
3453 static try
3454 check_intrinsic_standard (const char *name, int standard, locus *where)
3455 {
3456   /* Do not warn about GNU-extensions if -std=gnu.  */
3457   if (!gfc_option.warn_nonstd_intrinsics
3458       || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
3459     return SUCCESS;
3460
3461   if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3462                       "in the selected standard", name, where) == FAILURE)
3463     return FAILURE;
3464
3465   return SUCCESS;
3466 }
3467
3468
3469 /* See if a function call corresponds to an intrinsic function call.
3470    We return:
3471
3472     MATCH_YES    if the call corresponds to an intrinsic, simplification
3473                  is done if possible.
3474
3475     MATCH_NO     if the call does not correspond to an intrinsic
3476
3477     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3478                  error during the simplification process.
3479
3480    The error_flag parameter enables an error reporting.  */
3481
3482 match
3483 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3484 {
3485   gfc_intrinsic_sym *isym, *specific;
3486   gfc_actual_arglist *actual;
3487   const char *name;
3488   int flag;
3489
3490   if (expr->value.function.isym != NULL)
3491     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3492            ? MATCH_ERROR : MATCH_YES;
3493
3494   gfc_suppress_error = !error_flag;
3495   flag = 0;
3496
3497   for (actual = expr->value.function.actual; actual; actual = actual->next)
3498     if (actual->expr != NULL)
3499       flag |= (actual->expr->ts.type != BT_INTEGER
3500                && actual->expr->ts.type != BT_CHARACTER);
3501
3502   name = expr->symtree->n.sym->name;
3503
3504   isym = specific = gfc_find_function (name);
3505   if (isym == NULL)
3506     {
3507       gfc_suppress_error = 0;
3508       return MATCH_NO;
3509     }
3510
3511   if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
3512     return MATCH_ERROR;
3513
3514   if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3515        || isym->id == GFC_ISYM_CMPLX)
3516       && gfc_init_expr
3517       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3518                          "as initialization expression at %L", name,
3519                          &expr->where) == FAILURE)
3520     return MATCH_ERROR;
3521
3522   gfc_current_intrinsic_where = &expr->where;
3523
3524   /* Bypass the generic list for min and max.  */
3525   if (isym->check.f1m == gfc_check_min_max)
3526     {
3527       init_arglist (isym);
3528
3529       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3530         goto got_specific;
3531
3532       gfc_suppress_error = 0;
3533       return MATCH_NO;
3534     }
3535
3536   /* If the function is generic, check all of its specific
3537      incarnations.  If the generic name is also a specific, we check
3538      that name last, so that any error message will correspond to the
3539      specific.  */
3540   gfc_suppress_error = 1;
3541
3542   if (isym->generic)
3543     {
3544       for (specific = isym->specific_head; specific;
3545            specific = specific->next)
3546         {
3547           if (specific == isym)
3548             continue;
3549           if (check_specific (specific, expr, 0) == SUCCESS)
3550             goto got_specific;
3551         }
3552     }
3553
3554   gfc_suppress_error = !error_flag;
3555
3556   if (check_specific (isym, expr, error_flag) == FAILURE)
3557     {
3558       gfc_suppress_error = 0;
3559       return MATCH_NO;
3560     }
3561
3562   specific = isym;
3563
3564 got_specific:
3565   expr->value.function.isym = specific;
3566   gfc_intrinsic_symbol (expr->symtree->n.sym);
3567
3568   gfc_suppress_error = 0;
3569   if (do_simplify (specific, expr) == FAILURE)
3570     return MATCH_ERROR;
3571
3572   /* F95, 7.1.6.1, Initialization expressions
3573      (4) An elemental intrinsic function reference of type integer or
3574          character where each argument is an initialization expression
3575          of type integer or character
3576
3577      F2003, 7.1.7 Initialization expression
3578      (4)   A reference to an elemental standard intrinsic function,
3579            where each argument is an initialization expression  */
3580
3581   if (gfc_init_expr && isym->elemental && flag
3582       && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3583                         "as initialization expression with non-integer/non-"
3584                         "character arguments at %L", &expr->where) == FAILURE)
3585     return MATCH_ERROR;
3586
3587   return MATCH_YES;
3588 }
3589
3590
3591 /* See if a CALL statement corresponds to an intrinsic subroutine.
3592    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3593    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3594    correspond).  */
3595
3596 match
3597 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3598 {
3599   gfc_intrinsic_sym *isym;
3600   const char *name;
3601
3602   name = c->symtree->n.sym->name;
3603
3604   isym = gfc_find_subroutine (name);
3605   if (isym == NULL)
3606     return MATCH_NO;
3607
3608   if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
3609     return MATCH_ERROR;
3610
3611   gfc_suppress_error = !error_flag;
3612
3613   init_arglist (isym);
3614
3615   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3616     goto fail;
3617
3618   if (isym->check.f1 != NULL)
3619     {
3620       if (do_check (isym, c->ext.actual) == FAILURE)
3621         goto fail;
3622     }
3623   else
3624     {
3625       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3626         goto fail;
3627     }
3628
3629   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3630      seen at this point.  */
3631   gfc_suppress_error = 0;
3632
3633   if (isym->resolve.s1 != NULL)
3634     isym->resolve.s1 (c);
3635   else
3636     {
3637       c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3638       c->resolved_sym->attr.elemental = isym->elemental;
3639     }
3640
3641   if (gfc_pure (NULL) && !isym->elemental)
3642     {
3643       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3644                  &c->loc);
3645       return MATCH_ERROR;
3646     }
3647
3648   c->resolved_sym->attr.noreturn = isym->noreturn;
3649
3650   return MATCH_YES;
3651
3652 fail:
3653   gfc_suppress_error = 0;
3654   return MATCH_NO;
3655 }
3656
3657
3658 /* Call gfc_convert_type() with warning enabled.  */
3659
3660 try
3661 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3662 {
3663   return gfc_convert_type_warn (expr, ts, eflag, 1);
3664 }
3665
3666
3667 /* Try to convert an expression (in place) from one type to another.
3668    'eflag' controls the behavior on error.
3669
3670    The possible values are:
3671
3672      1 Generate a gfc_error()
3673      2 Generate a gfc_internal_error().
3674
3675    'wflag' controls the warning related to conversion.  */
3676
3677 try
3678 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3679 {
3680   gfc_intrinsic_sym *sym;
3681   gfc_typespec from_ts;
3682   locus old_where;
3683   gfc_expr *new_expr;
3684   int rank;
3685   mpz_t *shape;
3686
3687   from_ts = expr->ts;           /* expr->ts gets clobbered */
3688
3689   if (ts->type == BT_UNKNOWN)
3690     goto bad;
3691
3692   /* NULL and zero size arrays get their type here.  */
3693   if (expr->expr_type == EXPR_NULL
3694       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3695     {
3696       /* Sometimes the RHS acquire the type.  */
3697       expr->ts = *ts;
3698       return SUCCESS;
3699     }
3700
3701   if (expr->ts.type == BT_UNKNOWN)
3702     goto bad;
3703
3704   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3705       && gfc_compare_types (&expr->ts, ts))
3706     return SUCCESS;
3707
3708   sym = find_conv (&expr->ts, ts);
3709   if (sym == NULL)
3710     goto bad;
3711
3712   /* At this point, a conversion is necessary. A warning may be needed.  */
3713   if ((gfc_option.warn_std & sym->standard) != 0)
3714     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3715                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3716   else if (wflag && gfc_option.warn_conversion)
3717     gfc_warning_now ("Conversion from %s to %s at %L",
3718                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3719
3720   /* Insert a pre-resolved function call to the right function.  */
3721   old_where = expr->where;
3722   rank = expr->rank;
3723   shape = expr->shape;
3724
3725   new_expr = gfc_get_expr ();
3726   *new_expr = *expr;
3727
3728   new_expr = gfc_build_conversion (new_expr);
3729   new_expr->value.function.name = sym->lib_name;
3730   new_expr->value.function.isym = sym;
3731   new_expr->where = old_where;
3732   new_expr->rank = rank;
3733   new_expr->shape = gfc_copy_shape (shape, rank);
3734
3735   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3736   new_expr->symtree->n.sym->ts = *ts;
3737   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3738   new_expr->symtree->n.sym->attr.function = 1;
3739   new_expr->symtree->n.sym->attr.elemental = 1;
3740   new_expr->symtree->n.sym->attr.pure = 1;
3741   new_expr->symtree->n.sym->attr.referenced = 1;
3742   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3743   gfc_commit_symbol (new_expr->symtree->n.sym);
3744
3745   *expr = *new_expr;
3746
3747   gfc_free (new_expr);
3748   expr->ts = *ts;
3749
3750   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3751       && do_simplify (sym, expr) == FAILURE)
3752     {
3753
3754       if (eflag == 2)
3755         goto bad;
3756       return FAILURE;           /* Error already generated in do_simplify() */
3757     }
3758
3759   return SUCCESS;
3760
3761 bad:
3762   if (eflag == 1)
3763     {
3764       gfc_error ("Can't convert %s to %s at %L",
3765                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3766       return FAILURE;
3767     }
3768
3769   gfc_internal_error ("Can't convert %s to %s at %L",
3770                       gfc_typename (&from_ts), gfc_typename (ts),
3771                       &expr->where);
3772   /* Not reached */
3773 }
3774
3775
3776 try
3777 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
3778 {
3779   gfc_intrinsic_sym *sym;
3780   gfc_typespec from_ts;
3781   locus old_where;
3782   gfc_expr *new_expr;
3783   int rank;
3784   mpz_t *shape;
3785
3786   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
3787   from_ts = expr->ts;           /* expr->ts gets clobbered */
3788
3789   sym = find_char_conv (&expr->ts, ts);
3790   gcc_assert (sym);
3791
3792   /* Insert a pre-resolved function call to the right function.  */
3793   old_where = expr->where;
3794   rank = expr->rank;
3795   shape = expr->shape;
3796
3797   new_expr = gfc_get_expr ();
3798   *new_expr = *expr;
3799
3800   new_expr = gfc_build_conversion (new_expr);
3801   new_expr->value.function.name = sym->lib_name;
3802   new_expr->value.function.isym = sym;
3803   new_expr->where = old_where;
3804   new_expr->rank = rank;
3805   new_expr->shape = gfc_copy_shape (shape, rank);
3806
3807   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3808   new_expr->symtree->n.sym->ts = *ts;
3809   new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3810   new_expr->symtree->n.sym->attr.function = 1;
3811   new_expr->symtree->n.sym->attr.elemental = 1;
3812   new_expr->symtree->n.sym->attr.referenced = 1;
3813   gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3814   gfc_commit_symbol (new_expr->symtree->n.sym);
3815
3816   *expr = *new_expr;
3817
3818   gfc_free (new_expr);
3819   expr->ts = *ts;
3820
3821   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3822       && do_simplify (sym, expr) == FAILURE)
3823     {
3824       /* Error already generated in do_simplify() */
3825       return FAILURE;
3826     }
3827
3828   return SUCCESS;
3829 }