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