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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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", NOT_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_fn_r, 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_fn_r, 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_fn_r, 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_fn_r, 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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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", NOT_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     *whence = "whence";
2318
2319   int di, dr, dc, dl, ii;
2320
2321   di = gfc_default_integer_kind;
2322   dr = gfc_default_real_kind;
2323   dc = gfc_default_character_kind;
2324   dl = gfc_default_logical_kind;
2325   ii = gfc_index_integer_kind;
2326
2327   add_sym_0s ("abort", GFC_STD_GNU, NULL);
2328
2329   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2330     make_noreturn();
2331
2332   add_sym_1s ("cpu_time", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F95,
2333               gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2334               tm, BT_REAL, dr, REQUIRED);
2335
2336   /* More G77 compatibility garbage.  */
2337   add_sym_2s ("ctime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2338               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2339               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2340
2341   add_sym_1s ("idate", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2342               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2343               vl, BT_INTEGER, 4, REQUIRED);
2344
2345   add_sym_1s ("itime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2346               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2347               vl, BT_INTEGER, 4, REQUIRED);
2348
2349   add_sym_2s ("ltime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2350               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2351               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2352
2353   add_sym_2s ("gmtime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2354               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2355               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2356
2357   add_sym_1s ("second", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2358               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2359               tm, BT_REAL, dr, REQUIRED);
2360
2361   add_sym_2s ("chdir", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2362               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2363               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2364
2365   add_sym_3s ("chmod", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2366               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2367               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2368               st, BT_INTEGER, di, OPTIONAL);
2369
2370   add_sym_4s ("date_and_time", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F95,
2371               gfc_check_date_and_time, NULL, NULL,
2372               dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2373               zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2374
2375   /* More G77 compatibility garbage.  */
2376   add_sym_2s ("etime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2377               gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2378               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2379
2380   add_sym_2s ("dtime", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2381               gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2382               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2383
2384   add_sym_1s ("fdate", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2385               gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2386               dt, BT_CHARACTER, dc, REQUIRED);
2387
2388   add_sym_1s ("gerror", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2389               gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2390               dc, REQUIRED);
2391
2392   add_sym_2s ("getcwd", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2393               gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2394               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2395
2396   add_sym_2s ("getenv", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2397               NULL, NULL, NULL,
2398               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2399               REQUIRED);
2400
2401   add_sym_2s ("getarg", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2402               NULL, NULL, gfc_resolve_getarg,
2403               c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2404
2405   add_sym_1s ("getlog", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2406               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2407               dc, REQUIRED);
2408
2409   /* F2003 commandline routines.  */
2410
2411   add_sym_3s ("get_command", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F2003,
2412               NULL, NULL, gfc_resolve_get_command,
2413               com, BT_CHARACTER, dc, OPTIONAL,
2414               length, BT_INTEGER, di, OPTIONAL,
2415               st, BT_INTEGER, di, OPTIONAL);
2416
2417   add_sym_4s ("get_command_argument", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F2003,
2418               NULL, NULL, gfc_resolve_get_command_argument,
2419               num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2420               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2421
2422   /* F2003 subroutine to get environment variables.  */
2423
2424   add_sym_5s ("get_environment_variable", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F2003,
2425               NULL, NULL, gfc_resolve_get_environment_variable,
2426               name, BT_CHARACTER, dc, REQUIRED,
2427               val, BT_CHARACTER, dc, OPTIONAL,
2428               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2429               trim_name, BT_LOGICAL, dl, OPTIONAL);
2430
2431   add_sym_2s ("move_alloc", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F2003,
2432               gfc_check_move_alloc, NULL, NULL,
2433               f, BT_UNKNOWN, 0, REQUIRED,
2434               t, BT_UNKNOWN, 0, REQUIRED);
2435
2436   add_sym_5s ("mvbits", ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2437               gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2438               f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2439               ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2440               tp, BT_INTEGER, di, REQUIRED);
2441
2442   add_sym_1s ("random_number", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F95,
2443               gfc_check_random_number, NULL, gfc_resolve_random_number,
2444               h, BT_REAL, dr, REQUIRED);
2445
2446   add_sym_3s ("random_seed", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F95,
2447               gfc_check_random_seed, NULL, NULL,
2448               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2449               gt, BT_INTEGER, di, OPTIONAL);
2450
2451   /* More G77 compatibility garbage.  */
2452   add_sym_3s ("alarm", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2453               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2454               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2455               st, BT_INTEGER, di, OPTIONAL);
2456
2457   add_sym_1s ("srand", NOT_ELEMENTAL,  BT_UNKNOWN, di, GFC_STD_GNU,
2458               gfc_check_srand, NULL, gfc_resolve_srand,
2459               c, BT_INTEGER, 4, REQUIRED);
2460
2461   add_sym_1s ("exit", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2462               gfc_check_exit, NULL, gfc_resolve_exit,
2463               st, BT_INTEGER, di, OPTIONAL);
2464
2465   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2466     make_noreturn();
2467
2468   add_sym_3s ("fgetc", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2469               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2470               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2471               st, BT_INTEGER, di, OPTIONAL);
2472
2473   add_sym_2s ("fget", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2474               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2475               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2476
2477   add_sym_1s ("flush", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2478               gfc_check_flush, NULL, gfc_resolve_flush,
2479               c, BT_INTEGER, di, OPTIONAL);
2480
2481   add_sym_3s ("fputc", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2482               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2483               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2484               st, BT_INTEGER, di, OPTIONAL);
2485
2486   add_sym_2s ("fput", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2487               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2488               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2489
2490   add_sym_1s ("free", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2491               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2492
2493   add_sym_4s ("fseek", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2494               gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2495               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2496               whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2497
2498   add_sym_2s ("ftell", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2499               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2500               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2501
2502   add_sym_2s ("hostnm", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2503               gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2504               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2505
2506   add_sym_3s ("kill", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2507               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2508               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2509
2510   add_sym_3s ("link", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2511               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2512               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2513               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2514
2515   add_sym_1s ("perror", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2516               gfc_check_perror, NULL, gfc_resolve_perror,
2517               c, BT_CHARACTER, dc, REQUIRED);
2518
2519   add_sym_3s ("rename", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2520               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2521               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2522               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2523
2524   add_sym_1s ("sleep", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2525               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2526               val, BT_CHARACTER, dc, REQUIRED);
2527
2528   add_sym_3s ("fstat", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2529               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2530               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2531               st, BT_INTEGER, di, OPTIONAL);
2532
2533   add_sym_3s ("lstat", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2534               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2535               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2536               st, BT_INTEGER, di, OPTIONAL);
2537
2538   add_sym_3s ("stat", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2539               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2540               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2541               st, BT_INTEGER, di, OPTIONAL);
2542
2543   add_sym_3s ("signal", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2544               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2545               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2546               st, BT_INTEGER, di, OPTIONAL);
2547
2548   add_sym_3s ("symlnk", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2549               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2550               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2551               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2552
2553   add_sym_2s ("system", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2554               NULL, NULL, gfc_resolve_system_sub,
2555               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2556
2557   add_sym_3s ("system_clock", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_F95,
2558               gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2559               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2560               cm, BT_INTEGER, di, OPTIONAL);
2561
2562   add_sym_2s ("ttynam", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2563               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2564               ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2565
2566   add_sym_2s ("umask", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2567               gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2568               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2569
2570   add_sym_2s ("unlink", NOT_ELEMENTAL,  BT_UNKNOWN, 0, GFC_STD_GNU,
2571               gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2572               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2573 }
2574
2575
2576 /* Add a function to the list of conversion symbols.  */
2577
2578 static void
2579 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2580 {
2581   gfc_typespec from, to;
2582   gfc_intrinsic_sym *sym;
2583
2584   if (sizing == SZ_CONVS)
2585     {
2586       nconv++;
2587       return;
2588     }
2589
2590   gfc_clear_ts (&from);
2591   from.type = from_type;
2592   from.kind = from_kind;
2593
2594   gfc_clear_ts (&to);
2595   to.type = to_type;
2596   to.kind = to_kind;
2597
2598   sym = conversion + nconv;
2599
2600   sym->name = conv_name (&from, &to);
2601   sym->lib_name = sym->name;
2602   sym->simplify.cc = gfc_convert_constant;
2603   sym->standard = standard;
2604   sym->elemental = 1;
2605   sym->ts = to;
2606   sym->generic_id = GFC_ISYM_CONVERSION;
2607
2608   nconv++;
2609 }
2610
2611
2612 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2613    functions by looping over the kind tables.  */
2614
2615 static void
2616 add_conversions (void)
2617 {
2618   int i, j;
2619
2620   /* Integer-Integer conversions.  */
2621   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2622     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2623       {
2624         if (i == j)
2625           continue;
2626
2627         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2628                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2629       }
2630
2631   /* Integer-Real/Complex conversions.  */
2632   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2633     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2634       {
2635         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2636                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2637
2638         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2639                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2640
2641         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2642                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2643
2644         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2645                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2646       }
2647
2648   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2649     {
2650       /* Hollerith-Integer conversions.  */
2651       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2652         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2653                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2654       /* Hollerith-Real conversions.  */
2655       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2656         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2657                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2658       /* Hollerith-Complex conversions.  */
2659       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2660         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2661                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2662
2663       /* Hollerith-Character conversions.  */
2664       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2665                   gfc_default_character_kind, GFC_STD_LEGACY);
2666
2667       /* Hollerith-Logical conversions.  */
2668       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2669         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2670                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2671     }
2672
2673   /* Real/Complex - Real/Complex conversions.  */
2674   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2675     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2676       {
2677         if (i != j)
2678           {
2679             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2680                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2681
2682             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2683                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2684           }
2685
2686         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2687                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2688
2689         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2690                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2691       }
2692
2693   /* Logical/Logical kind conversion.  */
2694   for (i = 0; gfc_logical_kinds[i].kind; i++)
2695     for (j = 0; gfc_logical_kinds[j].kind; j++)
2696       {
2697         if (i == j)
2698           continue;
2699
2700         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2701                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2702       }
2703
2704   /* Integer-Logical and Logical-Integer conversions.  */
2705   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2706     for (i=0; gfc_integer_kinds[i].kind; i++)
2707       for (j=0; gfc_logical_kinds[j].kind; j++)
2708         {
2709           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2710                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2711           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2712                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2713         }
2714 }
2715
2716
2717 /* Initialize the table of intrinsics.  */
2718 void
2719 gfc_intrinsic_init_1 (void)
2720 {
2721   int i;
2722
2723   nargs = nfunc = nsub = nconv = 0;
2724
2725   /* Create a namespace to hold the resolved intrinsic symbols.  */
2726   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2727
2728   sizing = SZ_FUNCS;
2729   add_functions ();
2730   sizing = SZ_SUBS;
2731   add_subroutines ();
2732   sizing = SZ_CONVS;
2733   add_conversions ();
2734
2735   functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2736                           + sizeof (gfc_intrinsic_arg) * nargs);
2737
2738   next_sym = functions;
2739   subroutines = functions + nfunc;
2740
2741   conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2742
2743   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2744
2745   sizing = SZ_NOTHING;
2746   nconv = 0;
2747
2748   add_functions ();
2749   add_subroutines ();
2750   add_conversions ();
2751
2752   /* Set the pure flag.  All intrinsic functions are pure, and
2753      intrinsic subroutines are pure if they are elemental.  */
2754
2755   for (i = 0; i < nfunc; i++)
2756     functions[i].pure = 1;
2757
2758   for (i = 0; i < nsub; i++)
2759     subroutines[i].pure = subroutines[i].elemental;
2760 }
2761
2762
2763 void
2764 gfc_intrinsic_done_1 (void)
2765 {
2766   gfc_free (functions);
2767   gfc_free (conversion);
2768   gfc_free_namespace (gfc_intrinsic_namespace);
2769 }
2770
2771
2772 /******** Subroutines to check intrinsic interfaces ***********/
2773
2774 /* Given a formal argument list, remove any NULL arguments that may
2775    have been left behind by a sort against some formal argument list.  */
2776
2777 static void
2778 remove_nullargs (gfc_actual_arglist **ap)
2779 {
2780   gfc_actual_arglist *head, *tail, *next;
2781
2782   tail = NULL;
2783
2784   for (head = *ap; head; head = next)
2785     {
2786       next = head->next;
2787
2788       if (head->expr == NULL && !head->label)
2789         {
2790           head->next = NULL;
2791           gfc_free_actual_arglist (head);
2792         }
2793       else
2794         {
2795           if (tail == NULL)
2796             *ap = head;
2797           else
2798             tail->next = head;
2799
2800           tail = head;
2801           tail->next = NULL;
2802         }
2803     }
2804
2805   if (tail == NULL)
2806     *ap = NULL;
2807 }
2808
2809
2810 /* Given an actual arglist and a formal arglist, sort the actual
2811    arglist so that its arguments are in a one-to-one correspondence
2812    with the format arglist.  Arguments that are not present are given
2813    a blank gfc_actual_arglist structure.  If something is obviously
2814    wrong (say, a missing required argument) we abort sorting and
2815    return FAILURE.  */
2816
2817 static try
2818 sort_actual (const char *name, gfc_actual_arglist **ap,
2819              gfc_intrinsic_arg *formal, locus *where)
2820 {
2821   gfc_actual_arglist *actual, *a;
2822   gfc_intrinsic_arg *f;
2823
2824   remove_nullargs (ap);
2825   actual = *ap;
2826
2827   for (f = formal; f; f = f->next)
2828     f->actual = NULL;
2829
2830   f = formal;
2831   a = actual;
2832
2833   if (f == NULL && a == NULL)   /* No arguments */
2834     return SUCCESS;
2835
2836   for (;;)
2837     {           /* Put the nonkeyword arguments in a 1:1 correspondence */
2838       if (f == NULL)
2839         break;
2840       if (a == NULL)
2841         goto optional;
2842
2843       if (a->name != NULL)
2844         goto keywords;
2845
2846       f->actual = a;
2847
2848       f = f->next;
2849       a = a->next;
2850     }
2851
2852   if (a == NULL)
2853     goto do_sort;
2854
2855   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2856   return FAILURE;
2857
2858 keywords:
2859   /* Associate the remaining actual arguments, all of which have
2860      to be keyword arguments.  */
2861   for (; a; a = a->next)
2862     {
2863       for (f = formal; f; f = f->next)
2864         if (strcmp (a->name, f->name) == 0)
2865           break;
2866
2867       if (f == NULL)
2868         {
2869           if (a->name[0] == '%')
2870             gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
2871                        "are not allowed in this context at %L", where);
2872           else
2873             gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2874                        a->name, name, where);
2875           return FAILURE;
2876         }
2877
2878       if (f->actual != NULL)
2879         {
2880           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2881                      f->name, name, where);
2882           return FAILURE;
2883         }
2884
2885       f->actual = a;
2886     }
2887
2888 optional:
2889   /* At this point, all unmatched formal args must be optional.  */
2890   for (f = formal; f; f = f->next)
2891     {
2892       if (f->actual == NULL && f->optional == 0)
2893         {
2894           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2895                      f->name, name, where);
2896           return FAILURE;
2897         }
2898     }
2899
2900 do_sort:
2901   /* Using the formal argument list, string the actual argument list
2902      together in a way that corresponds with the formal list.  */
2903   actual = NULL;
2904
2905   for (f = formal; f; f = f->next)
2906     {
2907       if (f->actual && f->actual->label != NULL && f->ts.type)
2908         {
2909           gfc_error ("ALTERNATE RETURN not permitted at %L", where);
2910           return FAILURE;
2911         }
2912
2913       if (f->actual == NULL)
2914         {
2915           a = gfc_get_actual_arglist ();
2916           a->missing_arg_type = f->ts.type;
2917         }
2918       else
2919         a = f->actual;
2920
2921       if (actual == NULL)
2922         *ap = a;
2923       else
2924         actual->next = a;
2925
2926       actual = a;
2927     }
2928   actual->next = NULL;          /* End the sorted argument list.  */
2929
2930   return SUCCESS;
2931 }
2932
2933
2934 /* Compare an actual argument list with an intrinsic's formal argument
2935    list.  The lists are checked for agreement of type.  We don't check
2936    for arrayness here.  */
2937
2938 static try
2939 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
2940                int error_flag)
2941 {
2942   gfc_actual_arglist *actual;
2943   gfc_intrinsic_arg *formal;
2944   int i;
2945
2946   formal = sym->formal;
2947   actual = *ap;
2948
2949   i = 0;
2950   for (; formal; formal = formal->next, actual = actual->next, i++)
2951     {
2952       if (actual->expr == NULL)
2953         continue;
2954
2955       if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2956         {
2957           if (error_flag)
2958             gfc_error ("Type of argument '%s' in call to '%s' at %L should "
2959                        "be %s, not %s", gfc_current_intrinsic_arg[i],
2960                        gfc_current_intrinsic, &actual->expr->where,
2961                        gfc_typename (&formal->ts),
2962                        gfc_typename (&actual->expr->ts));
2963           return FAILURE;
2964         }
2965     }
2966
2967   return SUCCESS;
2968 }
2969
2970
2971 /* Given a pointer to an intrinsic symbol and an expression node that
2972    represent the function call to that subroutine, figure out the type
2973    of the result.  This may involve calling a resolution subroutine.  */
2974
2975 static void
2976 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
2977 {
2978   gfc_expr *a1, *a2, *a3, *a4, *a5;
2979   gfc_actual_arglist *arg;
2980
2981   if (specific->resolve.f1 == NULL)
2982     {
2983       if (e->value.function.name == NULL)
2984         e->value.function.name = specific->lib_name;
2985
2986       if (e->ts.type == BT_UNKNOWN)
2987         e->ts = specific->ts;
2988       return;
2989     }
2990
2991   arg = e->value.function.actual;
2992
2993   /* Special case hacks for MIN and MAX.  */
2994   if (specific->resolve.f1m == gfc_resolve_max
2995       || specific->resolve.f1m == gfc_resolve_min)
2996     {
2997       (*specific->resolve.f1m) (e, arg);
2998       return;
2999     }
3000
3001   if (arg == NULL)
3002     {
3003       (*specific->resolve.f0) (e);
3004       return;
3005     }
3006
3007   a1 = arg->expr;
3008   arg = arg->next;
3009
3010   if (arg == NULL)
3011     {
3012       (*specific->resolve.f1) (e, a1);
3013       return;
3014     }
3015
3016   a2 = arg->expr;
3017   arg = arg->next;
3018
3019   if (arg == NULL)
3020     {
3021       (*specific->resolve.f2) (e, a1, a2);
3022       return;
3023     }
3024
3025   a3 = arg->expr;
3026   arg = arg->next;
3027
3028   if (arg == NULL)
3029     {
3030       (*specific->resolve.f3) (e, a1, a2, a3);
3031       return;
3032     }
3033
3034   a4 = arg->expr;
3035   arg = arg->next;
3036
3037   if (arg == NULL)
3038     {
3039       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3040       return;
3041     }
3042
3043   a5 = arg->expr;
3044   arg = arg->next;
3045
3046   if (arg == NULL)
3047     {
3048       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3049       return;
3050     }
3051
3052   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3053 }
3054
3055
3056 /* Given an intrinsic symbol node and an expression node, call the
3057    simplification function (if there is one), perhaps replacing the
3058    expression with something simpler.  We return FAILURE on an error
3059    of the simplification, SUCCESS if the simplification worked, even
3060    if nothing has changed in the expression itself.  */
3061
3062 static try
3063 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3064 {
3065   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3066   gfc_actual_arglist *arg;
3067
3068   /* Check the arguments if there are Hollerith constants. We deal with
3069      them at run-time.  */
3070   for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
3071     {
3072       if (arg->expr && arg->expr->from_H)
3073         {
3074           result = NULL;
3075           goto finish;
3076         }
3077     }
3078   /* Max and min require special handling due to the variable number
3079      of args.  */
3080   if (specific->simplify.f1 == gfc_simplify_min)
3081     {
3082       result = gfc_simplify_min (e);
3083       goto finish;
3084     }
3085
3086   if (specific->simplify.f1 == gfc_simplify_max)
3087     {
3088       result = gfc_simplify_max (e);
3089       goto finish;
3090     }
3091
3092   if (specific->simplify.f1 == NULL)
3093     {
3094       result = NULL;
3095       goto finish;
3096     }
3097
3098   arg = e->value.function.actual;
3099
3100   if (arg == NULL)
3101     {
3102       result = (*specific->simplify.f0) ();
3103       goto finish;
3104     }
3105
3106   a1 = arg->expr;
3107   arg = arg->next;
3108
3109   if (specific->simplify.cc == gfc_convert_constant)
3110     {
3111       result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3112       goto finish;
3113     }
3114
3115   /* TODO: Warn if -pedantic and initialization expression and arg
3116      types not integer or character */
3117
3118   if (arg == NULL)
3119     result = (*specific->simplify.f1) (a1);
3120   else
3121     {
3122       a2 = arg->expr;
3123       arg = arg->next;
3124
3125       if (arg == NULL)
3126         result = (*specific->simplify.f2) (a1, a2);
3127       else
3128         {
3129           a3 = arg->expr;
3130           arg = arg->next;
3131
3132           if (arg == NULL)
3133             result = (*specific->simplify.f3) (a1, a2, a3);
3134           else
3135             {
3136               a4 = arg->expr;
3137               arg = arg->next;
3138
3139               if (arg == NULL)
3140                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3141               else
3142                 {
3143                   a5 = arg->expr;
3144                   arg = arg->next;
3145
3146                   if (arg == NULL)
3147                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3148                   else
3149                     gfc_internal_error
3150                       ("do_simplify(): Too many args for intrinsic");
3151                 }
3152             }
3153         }
3154     }
3155
3156 finish:
3157   if (result == &gfc_bad_expr)
3158     return FAILURE;
3159
3160   if (result == NULL)
3161     resolve_intrinsic (specific, e);    /* Must call at run-time */
3162   else
3163     {
3164       result->where = e->where;
3165       gfc_replace_expr (e, result);
3166     }
3167
3168   return SUCCESS;
3169 }
3170
3171
3172 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3173    error messages.  This subroutine returns FAILURE if a subroutine
3174    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3175    list cannot match any intrinsic.  */
3176
3177 static void
3178 init_arglist (gfc_intrinsic_sym *isym)
3179 {
3180   gfc_intrinsic_arg *formal;
3181   int i;
3182
3183   gfc_current_intrinsic = isym->name;
3184
3185   i = 0;
3186   for (formal = isym->formal; formal; formal = formal->next)
3187     {
3188       if (i >= MAX_INTRINSIC_ARGS)
3189         gfc_internal_error ("init_arglist(): too many arguments");
3190       gfc_current_intrinsic_arg[i++] = formal->name;
3191     }
3192 }
3193
3194
3195 /* Given a pointer to an intrinsic symbol and an expression consisting
3196    of a function call, see if the function call is consistent with the
3197    intrinsic's formal argument list.  Return SUCCESS if the expression
3198    and intrinsic match, FAILURE otherwise.  */
3199
3200 static try
3201 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3202 {
3203   gfc_actual_arglist *arg, **ap;
3204   int r;
3205   try t;
3206
3207   ap = &expr->value.function.actual;
3208
3209   init_arglist (specific);
3210
3211   /* Don't attempt to sort the argument list for min or max.  */
3212   if (specific->check.f1m == gfc_check_min_max
3213       || specific->check.f1m == gfc_check_min_max_integer
3214       || specific->check.f1m == gfc_check_min_max_real
3215       || specific->check.f1m == gfc_check_min_max_double)
3216     return (*specific->check.f1m) (*ap);
3217
3218   if (sort_actual (specific->name, ap, specific->formal,
3219                    &expr->where) == FAILURE)
3220     return FAILURE;
3221
3222   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3223     /* This is special because we might have to reorder the argument list.  */
3224     t = gfc_check_minloc_maxloc (*ap);
3225   else if (specific->check.f3red == gfc_check_minval_maxval)
3226     /* This is also special because we also might have to reorder the
3227        argument list.  */
3228     t = gfc_check_minval_maxval (*ap);
3229   else if (specific->check.f3red == gfc_check_product_sum)
3230     /* Same here. The difference to the previous case is that we allow a
3231        general numeric type.  */
3232     t = gfc_check_product_sum (*ap);
3233   else
3234      {
3235        if (specific->check.f1 == NULL)
3236          {
3237            t = check_arglist (ap, specific, error_flag);
3238            if (t == SUCCESS)
3239              expr->ts = specific->ts;
3240          }
3241        else
3242          t = do_check (specific, *ap);
3243      }
3244
3245   /* Check ranks for elemental intrinsics.  */
3246   if (t == SUCCESS && specific->elemental)
3247     {
3248       r = 0;
3249       for (arg = expr->value.function.actual; arg; arg = arg->next)
3250         {
3251           if (arg->expr == NULL || arg->expr->rank == 0)
3252             continue;
3253           if (r == 0)
3254             {
3255               r = arg->expr->rank;
3256               continue;
3257             }
3258
3259           if (arg->expr->rank != r)
3260             {
3261               gfc_error ("Ranks of arguments to elemental intrinsic '%s' "
3262                          "differ at %L", specific->name, &arg->expr->where);
3263               return FAILURE;
3264             }
3265         }
3266     }
3267
3268   if (t == FAILURE)
3269     remove_nullargs (ap);
3270
3271   return t;
3272 }
3273
3274
3275 /* See if an intrinsic is one of the intrinsics we evaluate
3276    as an extension.  */
3277
3278 static int
3279 gfc_init_expr_extensions (gfc_intrinsic_sym *isym)
3280 {
3281   /* FIXME: This should be moved into the intrinsic definitions.  */
3282   static const char * const init_expr_extensions[] = {
3283     "digits", "epsilon", "huge", "kind", "maxexponent", "minexponent",
3284     "precision", "present", "radix", "range", "selected_real_kind",
3285     "tiny", NULL
3286   };
3287
3288   int i;
3289
3290   for (i = 0; init_expr_extensions[i]; i++)
3291     if (strcmp (init_expr_extensions[i], isym->name) == 0)
3292       return 0;
3293
3294   return 1;
3295 }
3296
3297
3298 /* Check whether an intrinsic belongs to whatever standard the user
3299    has chosen.  */
3300
3301 static void
3302 check_intrinsic_standard (const char *name, int standard, locus *where)
3303 {
3304   if (!gfc_option.warn_nonstd_intrinsics)
3305     return;
3306
3307   gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3308                   "in the selected standard", name, where);
3309 }
3310
3311
3312 /* See if a function call corresponds to an intrinsic function call.
3313    We return:
3314
3315     MATCH_YES    if the call corresponds to an intrinsic, simplification
3316                  is done if possible.
3317
3318     MATCH_NO     if the call does not correspond to an intrinsic
3319
3320     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3321                  error during the simplification process.
3322
3323    The error_flag parameter enables an error reporting.  */
3324
3325 match
3326 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3327 {
3328   gfc_intrinsic_sym *isym, *specific;
3329   gfc_actual_arglist *actual;
3330   const char *name;
3331   int flag;
3332
3333   if (expr->value.function.isym != NULL)
3334     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3335            ? MATCH_ERROR : MATCH_YES;
3336
3337   gfc_suppress_error = !error_flag;
3338   flag = 0;
3339
3340   for (actual = expr->value.function.actual; actual; actual = actual->next)
3341     if (actual->expr != NULL)
3342       flag |= (actual->expr->ts.type != BT_INTEGER
3343                && actual->expr->ts.type != BT_CHARACTER);
3344
3345   name = expr->symtree->n.sym->name;
3346
3347   isym = specific = gfc_find_function (name);
3348   if (isym == NULL)
3349     {
3350       gfc_suppress_error = 0;
3351       return MATCH_NO;
3352     }
3353
3354   gfc_current_intrinsic_where = &expr->where;
3355
3356   /* Bypass the generic list for min and max.  */
3357   if (isym->check.f1m == gfc_check_min_max)
3358     {
3359       init_arglist (isym);
3360
3361       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3362         goto got_specific;
3363
3364       gfc_suppress_error = 0;
3365       return MATCH_NO;
3366     }
3367
3368   /* If the function is generic, check all of its specific
3369      incarnations.  If the generic name is also a specific, we check
3370      that name last, so that any error message will correspond to the
3371      specific.  */
3372   gfc_suppress_error = 1;
3373
3374   if (isym->generic)
3375     {
3376       for (specific = isym->specific_head; specific;
3377            specific = specific->next)
3378         {
3379           if (specific == isym)
3380             continue;
3381           if (check_specific (specific, expr, 0) == SUCCESS)
3382             goto got_specific;
3383         }
3384     }
3385
3386   gfc_suppress_error = !error_flag;
3387
3388   if (check_specific (isym, expr, error_flag) == FAILURE)
3389     {
3390       gfc_suppress_error = 0;
3391       return MATCH_NO;
3392     }
3393
3394   specific = isym;
3395
3396 got_specific:
3397   expr->value.function.isym = specific;
3398   gfc_intrinsic_symbol (expr->symtree->n.sym);
3399
3400   gfc_suppress_error = 0;
3401   if (do_simplify (specific, expr) == FAILURE)
3402     return MATCH_ERROR;
3403
3404   /* TODO: We should probably only allow elemental functions here.  */
3405   flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER);
3406
3407   if (gfc_init_expr && flag && gfc_init_expr_extensions (specific))
3408     {
3409       if (gfc_notify_std (GFC_STD_GNU, "Extension: Evaluation of "
3410                           "nonstandard initialization expression at %L",
3411                           &expr->where) == FAILURE)
3412         {
3413           return MATCH_ERROR;
3414         }
3415     }
3416
3417   check_intrinsic_standard (name, isym->standard, &expr->where);
3418
3419   return MATCH_YES;
3420 }
3421
3422
3423 /* See if a CALL statement corresponds to an intrinsic subroutine.
3424    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3425    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3426    correspond).  */
3427
3428 match
3429 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3430 {
3431   gfc_intrinsic_sym *isym;
3432   const char *name;
3433
3434   name = c->symtree->n.sym->name;
3435
3436   isym = find_subroutine (name);
3437   if (isym == NULL)
3438     return MATCH_NO;
3439
3440   gfc_suppress_error = !error_flag;
3441
3442   init_arglist (isym);
3443
3444   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3445     goto fail;
3446
3447   if (isym->check.f1 != NULL)
3448     {
3449       if (do_check (isym, c->ext.actual) == FAILURE)
3450         goto fail;
3451     }
3452   else
3453     {
3454       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3455         goto fail;
3456     }
3457
3458   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3459      seen at this point.  */
3460   gfc_suppress_error = 0;
3461
3462   if (isym->resolve.s1 != NULL)
3463     isym->resolve.s1 (c);
3464   else
3465     c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3466
3467   if (gfc_pure (NULL) && !isym->elemental)
3468     {
3469       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3470                  &c->loc);
3471       return MATCH_ERROR;
3472     }
3473
3474   c->resolved_sym->attr.noreturn = isym->noreturn;
3475   check_intrinsic_standard (name, isym->standard, &c->loc);
3476
3477   return MATCH_YES;
3478
3479 fail:
3480   gfc_suppress_error = 0;
3481   return MATCH_NO;
3482 }
3483
3484
3485 /* Call gfc_convert_type() with warning enabled.  */
3486
3487 try
3488 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3489 {
3490   return gfc_convert_type_warn (expr, ts, eflag, 1);
3491 }
3492
3493
3494 /* Try to convert an expression (in place) from one type to another.
3495    'eflag' controls the behavior on error.
3496
3497    The possible values are:
3498
3499      1 Generate a gfc_error()
3500      2 Generate a gfc_internal_error().
3501
3502    'wflag' controls the warning related to conversion.  */
3503
3504 try
3505 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3506 {
3507   gfc_intrinsic_sym *sym;
3508   gfc_typespec from_ts;
3509   locus old_where;
3510   gfc_expr *new;
3511   int rank;
3512   mpz_t *shape;
3513
3514   from_ts = expr->ts;           /* expr->ts gets clobbered */
3515
3516   if (ts->type == BT_UNKNOWN)
3517     goto bad;
3518
3519   /* NULL and zero size arrays get their type here.  */
3520   if (expr->expr_type == EXPR_NULL
3521       || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3522     {
3523       /* Sometimes the RHS acquire the type.  */
3524       expr->ts = *ts;
3525       return SUCCESS;
3526     }
3527
3528   if (expr->ts.type == BT_UNKNOWN)
3529     goto bad;
3530
3531   if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3532       && gfc_compare_types (&expr->ts, ts))
3533     return SUCCESS;
3534
3535   sym = find_conv (&expr->ts, ts);
3536   if (sym == NULL)
3537     goto bad;
3538
3539   /* At this point, a conversion is necessary. A warning may be needed.  */
3540   if ((gfc_option.warn_std & sym->standard) != 0)
3541     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3542                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3543   else if (wflag && gfc_option.warn_conversion)
3544     gfc_warning_now ("Conversion from %s to %s at %L",
3545                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3546
3547   /* Insert a pre-resolved function call to the right function.  */
3548   old_where = expr->where;
3549   rank = expr->rank;
3550   shape = expr->shape;
3551
3552   new = gfc_get_expr ();
3553   *new = *expr;
3554
3555   new = gfc_build_conversion (new);
3556   new->value.function.name = sym->lib_name;
3557   new->value.function.isym = sym;
3558   new->where = old_where;
3559   new->rank = rank;
3560   new->shape = gfc_copy_shape (shape, rank);
3561
3562   gfc_get_ha_sym_tree (sym->name, &new->symtree);
3563   new->symtree->n.sym->ts = *ts;
3564   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3565   new->symtree->n.sym->attr.function = 1;
3566   new->symtree->n.sym->attr.intrinsic = 1;
3567   new->symtree->n.sym->attr.elemental = 1;
3568   new->symtree->n.sym->attr.pure = 1;
3569   new->symtree->n.sym->attr.referenced = 1;
3570   gfc_intrinsic_symbol(new->symtree->n.sym);
3571   gfc_commit_symbol (new->symtree->n.sym);
3572
3573   *expr = *new;
3574
3575   gfc_free (new);
3576   expr->ts = *ts;
3577
3578   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3579       && do_simplify (sym, expr) == FAILURE)
3580     {
3581
3582       if (eflag == 2)
3583         goto bad;
3584       return FAILURE;           /* Error already generated in do_simplify() */
3585     }
3586
3587   return SUCCESS;
3588
3589 bad:
3590   if (eflag == 1)
3591     {
3592       gfc_error ("Can't convert %s to %s at %L",
3593                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3594       return FAILURE;
3595     }
3596
3597   gfc_internal_error ("Can't convert %s to %s at %L",
3598                       gfc_typename (&from_ts), gfc_typename (ts),
3599                       &expr->where);
3600   /* Not reached */
3601 }