gcc/fortran/intrinsic.c

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