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