gcc/fortran/intrinsic.c

   1 /* Build up a list of intrinsic subroutines and functions for the
   2    name-resolution stage.
   3    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
   4    Free Software Foundation, Inc.
   5    Contributed by Andy Vaught & Katherine Holcomb
   6
   7 This file is part of GCC.
   8
   9 GCC is free software; you can redistribute it and/or modify it under
  10 the terms of the GNU General Public License as published by the Free
  11 Software Foundation; either version 2, or (at your option) any later
  12 version.
  13
  14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with GCC; see the file COPYING.  If not, write to the Free
  21 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.  */
  23
  24
  25 #include "config.h"
  26 #include "system.h"
  27 #include "flags.h"
  28 #include "gfortran.h"
  29 #include "intrinsic.h"
  30
  31
  32 /* Namespace to hold the resolved symbols for intrinsic subroutines.  */
  33 static gfc_namespace *gfc_intrinsic_namespace;
  34
  35 int gfc_init_expr = 0;
  36
  37 /* Pointers to an intrinsic function and its argument names that are being
  38    checked.  */
  39
  40 const char *gfc_current_intrinsic;
  41 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
  42 locus *gfc_current_intrinsic_where;
  43
  44 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
  45 static gfc_intrinsic_arg *next_arg;
  46
  47 static int nfunc, nsub, nargs, nconv;
  48
  49 static enum
  50 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
  51 sizing;
  52
  53 #define REQUIRED        0
  54 #define OPTIONAL        1
  55
  56 /* Return a letter based on the passed type.  Used to construct the
  57    name of a type-dependent subroutine.  */
  58
  59 char
  60 gfc_type_letter (bt type)
  61 {
  62   char c;
  63
  64   switch (type)
  65     {
  66     case BT_LOGICAL:
  67       c = 'l';
  68       break;
  69     case BT_CHARACTER:
  70       c = 's';
  71       break;
  72     case BT_INTEGER:
  73       c = 'i';
  74       break;
  75     case BT_REAL:
  76       c = 'r';
  77       break;
  78     case BT_COMPLEX:
  79       c = 'c';
  80       break;
  81
  82     case BT_HOLLERITH:
  83       c = 'h';
  84       break;
  85
  86     default:
  87       c = 'u';
  88       break;
  89     }
  90
  91   return c;
  92 }
  93
  94
  95 /* Get a symbol for a resolved name.  */
  96
  97 gfc_symbol *
  98 gfc_get_intrinsic_sub_symbol (const char * name)
  99 {
 100   gfc_symbol *sym;
 101
 102   gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
 103   sym->attr.always_explicit = 1;
 104   sym->attr.subroutine = 1;
 105   sym->attr.flavor = FL_PROCEDURE;
 106   sym->attr.proc = PROC_INTRINSIC;
 107
 108   return sym;
 109 }
 110
 111
 112 /* Return a pointer to the name of a conversion function given two
 113    typespecs.  */
 114
 115 static const char *
 116 conv_name (gfc_typespec * from, gfc_typespec * to)
 117 {
 118   static char name[30];
 119
 120   sprintf (name, "__convert_%c%d_%c%d", gfc_type_letter (from->type),
 121            from->kind, gfc_type_letter (to->type), to->kind);
 122
 123   return gfc_get_string (name);
 124 }
 125
 126
 127 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
 128    corresponds to the conversion.  Returns NULL if the conversion
 129    isn't found.  */
 130
 131 static gfc_intrinsic_sym *
 132 find_conv (gfc_typespec * from, gfc_typespec * to)
 133 {
 134   gfc_intrinsic_sym *sym;
 135   const char *target;
 136   int i;
 137
 138   target = conv_name (from, to);
 139   sym = conversion;
 140
 141   for (i = 0; i < nconv; i++, sym++)
 142     if (strcmp (target, sym->name) == 0)
 143       return sym;
 144
 145   return NULL;
 146 }
 147
 148
 149 /* Interface to the check functions.  We break apart an argument list
 150    and call the proper check function rather than forcing each
 151    function to manipulate the argument list.  */
 152
 153 static try
 154 do_check (gfc_intrinsic_sym * specific, gfc_actual_arglist * arg)
 155 {
 156   gfc_expr *a1, *a2, *a3, *a4, *a5;
 157
 158   if (arg == NULL)
 159     return (*specific->check.f0) ();
 160
 161   a1 = arg->expr;
 162   arg = arg->next;
 163   if (arg == NULL)
 164     return (*specific->check.f1) (a1);
 165
 166   a2 = arg->expr;
 167   arg = arg->next;
 168   if (arg == NULL)
 169     return (*specific->check.f2) (a1, a2);
 170
 171   a3 = arg->expr;
 172   arg = arg->next;
 173   if (arg == NULL)
 174     return (*specific->check.f3) (a1, a2, a3);
 175
 176   a4 = arg->expr;
 177   arg = arg->next;
 178   if (arg == NULL)
 179     return (*specific->check.f4) (a1, a2, a3, a4);
 180
 181   a5 = arg->expr;
 182   arg = arg->next;
 183   if (arg == NULL)
 184     return (*specific->check.f5) (a1, a2, a3, a4, a5);
 185
 186   gfc_internal_error ("do_check(): too many args");
 187 }
 188
 189
 190 /*********** Subroutines to build the intrinsic list ****************/
 191
 192 /* Add a single intrinsic symbol to the current list.
 193
 194    Argument list:
 195       char *     name of function
 196       int        whether function is elemental
 197       int        If the function can be used as an actual argument [1] [2]
 198       bt         return type of function
 199       int        kind of return type of function
 200       int        Fortran standard version
 201       check      pointer to check function
 202       simplify   pointer to simplification function
 203       resolve    pointer to resolution function
 204
 205    Optional arguments come in multiples of four:
 206       char *    name of argument
 207       bt        type of argument
 208       int       kind of argument
 209       int       arg optional flag (1=optional, 0=required)
 210
 211    The sequence is terminated by a NULL name.
 212
 213
 214  [1] Whether a function can or cannot be used as an actual argument is
 215      determined by its presence on the 13.6 list in Fortran 2003.  The
 216      following intrinsics, which are GNU extensions, are considered allowed
 217      as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
 218      ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT.
 219  [2] The value 2 is used in this field for CHAR, which is allowed as an
 220      actual argument in F2003, but not in F95. It is the only such
 221      intrinsic function.  */
 222
 223 static void
 224 add_sym (const char *name, int elemental, int actual_ok, bt type, int kind,
 225          int standard, gfc_check_f check, gfc_simplify_f simplify,
 226          gfc_resolve_f resolve, ...)
 227 {
 228   char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
 229   int optional, first_flag;
 230   va_list argp;
 231
 232   /* First check that the intrinsic belongs to the selected standard.
 233      If not, don't add it to the symbol list.  */
 234   if (!(gfc_option.allow_std & standard)
 235       && gfc_option.flag_all_intrinsics == 0)
 236     return;
 237
 238   switch (sizing)
 239     {
 240     case SZ_SUBS:
 241       nsub++;
 242       break;
 243
 244     case SZ_FUNCS:
 245       nfunc++;
 246       break;
 247
 248     case SZ_NOTHING:
 249       next_sym->name = gfc_get_string (name);
 250
 251       strcpy (buf, "_gfortran_");
 252       strcat (buf, name);
 253       next_sym->lib_name = gfc_get_string (buf);
 254
 255       next_sym->elemental = elemental;
 256       next_sym->actual_ok = actual_ok;
 257       next_sym->ts.type = type;
 258       next_sym->ts.kind = kind;
 259       next_sym->standard = standard;
 260       next_sym->simplify = simplify;
 261       next_sym->check = check;
 262       next_sym->resolve = resolve;
 263       next_sym->specific = 0;
 264       next_sym->generic = 0;
 265       break;
 266
 267     default:
 268       gfc_internal_error ("add_sym(): Bad sizing mode");
 269     }
 270
 271   va_start (argp, resolve);
 272
 273   first_flag = 1;
 274
 275   for (;;)
 276     {
 277       name = va_arg (argp, char *);
 278       if (name == NULL)
 279         break;
 280
 281       type = (bt) va_arg (argp, int);
 282       kind = va_arg (argp, int);
 283       optional = va_arg (argp, int);
 284
 285       if (sizing != SZ_NOTHING)
 286         nargs++;
 287       else
 288         {
 289           next_arg++;
 290
 291           if (first_flag)
 292             next_sym->formal = next_arg;
 293           else
 294             (next_arg - 1)->next = next_arg;
 295
 296           first_flag = 0;
 297
 298           strcpy (next_arg->name, name);
 299           next_arg->ts.type = type;
 300           next_arg->ts.kind = kind;
 301           next_arg->optional = optional;
 302         }
 303     }
 304
 305   va_end (argp);
 306
 307   next_sym++;
 308 }
 309
 310
 311 /* Add a symbol to the function list where the function takes
 312    0 arguments.  */
 313
 314 static void
 315 add_sym_0 (const char *name, int elemental, int actual_ok, bt type,
 316                        int kind, int standard,
 317                        try (*check)(void),
 318                        gfc_expr *(*simplify)(void),
 319            void (*resolve)(gfc_expr *))
 320 {
 321   gfc_simplify_f sf;
 322   gfc_check_f cf;
 323   gfc_resolve_f rf;
 324
 325   cf.f0 = check;
 326   sf.f0 = simplify;
 327   rf.f0 = resolve;
 328
 329   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 330            (void*)0);
 331 }
 332
 333
 334 /* Add a symbol to the subroutine list where the subroutine takes
 335    0 arguments.  */
 336
 337 static void
 338 add_sym_0s (const char * name, int standard,
 339             void (*resolve)(gfc_code *))
 340 {
 341   gfc_check_f cf;
 342   gfc_simplify_f sf;
 343   gfc_resolve_f rf;
 344
 345   cf.f1 = NULL;
 346   sf.f1 = NULL;
 347   rf.s1 = resolve;
 348
 349   add_sym (name, 1, 0, BT_UNKNOWN, 0, standard, cf, sf, rf,
 350            (void*)0);
 351 }
 352
 353
 354 /* Add a symbol to the function list where the function takes
 355    1 arguments.  */
 356
 357 static void
 358 add_sym_1 (const char *name, int elemental, int actual_ok, bt type,
 359            int kind, int standard,
 360            try (*check)(gfc_expr *),
 361            gfc_expr *(*simplify)(gfc_expr *),
 362            void (*resolve)(gfc_expr *,gfc_expr *),
 363            const char* a1, bt type1, int kind1, int optional1)
 364 {
 365   gfc_check_f cf;
 366   gfc_simplify_f sf;
 367   gfc_resolve_f rf;
 368
 369   cf.f1 = check;
 370   sf.f1 = simplify;
 371   rf.f1 = resolve;
 372
 373   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 374            a1, type1, kind1, optional1,
 375            (void*)0);
 376 }
 377
 378
 379 /* Add a symbol to the subroutine list where the subroutine takes
 380    1 arguments.  */
 381
 382 static void
 383 add_sym_1s (const char *name, int elemental, bt type,
 384                         int kind, int standard,
 385                         try (*check)(gfc_expr *),
 386                         gfc_expr *(*simplify)(gfc_expr *),
 387                         void (*resolve)(gfc_code *),
 388             const char* a1, bt type1, int kind1, int optional1)
 389 {
 390   gfc_check_f cf;
 391   gfc_simplify_f sf;
 392   gfc_resolve_f rf;
 393
 394   cf.f1 = check;
 395   sf.f1 = simplify;
 396   rf.s1 = resolve;
 397
 398   add_sym (name, elemental, 0, type, kind, standard, cf, sf, rf,
 399            a1, type1, kind1, optional1,
 400            (void*)0);
 401 }
 402
 403
 404 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
 405    function.  MAX et al take 2 or more arguments.  */
 406
 407 static void
 408 add_sym_1m (const char *name, int elemental, int actual_ok, bt type,
 409                         int kind, int standard,
 410                         try (*check)(gfc_actual_arglist *),
 411                         gfc_expr *(*simplify)(gfc_expr *),
 412                         void (*resolve)(gfc_expr *,gfc_actual_arglist *),
 413                         const char* a1, bt type1, int kind1, int optional1,
 414             const char* a2, bt type2, int kind2, int optional2)
 415 {
 416   gfc_check_f cf;
 417   gfc_simplify_f sf;
 418   gfc_resolve_f rf;
 419
 420   cf.f1m = check;
 421   sf.f1 = simplify;
 422   rf.f1m = resolve;
 423
 424   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 425            a1, type1, kind1, optional1,
 426            a2, type2, kind2, optional2,
 427            (void*)0);
 428 }
 429
 430
 431 /* Add a symbol to the function list where the function takes
 432    2 arguments.  */
 433
 434 static void
 435 add_sym_2 (const char *name, int elemental, int actual_ok, bt type,
 436                        int kind, int standard,
 437                        try (*check)(gfc_expr *,gfc_expr *),
 438                        gfc_expr *(*simplify)(gfc_expr *,gfc_expr *),
 439                        void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *),
 440                        const char* a1, bt type1, int kind1, int optional1,
 441            const char* a2, bt type2, int kind2, int optional2)
 442 {
 443   gfc_check_f cf;
 444   gfc_simplify_f sf;
 445   gfc_resolve_f rf;
 446
 447   cf.f2 = check;
 448   sf.f2 = simplify;
 449   rf.f2 = resolve;
 450
 451   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 452            a1, type1, kind1, optional1,
 453            a2, type2, kind2, optional2,
 454            (void*)0);
 455 }
 456
 457
 458 /* Add a symbol to the subroutine list where the subroutine takes
 459    2 arguments.  */
 460
 461 static void
 462 add_sym_2s (const char *name, int elemental, bt type,
 463                         int kind, int standard,
 464                        try (*check)(gfc_expr *,gfc_expr *),
 465                        gfc_expr *(*simplify)(gfc_expr *,gfc_expr *),
 466                        void (*resolve)(gfc_code *),
 467                        const char* a1, bt type1, int kind1, int optional1,
 468             const char* a2, bt type2, int kind2, int optional2)
 469 {
 470   gfc_check_f cf;
 471   gfc_simplify_f sf;
 472   gfc_resolve_f rf;
 473
 474   cf.f2 = check;
 475   sf.f2 = simplify;
 476   rf.s1 = resolve;
 477
 478   add_sym (name, elemental, 0, type, kind, standard, cf, sf, rf,
 479            a1, type1, kind1, optional1,
 480            a2, type2, kind2, optional2,
 481            (void*)0);
 482 }
 483
 484
 485 /* Add a symbol to the function list where the function takes
 486    3 arguments.  */
 487
 488 static void
 489 add_sym_3 (const char *name, int elemental, int actual_ok, bt type,
 490                        int kind, int standard,
 491                        try (*check)(gfc_expr *,gfc_expr *,gfc_expr *),
 492                        gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *),
 493                        void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 494                        const char* a1, bt type1, int kind1, int optional1,
 495                        const char* a2, bt type2, int kind2, int optional2,
 496            const char* a3, bt type3, int kind3, int optional3)
 497 {
 498   gfc_check_f cf;
 499   gfc_simplify_f sf;
 500   gfc_resolve_f rf;
 501
 502   cf.f3 = check;
 503   sf.f3 = simplify;
 504   rf.f3 = resolve;
 505
 506   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 507            a1, type1, kind1, optional1,
 508            a2, type2, kind2, optional2,
 509            a3, type3, kind3, optional3,
 510            (void*)0);
 511 }
 512
 513
 514 /* MINLOC and MAXLOC get special treatment because their argument
 515    might have to be reordered.  */
 516
 517 static void
 518 add_sym_3ml (const char *name, int elemental,
 519                          int actual_ok, bt type, int kind, int standard,
 520                          try (*check)(gfc_actual_arglist *),
 521                          gfc_expr*(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *),
 522                          void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 523                          const char* a1, bt type1, int kind1, int optional1,
 524                          const char* a2, bt type2, int kind2, int optional2,
 525              const char* a3, bt type3, int kind3, int optional3)
 526 {
 527   gfc_check_f cf;
 528   gfc_simplify_f sf;
 529   gfc_resolve_f rf;
 530
 531   cf.f3ml = check;
 532   sf.f3 = simplify;
 533   rf.f3 = resolve;
 534
 535   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 536            a1, type1, kind1, optional1,
 537            a2, type2, kind2, optional2,
 538            a3, type3, kind3, optional3,
 539            (void*)0);
 540 }
 541
 542
 543 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
 544    their argument also might have to be reordered.  */
 545
 546 static void
 547 add_sym_3red (const char *name, int elemental,
 548                           int actual_ok, bt type, int kind, int standard,
 549                           try (*check)(gfc_actual_arglist *),
 550                           gfc_expr*(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *),
 551                           void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 552                           const char* a1, bt type1, int kind1, int optional1,
 553                           const char* a2, bt type2, int kind2, int optional2,
 554               const char* a3, bt type3, int kind3, int optional3)
 555 {
 556   gfc_check_f cf;
 557   gfc_simplify_f sf;
 558   gfc_resolve_f rf;
 559
 560   cf.f3red = check;
 561   sf.f3 = simplify;
 562   rf.f3 = resolve;
 563
 564   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 565            a1, type1, kind1, optional1,
 566            a2, type2, kind2, optional2,
 567            a3, type3, kind3, optional3,
 568            (void*)0);
 569 }
 570
 571
 572 /* Add a symbol to the subroutine list where the subroutine takes
 573    3 arguments.  */
 574
 575 static void
 576 add_sym_3s (const char *name, int elemental, bt type,
 577                         int kind, int standard,
 578                        try (*check)(gfc_expr *,gfc_expr *,gfc_expr *),
 579                        gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *),
 580                        void (*resolve)(gfc_code *),
 581                        const char* a1, bt type1, int kind1, int optional1,
 582                        const char* a2, bt type2, int kind2, int optional2,
 583             const char* a3, bt type3, int kind3, int optional3)
 584 {
 585   gfc_check_f cf;
 586   gfc_simplify_f sf;
 587   gfc_resolve_f rf;
 588
 589   cf.f3 = check;
 590   sf.f3 = simplify;
 591   rf.s1 = resolve;
 592
 593   add_sym (name, elemental, 0, type, kind, standard, cf, sf, rf,
 594            a1, type1, kind1, optional1,
 595            a2, type2, kind2, optional2,
 596            a3, type3, kind3, optional3,
 597            (void*)0);
 598 }
 599
 600
 601 /* Add a symbol to the function list where the function takes
 602    4 arguments.  */
 603
 604 static void
 605 add_sym_4 (const char *name, int elemental, int actual_ok, bt type,
 606                        int kind, int standard,
 607                        try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 608                        gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 609                        void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 610                        const char* a1, bt type1, int kind1, int optional1,
 611                        const char* a2, bt type2, int kind2, int optional2,
 612                        const char* a3, bt type3, int kind3, int optional3,
 613            const char* a4, bt type4, int kind4, int optional4 )
 614 {
 615   gfc_check_f cf;
 616   gfc_simplify_f sf;
 617   gfc_resolve_f rf;
 618
 619   cf.f4 = check;
 620   sf.f4 = simplify;
 621   rf.f4 = resolve;
 622
 623   add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
 624            a1, type1, kind1, optional1,
 625            a2, type2, kind2, optional2,
 626            a3, type3, kind3, optional3,
 627            a4, type4, kind4, optional4,
 628            (void*)0);
 629 }
 630
 631
 632 /* Add a symbol to the subroutine list where the subroutine takes
 633    4 arguments.  */
 634
 635 static void
 636 add_sym_4s (const char *name, int elemental,
 637                         bt type, int kind, int standard,
 638     try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 639     gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 640     void (*resolve)(gfc_code *),
 641     const char* a1, bt type1, int kind1, int optional1,
 642     const char* a2, bt type2, int kind2, int optional2,
 643     const char* a3, bt type3, int kind3, int optional3,
 644     const char* a4, bt type4, int kind4, int optional4)
 645 {
 646   gfc_check_f cf;
 647   gfc_simplify_f sf;
 648   gfc_resolve_f rf;
 649
 650   cf.f4 = check;
 651   sf.f4 = simplify;
 652   rf.s1 = resolve;
 653
 654   add_sym (name, elemental, 0, type, kind, standard, cf, sf, rf,
 655            a1, type1, kind1, optional1,
 656            a2, type2, kind2, optional2,
 657            a3, type3, kind3, optional3,
 658            a4, type4, kind4, optional4,
 659            (void*)0);
 660 }
 661
 662
 663 /* Add a symbol to the subroutine list where the subroutine takes
 664    5 arguments.  */
 665
 666 static void
 667 add_sym_5s (const char *name, int elemental,
 668  bt type, int kind, int standard,
 669  try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 670  gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
 671  void (*resolve)(gfc_code *),
 672  const char* a1, bt type1, int kind1, int optional1,
 673  const char* a2, bt type2, int kind2, int optional2,
 674  const char* a3, bt type3, int kind3, int optional3,
 675  const char* a4, bt type4, int kind4, int optional4,
 676  const char* a5, bt type5, int kind5, int optional5)
 677 {
 678   gfc_check_f cf;
 679   gfc_simplify_f sf;
 680   gfc_resolve_f rf;
 681
 682   cf.f5 = check;
 683   sf.f5 = simplify;
 684   rf.s1 = resolve;
 685
 686   add_sym (name, elemental, 0, type, kind, standard, cf, sf, rf,
 687            a1, type1, kind1, optional1,
 688            a2, type2, kind2, optional2,
 689            a3, type3, kind3, optional3,
 690            a4, type4, kind4, optional4,
 691            a5, type5, kind5, optional5,
 692            (void*)0);
 693 }
 694
 695
 696 /* Locate an intrinsic symbol given a base pointer, number of elements
 697    in the table and a pointer to a name.  Returns the NULL pointer if
 698    a name is not found.  */
 699
 700 static gfc_intrinsic_sym *
 701 find_sym (gfc_intrinsic_sym * start, int n, const char *name)
 702 {
 703
 704   while (n > 0)
 705     {
 706       if (strcmp (name, start->name) == 0)
 707         return start;
 708
 709       start++;
 710       n--;
 711     }
 712
 713   return NULL;
 714 }
 715
 716
 717 /* Given a name, find a function in the intrinsic function table.
 718    Returns NULL if not found.  */
 719
 720 gfc_intrinsic_sym *
 721 gfc_find_function (const char *name)
 722 {
 723   gfc_intrinsic_sym *sym;
 724
 725   sym = find_sym (functions, nfunc, name);
 726   if (!sym)
 727     sym = find_sym (conversion, nconv, name);
 728
 729   return sym;
 730 }
 731
 732
 733 /* Given a name, find a function in the intrinsic subroutine table.
 734    Returns NULL if not found.  */
 735
 736 static gfc_intrinsic_sym *
 737 find_subroutine (const char *name)
 738 {
 739
 740   return find_sym (subroutines, nsub, name);
 741 }
 742
 743
 744 /* Given a string, figure out if it is the name of a generic intrinsic
 745    function or not.  */
 746
 747 int
 748 gfc_generic_intrinsic (const char *name)
 749 {
 750   gfc_intrinsic_sym *sym;
 751
 752   sym = gfc_find_function (name);
 753   return (sym == NULL) ? 0 : sym->generic;
 754 }
 755
 756
 757 /* Given a string, figure out if it is the name of a specific
 758    intrinsic function or not.  */
 759
 760 int
 761 gfc_specific_intrinsic (const char *name)
 762 {
 763   gfc_intrinsic_sym *sym;
 764
 765   sym = gfc_find_function (name);
 766   return (sym == NULL) ? 0 : sym->specific;
 767 }
 768
 769
 770 /* Given a string, figure out if it is the name of an intrinsic function
 771    or subroutine allowed as an actual argument or not.  */
 772 int
 773 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
 774 {
 775   gfc_intrinsic_sym *sym;
 776
 777   /* Intrinsic subroutines are not allowed as actual arguments.  */
 778   if (subroutine_flag)
 779     return 0;
 780   else
 781     {
 782       sym = gfc_find_function (name);
 783       return (sym == NULL) ? 0 : sym->actual_ok;
 784     }
 785 }
 786
 787
 788 /* Given a string, figure out if it is the name of an intrinsic
 789    subroutine or function.  There are no generic intrinsic
 790    subroutines, they are all specific.  */
 791
 792 int
 793 gfc_intrinsic_name (const char *name, int subroutine_flag)
 794 {
 795
 796   return subroutine_flag ?
 797     find_subroutine (name) != NULL : 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
 853   /* First check that the intrinsic belongs to the selected standard.
 854      If not, don't add it to the symbol list.  */
 855   if (!(gfc_option.allow_std & standard)
 856       && gfc_option.flag_all_intrinsics == 0)
 857     return;
 858
 859   switch (sizing)
 860     {
 861     case SZ_FUNCS:
 862       nfunc++;
 863       break;
 864
 865     case SZ_SUBS:
 866       nsub++;
 867       break;
 868
 869     case SZ_NOTHING:
 870       next_sym[0] = next_sym[-1];
 871       next_sym->name = gfc_get_string (name);
 872       next_sym++;
 873       break;
 874
 875     default:
 876       break;
 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 /* Add intrinsic functions.  */
 890
 891 static void
 892 add_functions (void)
 893 {
 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 0, 0, 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", 1, 0, BT_CHARACTER, dc, GFC_STD_F95,
 954              gfc_check_achar, gfc_simplify_achar, NULL,
 955              i, BT_INTEGER, di, REQUIRED);
 956
 957   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
 958
 959   add_sym_1 ("acos", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 0, 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", 1, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 0, 0, 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", 0, 0, 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", 1, 1, 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", 1, 1, 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", 0, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 0, 0, BT_LOGICAL, dl, GFC_STD_F95,
1063              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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1100              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1101              x, BT_REAL, dr, REQUIRED);
1102
1103   add_sym_1 ("dbesj0", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1104              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1105              x, BT_REAL, dd, REQUIRED);
1106
1107   make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
1108
1109   add_sym_1 ("besj1", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1110              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1111              x, BT_REAL, dr, REQUIRED);
1112
1113   add_sym_1 ("dbesj1", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1114              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1115              x, BT_REAL, dd, REQUIRED);
1116
1117   make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
1118
1119   add_sym_2 ("besjn", 1, 0, 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", 1, 0, 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", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1130              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1131              x, BT_REAL, dr, REQUIRED);
1132
1133   add_sym_1 ("dbesy0", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1134              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1135              x, BT_REAL, dd, REQUIRED);
1136
1137   make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
1138
1139   add_sym_1 ("besy1", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1140              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1141              x, BT_REAL, dr, REQUIRED);
1142
1143   add_sym_1 ("dbesy1", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1144              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1145              x, BT_REAL, dd, REQUIRED);
1146
1147   make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
1148
1149   add_sym_2 ("besyn", 1, 0, 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", 1, 0, 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", 0, 0, 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", 1, 0, 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", 1, 0, 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", 1, 2, 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", 0, 0, 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", 0, 0, 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", 1, 0, 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", 1, 0, BT_INTEGER, di, GFC_STD_F2003,
1203              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", 1, 0, 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", 1, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 1, 0, 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", 0, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 0, 0, BT_UNKNOWN, 0, GFC_STD_F95,
1311              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", 1, 1, 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", 1, 0, 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", 0, 0, 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", 0, 0, 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", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1343              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1344              x, BT_REAL, dr, REQUIRED);
1345
1346   add_sym_1 ("derf", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1347              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1348              x, BT_REAL, dd, REQUIRED);
1349
1350   make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
1351
1352   add_sym_1 ("erfc", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1353              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1354              x, BT_REAL, dr, REQUIRED);
1355
1356   add_sym_1 ("derfc", 1, 0, BT_REAL, dd, GFC_STD_GNU,
1357              gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1358              x, BT_REAL, dd, REQUIRED);
1359
1360   make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
1361
1362   /* G77 compatibility */
1363   add_sym_1 ("etime", 0, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 0, 0, 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", 1, 0, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 0, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 0, 0, 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", 0, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 1, 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", 1, 0, 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", 1, 0, BT_INTEGER, di, GFC_STD_F77,
1570              NULL, gfc_simplify_ifix, NULL,
1571              a, BT_REAL, dr, REQUIRED);
1572
1573   add_sym_1 ("idint", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 0, 0, 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", 0, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 0, 0, 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", 0, 0, 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", 0, 1, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 1, 0, 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", 0, 0, 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", 1, 0, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 1, 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", 1, 0, 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", 1, 1, 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", 1, 1, 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", 1, 0, 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", 0, 0, 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", 0, 0, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_malloc,
1762              NULL, gfc_resolve_malloc, a, BT_INTEGER, di, REQUIRED);
1763
1764   make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1765
1766   add_sym_2 ("matmul", 0, 0, BT_REAL, dr, GFC_STD_F95,
1767              gfc_check_matmul, NULL, gfc_resolve_matmul,
1768              ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1769
1770   make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1771
1772   /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1773      int(max).  The max function must take at least two arguments.  */
1774
1775   add_sym_1m ("max", 1, 0, BT_UNKNOWN, 0, GFC_STD_F77,
1776              gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1777              a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1778
1779   add_sym_1m ("max0", 1, 0, BT_INTEGER, di, GFC_STD_F77,
1780              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1781              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1782
1783   add_sym_1m ("amax0", 1, 0, BT_REAL, dr, GFC_STD_F77,
1784              gfc_check_min_max_integer, gfc_simplify_max, NULL,
1785              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1786
1787   add_sym_1m ("amax1", 1, 0, BT_REAL, dr, GFC_STD_F77,
1788              gfc_check_min_max_real, gfc_simplify_max, NULL,
1789              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1790
1791   add_sym_1m ("max1", 1, 0, BT_INTEGER, di, GFC_STD_F77,
1792              gfc_check_min_max_real, gfc_simplify_max, NULL,
1793              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1794
1795   add_sym_1m ("dmax1", 1, 0, BT_REAL, dd, GFC_STD_F77,
1796              gfc_check_min_max_double, gfc_simplify_max, NULL,
1797              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1798
1799   make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1800
1801   add_sym_1 ("maxexponent", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1802              gfc_check_x, gfc_simplify_maxexponent, NULL,
1803              x, BT_UNKNOWN, dr, REQUIRED);
1804
1805   make_generic ("maxexponent", GFC_ISYM_NONE, GFC_STD_F95);
1806
1807   add_sym_3ml ("maxloc", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1808                gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1809                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1810                msk, BT_LOGICAL, dl, OPTIONAL);
1811
1812   make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1813
1814   add_sym_3red ("maxval", 0, 0, BT_REAL, dr, GFC_STD_F95,
1815                 gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
1816                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1817                 msk, BT_LOGICAL, dl, OPTIONAL);
1818
1819   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1820
1821   add_sym_0 ("mclock", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
1822              NULL, NULL, gfc_resolve_mclock);
1823
1824   make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1825
1826   add_sym_0 ("mclock8", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
1827              NULL, NULL, gfc_resolve_mclock8);
1828
1829   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1830
1831   add_sym_3 ("merge", 1, 0, BT_REAL, dr, GFC_STD_F95,
1832              gfc_check_merge, NULL, gfc_resolve_merge,
1833              ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1834              msk, BT_LOGICAL, dl, REQUIRED);
1835
1836   make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1837
1838   /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1839      int(min).  */
1840
1841   add_sym_1m ("min", 1, 0, BT_UNKNOWN, 0, GFC_STD_F77,
1842               gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1843              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1844
1845   add_sym_1m ("min0", 1, 0, BT_INTEGER, di, GFC_STD_F77,
1846               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1847              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1848
1849   add_sym_1m ("amin0", 1, 0, BT_REAL, dr, GFC_STD_F77,
1850               gfc_check_min_max_integer, gfc_simplify_min, NULL,
1851              a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1852
1853   add_sym_1m ("amin1", 1, 0, BT_REAL, dr, GFC_STD_F77,
1854               gfc_check_min_max_real, gfc_simplify_min, NULL,
1855              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1856
1857   add_sym_1m ("min1", 1, 0, BT_INTEGER, di, GFC_STD_F77,
1858               gfc_check_min_max_real, gfc_simplify_min, NULL,
1859              a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1860
1861   add_sym_1m ("dmin1", 1, 0, BT_REAL, dd, GFC_STD_F77,
1862               gfc_check_min_max_double, gfc_simplify_min, NULL,
1863              a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1864
1865   make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
1866
1867   add_sym_1 ("minexponent", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1868              gfc_check_x, gfc_simplify_minexponent, NULL,
1869              x, BT_UNKNOWN, dr, REQUIRED);
1870
1871   make_generic ("minexponent", GFC_ISYM_NONE, GFC_STD_F95);
1872
1873   add_sym_3ml ("minloc", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1874                gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
1875                ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1876                msk, BT_LOGICAL, dl, OPTIONAL);
1877
1878   make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
1879
1880   add_sym_3red ("minval", 0, 0, BT_REAL, dr, GFC_STD_F95,
1881                 gfc_check_minval_maxval, NULL, gfc_resolve_minval,
1882                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1883                 msk, BT_LOGICAL, dl, OPTIONAL);
1884
1885   make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
1886
1887   add_sym_2 ("mod", 1, 1, BT_INTEGER, di, GFC_STD_F77,
1888              gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1889              a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
1890
1891   add_sym_2 ("amod", 1, 1, BT_REAL, dr, GFC_STD_F77,
1892              NULL, gfc_simplify_mod, gfc_resolve_mod,
1893              a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
1894
1895   add_sym_2 ("dmod", 1, 1, BT_REAL, dd, GFC_STD_F77,
1896              NULL, gfc_simplify_mod, gfc_resolve_mod,
1897              a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
1898
1899   make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
1900
1901   add_sym_2 ("modulo", 1, 0, BT_REAL, di, GFC_STD_F95,
1902              gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1903              a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
1904
1905   make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
1906
1907   add_sym_2 ("nearest", 1, 0, BT_REAL, dr, GFC_STD_F95,
1908              gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1909              x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
1910
1911   make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
1912
1913   add_sym_2 ("nint", 1, 1, BT_INTEGER, di, GFC_STD_F77,
1914              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1915              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1916
1917   add_sym_1 ("idnint", 1, 1, BT_INTEGER, di, GFC_STD_F77,
1918              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1919              a, BT_REAL, dd, REQUIRED);
1920
1921   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
1922
1923   add_sym_1 ("not", 1, 0, BT_INTEGER, di, GFC_STD_F95,
1924              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1925              i, BT_INTEGER, di, REQUIRED);
1926
1927   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
1928
1929   add_sym_1 ("null", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1930              gfc_check_null, gfc_simplify_null, NULL,
1931              mo, BT_INTEGER, di, OPTIONAL);
1932
1933   make_generic ("null", GFC_ISYM_NONE, GFC_STD_F95);
1934
1935   add_sym_3 ("pack", 0, 0, BT_REAL, dr, GFC_STD_F95,
1936              gfc_check_pack, NULL, gfc_resolve_pack,
1937              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
1938              v, BT_REAL, dr, OPTIONAL);
1939
1940   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
1941
1942   add_sym_1 ("precision", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1943              gfc_check_precision, gfc_simplify_precision, NULL,
1944              x, BT_UNKNOWN, 0, REQUIRED);
1945
1946   make_generic ("precision", GFC_ISYM_NONE, GFC_STD_F95);
1947
1948   add_sym_1 ("present", 0, 0, BT_LOGICAL, dl, GFC_STD_F95,
1949              gfc_check_present, NULL, NULL,
1950              a, BT_REAL, dr, REQUIRED);
1951
1952   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
1953
1954   add_sym_3red ("product", 0, 0, BT_REAL, dr, GFC_STD_F95,
1955                 gfc_check_product_sum, NULL, gfc_resolve_product,
1956                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1957                 msk, BT_LOGICAL, dl, OPTIONAL);
1958
1959   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
1960
1961   add_sym_1 ("radix", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1962              gfc_check_radix, gfc_simplify_radix, NULL,
1963              x, BT_UNKNOWN, 0, REQUIRED);
1964
1965   make_generic ("radix", GFC_ISYM_NONE, GFC_STD_F95);
1966
1967   /* The following function is for G77 compatibility.  */
1968   add_sym_1 ("rand", 0, 0, BT_REAL, 4, GFC_STD_GNU,
1969              gfc_check_rand, NULL, NULL,
1970              i, BT_INTEGER, 4, OPTIONAL);
1971
1972   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
1973      use slightly different shoddy multiplicative congruential PRNG.  */
1974   make_alias ("ran", GFC_STD_GNU);
1975
1976   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
1977
1978   add_sym_1 ("range", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1979              gfc_check_range, gfc_simplify_range, NULL,
1980              x, BT_REAL, dr, REQUIRED);
1981
1982   make_generic ("range", GFC_ISYM_NONE, GFC_STD_F95);
1983
1984   add_sym_2 ("real", 1, 0, BT_REAL, dr, GFC_STD_F77,
1985              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1986              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1987
1988   /* This provides compatibility with g77.  */
1989   add_sym_1 ("realpart", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1990              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
1991              a, BT_UNKNOWN, dr, REQUIRED);
1992
1993   add_sym_1 ("float", 1, 0, BT_REAL, dr, GFC_STD_F77,
1994              gfc_check_i, gfc_simplify_float, NULL,
1995              a, BT_INTEGER, di, REQUIRED);
1996
1997   add_sym_1 ("sngl", 1, 0, BT_REAL, dr, GFC_STD_F77,
1998              NULL, gfc_simplify_sngl, NULL,
1999              a, BT_REAL, dd, REQUIRED);
2000
2001   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2002
2003   add_sym_2 ("rename", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2004              gfc_check_rename, NULL, gfc_resolve_rename,
2005              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2006
2007   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2008
2009   add_sym_2 ("repeat", 0, 0, BT_CHARACTER, dc, GFC_STD_F95,
2010              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2011              stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED);
2012
2013   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2014
2015   add_sym_4 ("reshape", 0, 0, BT_REAL, dr, GFC_STD_F95,
2016              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2017              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2018              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2019
2020   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2021
2022   add_sym_1 ("rrspacing", 1, 0, BT_REAL, dr, GFC_STD_F95,
2023              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2024              x, BT_REAL, dr, REQUIRED);
2025
2026   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2027
2028   add_sym_2 ("scale", 1, 0, BT_REAL, dr, GFC_STD_F95,
2029              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2030              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2031
2032   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2033
2034   add_sym_3 ("scan", 1, 0, BT_INTEGER, di, GFC_STD_F95,
2035              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2036              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2037              bck, BT_LOGICAL, dl, OPTIONAL);
2038
2039   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2040
2041   /* Added for G77 compatibility garbage.  */
2042   add_sym_0 ("second", 0, 0, BT_REAL, 4, GFC_STD_GNU,
2043              NULL, NULL, NULL);
2044
2045   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2046
2047   /* Added for G77 compatibility.  */
2048   add_sym_1 ("secnds", 0, 0, BT_REAL, dr, GFC_STD_GNU,
2049              gfc_check_secnds, NULL, gfc_resolve_secnds,
2050              x, BT_REAL, dr, REQUIRED);
2051
2052   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2053
2054   add_sym_1 ("selected_int_kind", 0, 0, BT_INTEGER, di,  GFC_STD_F95,
2055              gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL,
2056              r, BT_INTEGER, di, REQUIRED);
2057
2058   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2059
2060   add_sym_2 ("selected_real_kind", 0, 0, BT_INTEGER, di,  GFC_STD_F95,
2061              gfc_check_selected_real_kind, gfc_simplify_selected_real_kind,
2062              NULL,
2063              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2064
2065   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2066
2067   add_sym_2 ("set_exponent", 1, 0, BT_REAL, dr, GFC_STD_F95,
2068              gfc_check_set_exponent, gfc_simplify_set_exponent,
2069              gfc_resolve_set_exponent,
2070              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2071
2072   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2073
2074   add_sym_1 ("shape", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2075              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2076              src, BT_REAL, dr, REQUIRED);
2077
2078   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2079
2080   add_sym_2 ("sign", 1, 1, BT_REAL, dr, GFC_STD_F77,
2081              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2082              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2083
2084   add_sym_2 ("isign", 1, 1, BT_INTEGER, di, GFC_STD_F77,
2085              NULL, gfc_simplify_sign, gfc_resolve_sign,
2086              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2087
2088   add_sym_2 ("dsign", 1, 1, BT_REAL, dd, GFC_STD_F77,
2089              NULL, gfc_simplify_sign, gfc_resolve_sign,
2090              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2091
2092   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2093
2094   add_sym_2 ("signal", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2095              gfc_check_signal, NULL, gfc_resolve_signal,
2096              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2097
2098   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2099
2100   add_sym_1 ("sin", 1, 1, BT_REAL, dr, GFC_STD_F77,
2101              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2102              x, BT_REAL, dr, REQUIRED);
2103
2104   add_sym_1 ("dsin", 1, 1, BT_REAL, dd, GFC_STD_F77,
2105              NULL, gfc_simplify_sin, gfc_resolve_sin,
2106              x, BT_REAL, dd, REQUIRED);
2107
2108   add_sym_1 ("csin", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
2109              NULL, gfc_simplify_sin, gfc_resolve_sin,
2110              x, BT_COMPLEX, dz, REQUIRED);
2111
2112   add_sym_1 ("zsin", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU,
2113              NULL, gfc_simplify_sin, gfc_resolve_sin,
2114              x, BT_COMPLEX, dd, REQUIRED);
2115
2116   make_alias ("cdsin", GFC_STD_GNU);
2117
2118   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2119
2120   add_sym_1 ("sinh", 1, 1, BT_REAL, dr, GFC_STD_F77,
2121              gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2122              x, BT_REAL, dr, REQUIRED);
2123
2124   add_sym_1 ("dsinh", 1, 1, BT_REAL, dd, GFC_STD_F77,
2125              NULL, gfc_simplify_sinh, gfc_resolve_sinh,
2126              x, BT_REAL, dd, REQUIRED);
2127
2128   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2129
2130   add_sym_2 ("size", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2131              gfc_check_size, gfc_simplify_size, NULL,
2132              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2133
2134   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2135
2136   add_sym_1 ("spacing", 1, 0, BT_REAL, dr, GFC_STD_F95,
2137              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2138              x, BT_REAL, dr, REQUIRED);
2139
2140   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2141
2142   add_sym_3 ("spread", 0, 0, BT_REAL, dr, GFC_STD_F95,
2143              gfc_check_spread, NULL, gfc_resolve_spread,
2144              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2145              n, BT_INTEGER, di, REQUIRED);
2146
2147   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2148
2149   add_sym_1 ("sqrt", 1, 1, BT_REAL, dr, GFC_STD_F77,
2150              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2151              x, BT_REAL, dr, REQUIRED);
2152
2153   add_sym_1 ("dsqrt", 1, 1, BT_REAL, dd, GFC_STD_F77,
2154              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2155              x, BT_REAL, dd, REQUIRED);
2156
2157   add_sym_1 ("csqrt", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
2158              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2159              x, BT_COMPLEX, dz, REQUIRED);
2160
2161   add_sym_1 ("zsqrt", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU,
2162              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2163              x, BT_COMPLEX, dd, REQUIRED);
2164
2165   make_alias ("cdsqrt", GFC_STD_GNU);
2166
2167   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2168
2169   add_sym_2 ("stat", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2170              gfc_check_stat, NULL, gfc_resolve_stat,
2171              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2172
2173   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2174
2175   add_sym_3red ("sum", 0, 0, BT_UNKNOWN, 0, GFC_STD_F95,
2176                 gfc_check_product_sum, NULL, gfc_resolve_sum,
2177                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2178                 msk, BT_LOGICAL, dl, OPTIONAL);
2179
2180   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2181
2182   add_sym_2 ("symlnk", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2183              gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2184              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2185
2186   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2187
2188   add_sym_1 ("system", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2189              NULL, NULL, NULL,
2190              c, BT_CHARACTER, dc, REQUIRED);
2191
2192   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2193
2194   add_sym_1 ("tan", 1, 1, BT_REAL, dr, GFC_STD_F77,
2195              gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2196              x, BT_REAL, dr, REQUIRED);
2197
2198   add_sym_1 ("dtan", 1, 1, BT_REAL, dd, GFC_STD_F77,
2199              NULL, gfc_simplify_tan, gfc_resolve_tan,
2200              x, BT_REAL, dd, REQUIRED);
2201
2202   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2203
2204   add_sym_1 ("tanh", 1, 1, BT_REAL, dr, GFC_STD_F77,
2205              gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2206              x, BT_REAL, dr, REQUIRED);
2207
2208   add_sym_1 ("dtanh", 1, 1, BT_REAL, dd, GFC_STD_F77,
2209              NULL, gfc_simplify_tanh, gfc_resolve_tanh,
2210              x, BT_REAL, dd, REQUIRED);
2211
2212   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2213
2214   add_sym_0 ("time", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2215              NULL, NULL, gfc_resolve_time);
2216
2217   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2218
2219   add_sym_0 ("time8", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2220              NULL, NULL, gfc_resolve_time8);
2221
2222   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2223
2224   add_sym_1 ("tiny", 0, 0, BT_REAL, dr, GFC_STD_F95,
2225              gfc_check_x, gfc_simplify_tiny, NULL,
2226              x, BT_REAL, dr, REQUIRED);
2227
2228   make_generic ("tiny", GFC_ISYM_NONE, GFC_STD_F95);
2229
2230   add_sym_3 ("transfer", 0, 0, BT_REAL, dr, GFC_STD_F95,
2231              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2232              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2233              sz, BT_INTEGER, di, OPTIONAL);
2234
2235   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2236
2237   add_sym_1 ("transpose", 0, 0, BT_REAL, dr, GFC_STD_F95,
2238              gfc_check_transpose, NULL, gfc_resolve_transpose,
2239              m, BT_REAL, dr, REQUIRED);
2240
2241   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2242
2243   add_sym_1 ("trim", 0, 0, BT_CHARACTER, dc, GFC_STD_F95,
2244              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2245              stg, BT_CHARACTER, dc, REQUIRED);
2246
2247   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2248
2249   add_sym_1 ("ttynam", 0, 0, BT_CHARACTER, 0, GFC_STD_GNU,
2250               gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2251               ut, BT_INTEGER, di, REQUIRED);
2252
2253   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2254
2255   add_sym_2 ("ubound", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2256              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2257              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2258
2259   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2260
2261   /* g77 compatibility for UMASK.  */
2262   add_sym_1 ("umask", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2263              gfc_check_umask, NULL, gfc_resolve_umask,
2264              a, BT_INTEGER, di, REQUIRED);
2265
2266   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2267
2268   /* g77 compatibility for UNLINK.  */
2269   add_sym_1 ("unlink", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2270              gfc_check_unlink, NULL, gfc_resolve_unlink,
2271              a, BT_CHARACTER, dc, REQUIRED);
2272
2273   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2274
2275   add_sym_3 ("unpack", 0, 0, BT_REAL, dr, GFC_STD_F95,
2276              gfc_check_unpack, NULL, gfc_resolve_unpack,
2277              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2278              f, BT_REAL, dr, REQUIRED);
2279
2280   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2281
2282   add_sym_3 ("verify", 1, 0, BT_INTEGER, di, GFC_STD_F95,
2283              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2284              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2285              bck, BT_LOGICAL, dl, OPTIONAL);
2286
2287   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2288
2289   add_sym_1 ("loc", 0, 0, BT_INTEGER, ii, GFC_STD_GNU,
2290             gfc_check_loc, NULL, gfc_resolve_loc,
2291             ar, BT_UNKNOWN, 0, REQUIRED);
2292
2293   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2294
2295 }
2296
2297
2298 /* Add intrinsic subroutines.  */
2299
2300 static void
2301 add_subroutines (void)
2302 {
2303   /* Argument names as in the standard (to be used as argument keywords).  */
2304   const char
2305     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2306     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2307     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2308     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2309     *com = "command", *length = "length", *st = "status",
2310     *val = "value", *num = "number", *name = "name",
2311     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2312     *sec = "seconds", *res = "result", *of = "offset", *md = "mode";
2313
2314   int di, dr, dc, dl, ii;
2315
2316   di = gfc_default_integer_kind;
2317   dr = gfc_default_real_kind;
2318   dc = gfc_default_character_kind;
2319   dl = gfc_default_logical_kind;
2320   ii = gfc_index_integer_kind;
2321
2322   add_sym_0s ("abort", GFC_STD_GNU, NULL);
2323
2324   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2325     make_noreturn();
2326
2327   add_sym_1s ("cpu_time", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2328               gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2329               tm, BT_REAL, dr, REQUIRED);
2330
2331   /* More G77 compatibility garbage.  */
2332   add_sym_2s ("ctime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2333               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2334               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2335
2336   add_sym_1s ("idate", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2337               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2338               vl, BT_INTEGER, 4, REQUIRED);
2339
2340   add_sym_1s ("itime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2341               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2342               vl, BT_INTEGER, 4, REQUIRED);
2343
2344   add_sym_2s ("ltime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2345               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2346               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2347
2348   add_sym_2s ("gmtime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2349               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2350               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2351
2352   add_sym_1s ("second", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2353               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2354               tm, BT_REAL, dr, REQUIRED);
2355
2356   add_sym_2s ("chdir", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2357               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2358               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2359
2360   add_sym_3s ("chmod", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2361               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2362               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2363               st, BT_INTEGER, di, OPTIONAL);
2364
2365   add_sym_4s ("date_and_time", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2366               gfc_check_date_and_time, NULL, NULL,
2367               dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2368               zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2369
2370   /* More G77 compatibility garbage.  */
2371   add_sym_2s ("etime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2372              gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2373               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2374
2375   add_sym_2s ("dtime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2376              gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2377               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2378
2379   add_sym_1s ("fdate", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2380              gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2381              dt, BT_CHARACTER, dc, REQUIRED);
2382
2383   add_sym_1s ("gerror", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2384               gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER,
2385               dc, REQUIRED);
2386
2387   add_sym_2s ("getcwd", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2388           gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2389               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2390
2391   add_sym_2s ("getenv", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2392               NULL, NULL, NULL,
2393               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2394
2395   add_sym_2s ("getarg", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2396               NULL, NULL, gfc_resolve_getarg,
2397               c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2398
2399   add_sym_1s ("getlog", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2400               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2401               dc, REQUIRED);
2402
2403   /* F2003 commandline routines.  */
2404
2405   add_sym_3s ("get_command", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2406               NULL, NULL, gfc_resolve_get_command,
2407               com, BT_CHARACTER, dc, OPTIONAL, length, BT_INTEGER, di, OPTIONAL,
2408               st, BT_INTEGER, di, OPTIONAL);
2409
2410   add_sym_4s ("get_command_argument", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2411               NULL, NULL, gfc_resolve_get_command_argument,
2412               num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2413               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2414
2415   /* F2003 subroutine to get environment variables.  */
2416
2417   add_sym_5s ("get_environment_variable", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2418              NULL, NULL, gfc_resolve_get_environment_variable,
2419               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2420               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2421               trim_name, BT_LOGICAL, dl, OPTIONAL);
2422
2423   add_sym_5s ("mvbits", 1, BT_UNKNOWN, 0, GFC_STD_F95,
2424               gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2425               f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2426               ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2427               tp, BT_INTEGER, di, REQUIRED);
2428
2429   add_sym_1s ("random_number", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2430               gfc_check_random_number, NULL, gfc_resolve_random_number,
2431               h, BT_REAL, dr, REQUIRED);
2432
2433   add_sym_3s ("random_seed", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2434              gfc_check_random_seed, NULL, NULL,
2435               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2436               gt, BT_INTEGER, di, OPTIONAL);
2437
2438   /* More G77 compatibility garbage.  */
2439   add_sym_3s ("alarm", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2440               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2441               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2442               st, BT_INTEGER, di, OPTIONAL);
2443
2444   add_sym_1s ("srand", 0, BT_UNKNOWN, di, GFC_STD_GNU,
2445              gfc_check_srand, NULL, gfc_resolve_srand,
2446               c, BT_INTEGER, 4, REQUIRED);
2447
2448   add_sym_1s ("exit", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2449              gfc_check_exit, NULL, gfc_resolve_exit,
2450               c, BT_INTEGER, di, OPTIONAL);
2451
2452   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2453     make_noreturn();
2454
2455   add_sym_3s ("fgetc", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2456               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2457               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2458               st, BT_INTEGER, di, OPTIONAL);
2459
2460   add_sym_2s ("fget", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2461               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2462               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2463
2464   add_sym_1s ("flush", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2465               gfc_check_flush, NULL, gfc_resolve_flush,
2466               c, BT_INTEGER, di, OPTIONAL);
2467
2468   add_sym_3s ("fputc", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2469               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2470               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2471               st, BT_INTEGER, di, OPTIONAL);
2472
2473   add_sym_2s ("fput", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2474               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2475               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2476
2477   add_sym_1s ("free", 0, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2478               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2479
2480   add_sym_2s ("ftell", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2481               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2482               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2483
2484   add_sym_2s ("hostnm", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2485           gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2486               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2487
2488   add_sym_3s ("kill", 0, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2489               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2490               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2491
2492   add_sym_3s ("link", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2493               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2494               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2495               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2496
2497   add_sym_1s ("perror", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2498           gfc_check_perror, NULL, gfc_resolve_perror,
2499               c, BT_CHARACTER, dc, REQUIRED);
2500
2501   add_sym_3s ("rename", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2502               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2503               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2504               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2505
2506   add_sym_1s ("sleep", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2507               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2508               val, BT_CHARACTER, dc, REQUIRED);
2509
2510   add_sym_3s ("fstat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2511               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2512               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2513               st, BT_INTEGER, di, OPTIONAL);
2514
2515   add_sym_3s ("lstat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2516               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2517               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2518               st, BT_INTEGER, di, OPTIONAL);
2519
2520   add_sym_3s ("stat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2521               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2522               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2523               st, BT_INTEGER, di, OPTIONAL);
2524
2525   add_sym_3s ("signal", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2526               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2527               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2528               st, BT_INTEGER, di, OPTIONAL);
2529
2530   add_sym_3s ("symlnk", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2531               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2532               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2533               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2534
2535   add_sym_2s ("system", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2536               NULL, NULL, gfc_resolve_system_sub,
2537               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2538
2539   add_sym_3s ("system_clock", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2540              gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2541               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2542               cm, BT_INTEGER, di, OPTIONAL);
2543
2544   add_sym_2s ("ttynam", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2545               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2546               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
2547
2548   add_sym_2s ("umask", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2549           gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2550               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2551
2552   add_sym_2s ("unlink", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2553           gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2554               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2555
2556 }
2557
2558
2559 /* Add a function to the list of conversion symbols.  */
2560
2561 static void
2562 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2563 {
2564
2565   gfc_typespec from, to;
2566   gfc_intrinsic_sym *sym;
2567
2568   if (sizing == SZ_CONVS)
2569     {
2570       nconv++;
2571       return;
2572     }
2573
2574   gfc_clear_ts (&from);
2575   from.type = from_type;
2576   from.kind = from_kind;
2577
2578   gfc_clear_ts (&to);
2579   to.type = to_type;
2580   to.kind = to_kind;
2581
2582   sym = conversion + nconv;
2583
2584   sym->name = conv_name (&from, &to);
2585   sym->lib_name = sym->name;
2586   sym->simplify.cc = gfc_convert_constant;
2587   sym->standard = standard;
2588   sym->elemental = 1;
2589   sym->ts = to;
2590   sym->generic_id = GFC_ISYM_CONVERSION;
2591
2592   nconv++;
2593 }
2594
2595
2596 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2597    functions by looping over the kind tables.  */
2598
2599 static void
2600 add_conversions (void)
2601 {
2602   int i, j;
2603
2604   /* Integer-Integer conversions.  */
2605   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2606     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2607       {
2608         if (i == j)
2609           continue;
2610
2611         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2612                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2613       }
2614
2615   /* Integer-Real/Complex conversions.  */
2616   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2617     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2618       {
2619         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2620                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2621
2622         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2623                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2624
2625         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2626                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2627
2628         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2629                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2630       }
2631
2632   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2633     {
2634       /* Hollerith-Integer conversions.  */
2635       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2636         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2637                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2638       /* Hollerith-Real conversions.  */
2639       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2640         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2641                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2642       /* Hollerith-Complex conversions.  */
2643       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2644         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2645                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2646
2647       /* Hollerith-Character conversions.  */
2648       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2649                   gfc_default_character_kind, GFC_STD_LEGACY);
2650
2651       /* Hollerith-Logical conversions.  */
2652       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2653         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2654                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2655     }
2656
2657   /* Real/Complex - Real/Complex conversions.  */
2658   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2659     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2660       {
2661         if (i != j)
2662           {
2663             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2664                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2665
2666             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2667                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2668           }
2669
2670         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2671                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2672
2673         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2674                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2675       }
2676
2677   /* Logical/Logical kind conversion.  */
2678   for (i = 0; gfc_logical_kinds[i].kind; i++)
2679     for (j = 0; gfc_logical_kinds[j].kind; j++)
2680       {
2681         if (i == j)
2682           continue;
2683
2684         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2685                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2686       }
2687
2688   /* Integer-Logical and Logical-Integer conversions.  */
2689   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2690     for (i=0; gfc_integer_kinds[i].kind; i++)
2691       for (j=0; gfc_logical_kinds[j].kind; j++)
2692         {
2693           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2694                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2695           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2696                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2697         }
2698 }
2699
2700
2701 /* Initialize the table of intrinsics.  */
2702 void
2703 gfc_intrinsic_init_1 (void)
2704 {
2705   int i;
2706
2707   nargs = nfunc = nsub = nconv = 0;
2708
2709   /* Create a namespace to hold the resolved intrinsic symbols.  */
2710   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2711
2712   sizing = SZ_FUNCS;
2713   add_functions ();
2714   sizing = SZ_SUBS;
2715   add_subroutines ();
2716   sizing = SZ_CONVS;
2717   add_conversions ();
2718
2719   functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2720                           + sizeof (gfc_intrinsic_arg) * nargs);
2721
2722   next_sym = functions;
2723   subroutines = functions + nfunc;
2724
2725   conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2726
2727   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2728
2729   sizing = SZ_NOTHING;
2730   nconv = 0;
2731
2732   add_functions ();
2733   add_subroutines ();
2734   add_conversions ();
2735
2736   /* Set the pure flag.  All intrinsic functions are pure, and
2737      intrinsic subroutines are pure if they are elemental.  */
2738
2739   for (i = 0; i < nfunc; i++)
2740     functions[i].pure = 1;
2741
2742   for (i = 0; i < nsub; i++)
2743     subroutines[i].pure = subroutines[i].elemental;
2744 }
2745
2746
2747 void
2748 gfc_intrinsic_done_1 (void)
2749 {
2750   gfc_free (functions);
2751   gfc_free (conversion);
2752   gfc_free_namespace (gfc_intrinsic_namespace);
2753 }
2754
2755
2756 /******** Subroutines to check intrinsic interfaces ***********/
2757
2758 /* Given a formal argument list, remove any NULL arguments that may
2759    have been left behind by a sort against some formal argument list.  */
2760
2761 static void
2762 remove_nullargs (gfc_actual_arglist ** ap)
2763 {
2764   gfc_actual_arglist *head, *tail, *next;
2765
2766   tail = NULL;
2767
2768   for (head = *ap; head; head = next)
2769     {
2770       next = head->next;
2771
2772       if (head->expr == NULL)
2773         {
2774           head->next = NULL;
2775           gfc_free_actual_arglist (head);
2776         }
2777       else
2778         {
2779           if (tail == NULL)
2780             *ap = head;
2781           else
2782             tail->next = head;
2783
2784           tail = head;
2785           tail->next = NULL;
2786         }
2787     }
2788
2789   if (tail == NULL)
2790     *ap = NULL;
2791 }
2792
2793
2794 /* Given an actual arglist and a formal arglist, sort the actual
2795    arglist so that its arguments are in a one-to-one correspondence
2796    with the format arglist.  Arguments that are not present are given
2797    a blank gfc_actual_arglist structure.  If something is obviously
2798    wrong (say, a missing required argument) we abort sorting and
2799    return FAILURE.  */
2800
2801 static try
2802 sort_actual (const char *name, gfc_actual_arglist ** ap,
2803              gfc_intrinsic_arg * formal, locus * where)
2804 {
2805
2806   gfc_actual_arglist *actual, *a;
2807   gfc_intrinsic_arg *f;
2808
2809   remove_nullargs (ap);
2810   actual = *ap;
2811
2812   for (f = formal; f; f = f->next)
2813     f->actual = NULL;
2814
2815   f = formal;
2816   a = actual;
2817
2818   if (f == NULL && a == NULL)   /* No arguments */
2819     return SUCCESS;
2820
2821   for (;;)
2822     {                           /* Put the nonkeyword arguments in a 1:1 correspondence */
2823       if (f == NULL)
2824         break;
2825       if (a == NULL)
2826         goto optional;
2827
2828       if (a->name != NULL)
2829         goto keywords;
2830
2831       f->actual = a;
2832
2833       f = f->next;
2834       a = a->next;
2835     }
2836
2837   if (a == NULL)
2838     goto do_sort;
2839
2840   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2841   return FAILURE;
2842
2843 keywords:
2844   /* Associate the remaining actual arguments, all of which have
2845      to be keyword arguments.  */
2846   for (; a; a = a->next)
2847     {
2848       for (f = formal; f; f = f->next)
2849         if (strcmp (a->name, f->name) == 0)
2850           break;
2851
2852       if (f == NULL)
2853         {
2854           gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2855                      a->name, name, where);
2856           return FAILURE;
2857         }
2858
2859       if (f->actual != NULL)
2860         {
2861           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2862                      f->name, name, where);
2863           return FAILURE;
2864         }
2865
2866       f->actual = a;
2867     }
2868
2869 optional:
2870   /* At this point, all unmatched formal args must be optional.  */
2871   for (f = formal; f; f = f->next)
2872     {
2873       if (f->actual == NULL && f->optional == 0)
2874         {
2875           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2876                      f->name, name, where);
2877           return FAILURE;
2878         }
2879     }
2880
2881 do_sort:
2882   /* Using the formal argument list, string the actual argument list
2883      together in a way that corresponds with the formal list.  */
2884   actual = NULL;
2885
2886   for (f = formal; f; f = f->next)
2887     {
2888       if (f->actual == NULL)
2889         {
2890           a = gfc_get_actual_arglist ();
2891           a->missing_arg_type = f->ts.type;
2892         }
2893       else
2894         a = f->actual;
2895
2896       if (actual == NULL)
2897         *ap = a;
2898       else
2899         actual->next = a;
2900
2901       actual = a;
2902     }
2903   actual->next = NULL;          /* End the sorted argument list.  */
2904
2905   return SUCCESS;
2906 }
2907
2908
2909 /* Compare an actual argument list with an intrinsic's formal argument
2910    list.  The lists are checked for agreement of type.  We don't check
2911    for arrayness here.  */
2912
2913 static try
2914 check_arglist (gfc_actual_arglist ** ap, gfc_intrinsic_sym * sym,
2915                int error_flag)
2916 {
2917   gfc_actual_arglist *actual;
2918   gfc_intrinsic_arg *formal;
2919   int i;
2920
2921   formal = sym->formal;
2922   actual = *ap;
2923
2924   i = 0;
2925   for (; formal; formal = formal->next, actual = actual->next, i++)
2926     {
2927       if (actual->expr == NULL)
2928         continue;
2929
2930       if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2931         {
2932           if (error_flag)
2933             gfc_error
2934               ("Type of argument '%s' in call to '%s' at %L should be "
2935                "%s, not %s", gfc_current_intrinsic_arg[i],
2936                gfc_current_intrinsic, &actual->expr->where,
2937                gfc_typename (&formal->ts), gfc_typename (&actual->expr->ts));
2938           return FAILURE;
2939         }
2940     }
2941
2942   return SUCCESS;
2943 }
2944
2945
2946 /* Given a pointer to an intrinsic symbol and an expression node that
2947    represent the function call to that subroutine, figure out the type
2948    of the result.  This may involve calling a resolution subroutine.  */
2949
2950 static void
2951 resolve_intrinsic (gfc_intrinsic_sym * specific, gfc_expr * e)
2952 {
2953   gfc_expr *a1, *a2, *a3, *a4, *a5;
2954   gfc_actual_arglist *arg;
2955
2956   if (specific->resolve.f1 == NULL)
2957     {
2958       if (e->value.function.name == NULL)
2959         e->value.function.name = specific->lib_name;
2960
2961       if (e->ts.type == BT_UNKNOWN)
2962         e->ts = specific->ts;
2963       return;
2964     }
2965
2966   arg = e->value.function.actual;
2967
2968   /* Special case hacks for MIN and MAX.  */
2969   if (specific->resolve.f1m == gfc_resolve_max
2970       || specific->resolve.f1m == gfc_resolve_min)
2971     {
2972       (*specific->resolve.f1m) (e, arg);
2973       return;
2974     }
2975
2976   if (arg == NULL)
2977     {
2978       (*specific->resolve.f0) (e);
2979       return;
2980     }
2981
2982   a1 = arg->expr;
2983   arg = arg->next;
2984
2985   if (arg == NULL)
2986     {
2987       (*specific->resolve.f1) (e, a1);
2988       return;
2989     }
2990
2991   a2 = arg->expr;
2992   arg = arg->next;
2993
2994   if (arg == NULL)
2995     {
2996       (*specific->resolve.f2) (e, a1, a2);
2997       return;
2998     }
2999
3000   a3 = arg->expr;
3001   arg = arg->next;
3002
3003   if (arg == NULL)
3004     {
3005       (*specific->resolve.f3) (e, a1, a2, a3);
3006       return;
3007     }
3008
3009   a4 = arg->expr;
3010   arg = arg->next;
3011
3012   if (arg == NULL)
3013     {
3014       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3015       return;
3016     }
3017
3018   a5 = arg->expr;
3019   arg = arg->next;
3020
3021   if (arg == NULL)
3022     {
3023       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3024       return;
3025     }
3026
3027   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3028 }
3029
3030
3031 /* Given an intrinsic symbol node and an expression node, call the
3032    simplification function (if there is one), perhaps replacing the
3033    expression with something simpler.  We return FAILURE on an error
3034    of the simplification, SUCCESS if the simplification worked, even
3035    if nothing has changed in the expression itself.  */
3036
3037 static try
3038 do_simplify (gfc_intrinsic_sym * specific, gfc_expr * e)
3039 {
3040   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3041   gfc_actual_arglist *arg;
3042
3043   /* Check the arguments if there are Hollerith constants. We deal with
3044      them at run-time.  */
3045   for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
3046     {
3047       if (arg->expr && arg->expr->from_H)
3048         {
3049           result = NULL;
3050           goto finish;
3051         }
3052     }
3053   /* Max and min require special handling due to the variable number
3054      of args.  */
3055   if (specific->simplify.f1 == gfc_simplify_min)
3056     {
3057       result = gfc_simplify_min (e);
3058       goto finish;
3059     }
3060
3061   if (specific->simplify.f1 == gfc_simplify_max)
3062     {
3063       result = gfc_simplify_max (e);
3064       goto finish;
3065     }
3066
3067   if (specific->simplify.f1 == NULL)
3068     {
3069       result = NULL;
3070       goto finish;
3071     }
3072
3073   arg = e->value.function.actual;
3074
3075   if (arg == NULL)
3076     {
3077       result = (*specific->simplify.f0) ();
3078       goto finish;
3079     }
3080
3081   a1 = arg->expr;
3082   arg = arg->next;
3083
3084   if (specific->simplify.cc == gfc_convert_constant)
3085     {
3086       result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3087       goto finish;
3088     }
3089
3090   /* TODO: Warn if -pedantic and initialization expression and arg
3091      types not integer or character */
3092
3093   if (arg == NULL)
3094     result = (*specific->simplify.f1) (a1);
3095   else
3096     {
3097       a2 = arg->expr;
3098       arg = arg->next;
3099
3100       if (arg == NULL)
3101         result = (*specific->simplify.f2) (a1, a2);
3102       else
3103         {
3104           a3 = arg->expr;
3105           arg = arg->next;
3106
3107           if (arg == NULL)
3108             result = (*specific->simplify.f3) (a1, a2, a3);
3109           else
3110             {
3111               a4 = arg->expr;
3112               arg = arg->next;
3113
3114               if (arg == NULL)
3115                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3116               else
3117                 {
3118                   a5 = arg->expr;
3119                   arg = arg->next;
3120
3121                   if (arg == NULL)
3122                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3123                   else
3124                     gfc_internal_error
3125                       ("do_simplify(): Too many args for intrinsic");
3126                 }
3127             }
3128         }
3129     }
3130
3131 finish:
3132   if (result == &gfc_bad_expr)
3133     return FAILURE;
3134
3135   if (result == NULL)
3136     resolve_intrinsic (specific, e);    /* Must call at run-time */
3137   else
3138     {
3139       result->where = e->where;
3140       gfc_replace_expr (e, result);
3141     }
3142
3143   return SUCCESS;
3144 }
3145
3146
3147 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3148    error messages.  This subroutine returns FAILURE if a subroutine
3149    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3150    list cannot match any intrinsic.  */
3151
3152 static void
3153 init_arglist (gfc_intrinsic_sym * isym)
3154 {
3155   gfc_intrinsic_arg *formal;
3156   int i;
3157
3158   gfc_current_intrinsic = isym->name;
3159
3160   i = 0;
3161   for (formal = isym->formal; formal; formal = formal->next)
3162     {
3163       if (i >= MAX_INTRINSIC_ARGS)
3164         gfc_internal_error ("init_arglist(): too many arguments");
3165       gfc_current_intrinsic_arg[i++] = formal->name;
3166     }
3167 }
3168
3169
3170 /* Given a pointer to an intrinsic symbol and an expression consisting
3171    of a function call, see if the function call is consistent with the
3172    intrinsic's formal argument list.  Return SUCCESS if the expression
3173    and intrinsic match, FAILURE otherwise.  */
3174
3175 static try
3176 check_specific (gfc_intrinsic_sym * specific, gfc_expr * expr, int error_flag)
3177 {
3178   gfc_actual_arglist *arg, **ap;
3179   int r;
3180   try t;
3181
3182   ap = &expr->value.function.actual;
3183
3184   init_arglist (specific);
3185
3186   /* Don't attempt to sort the argument list for min or max.  */
3187   if (specific->check.f1m == gfc_check_min_max
3188       || specific->check.f1m == gfc_check_min_max_integer
3189       || specific->check.f1m == gfc_check_min_max_real
3190       || specific->check.f1m == gfc_check_min_max_double)
3191     return (*specific->check.f1m) (*ap);
3192
3193   if (sort_actual (specific->name, ap, specific->formal,
3194                    &expr->where) == FAILURE)
3195     return FAILURE;
3196
3197   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3198     /* This is special because we might have to reorder the argument
3199        list.  */
3200     t = gfc_check_minloc_maxloc (*ap);
3201   else if (specific->check.f3red == gfc_check_minval_maxval)
3202     /* This is also special because we also might have to reorder the
3203        argument list.  */
3204     t = gfc_check_minval_maxval (*ap);
3205   else if (specific->check.f3red == gfc_check_product_sum)
3206     /* Same here. The difference to the previous case is that we allow a
3207        general numeric type.  */
3208     t = gfc_check_product_sum (*ap);
3209   else
3210      {
3211        if (specific->check.f1 == NULL)
3212          {
3213            t = check_arglist (ap, specific, error_flag);
3214            if (t == SUCCESS)
3215              expr->ts = specific->ts;
3216          }
3217        else
3218          t = do_check (specific, *ap);
3219      }
3220
3221   /* Check ranks for elemental intrinsics.  */
3222   if (t == SUCCESS && specific->elemental)
3223     {
3224       r = 0;
3225       for (arg = expr->value.function.actual; arg; arg = arg->next)
3226         {
3227           if (arg->expr == NULL || arg->expr->rank == 0)
3228             continue;
3229           if (r == 0)
3230             {
3231               r = arg->expr->rank;
3232               continue;
3233             }
3234
3235           if (arg->expr->rank != r)
3236             {
3237               gfc_error
3238                 ("Ranks of arguments to elemental intrinsic '%s' differ "
3239                  "at %L", specific->name, &arg->expr->where);
3240               return FAILURE;
3241             }
3242         }
3243     }
3244
3245   if (t == FAILURE)
3246     remove_nullargs (ap);
3247
3248   return t;
3249 }
3250
3251
3252 /* See if an intrinsic is one of the intrinsics we evaluate
3253    as an extension.  */
3254
3255 static int
3256 gfc_init_expr_extensions (gfc_intrinsic_sym *isym)
3257 {
3258   /* FIXME: This should be moved into the intrinsic definitions.  */
3259   static const char * const init_expr_extensions[] = {
3260     "digits", "epsilon", "huge", "kind", "maxexponent", "minexponent",
3261     "precision", "present", "radix", "range", "selected_real_kind",
3262     "tiny", NULL
3263   };
3264
3265   int i;
3266
3267   for (i = 0; init_expr_extensions[i]; i++)
3268     if (strcmp (init_expr_extensions[i], isym->name) == 0)
3269       return 0;
3270
3271   return 1;
3272 }
3273
3274
3275 /* Check whether an intrinsic belongs to whatever standard the user
3276    has chosen.  */
3277
3278 static void
3279 check_intrinsic_standard (const char *name, int standard, locus * where)
3280 {
3281   if (!gfc_option.warn_nonstd_intrinsics)
3282     return;
3283
3284   gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3285                   "in the selected standard", name, where);
3286 }
3287
3288
3289 /* See if a function call corresponds to an intrinsic function call.
3290    We return:
3291
3292     MATCH_YES    if the call corresponds to an intrinsic, simplification
3293                  is done if possible.
3294
3295     MATCH_NO     if the call does not correspond to an intrinsic
3296
3297     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3298                  error during the simplification process.
3299
3300    The error_flag parameter enables an error reporting.  */
3301
3302 match
3303 gfc_intrinsic_func_interface (gfc_expr * expr, int error_flag)
3304 {
3305   gfc_intrinsic_sym *isym, *specific;
3306   gfc_actual_arglist *actual;
3307   const char *name;
3308   int flag;
3309
3310   if (expr->value.function.isym != NULL)
3311     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3312       ? MATCH_ERROR : MATCH_YES;
3313
3314   gfc_suppress_error = !error_flag;
3315   flag = 0;
3316
3317   for (actual = expr->value.function.actual; actual; actual = actual->next)
3318     if (actual->expr != NULL)
3319       flag |= (actual->expr->ts.type != BT_INTEGER
3320                && actual->expr->ts.type != BT_CHARACTER);
3321
3322   name = expr->symtree->n.sym->name;
3323
3324   isym = specific = gfc_find_function (name);
3325   if (isym == NULL)
3326     {
3327       gfc_suppress_error = 0;
3328       return MATCH_NO;
3329     }
3330
3331   gfc_current_intrinsic_where = &expr->where;
3332
3333   /* Bypass the generic list for min and max.  */
3334   if (isym->check.f1m == gfc_check_min_max)
3335     {
3336       init_arglist (isym);
3337
3338       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3339         goto got_specific;
3340
3341       gfc_suppress_error = 0;
3342       return MATCH_NO;
3343     }
3344
3345   /* If the function is generic, check all of its specific
3346      incarnations.  If the generic name is also a specific, we check
3347      that name last, so that any error message will correspond to the
3348      specific.  */
3349   gfc_suppress_error = 1;
3350
3351   if (isym->generic)
3352     {
3353       for (specific = isym->specific_head; specific;
3354            specific = specific->next)
3355         {
3356           if (specific == isym)
3357             continue;
3358           if (check_specific (specific, expr, 0) == SUCCESS)
3359             goto got_specific;
3360         }
3361     }
3362
3363   gfc_suppress_error = !error_flag;
3364
3365   if (check_specific (isym, expr, error_flag) == FAILURE)
3366     {
3367       gfc_suppress_error = 0;
3368       return MATCH_NO;
3369     }
3370
3371   specific = isym;
3372
3373 got_specific:
3374   expr->value.function.isym = specific;
3375   gfc_intrinsic_symbol (expr->symtree->n.sym);
3376
3377   gfc_suppress_error = 0;
3378   if (do_simplify (specific, expr) == FAILURE)
3379     return MATCH_ERROR;
3380
3381   /* TODO: We should probably only allow elemental functions here.  */
3382   flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER);
3383
3384   if (pedantic && gfc_init_expr
3385       && flag && gfc_init_expr_extensions (specific))
3386     {
3387       if (gfc_notify_std (GFC_STD_GNU, "Extension: Evaluation of "
3388             "nonstandard initialization expression at %L", &expr->where)
3389           == FAILURE)
3390         {
3391           return MATCH_ERROR;
3392         }
3393     }
3394
3395   check_intrinsic_standard (name, isym->standard, &expr->where);
3396
3397   return MATCH_YES;
3398 }
3399
3400
3401 /* See if a CALL statement corresponds to an intrinsic subroutine.
3402    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3403    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3404    correspond).  */
3405
3406 match
3407 gfc_intrinsic_sub_interface (gfc_code * c, int error_flag)
3408 {
3409   gfc_intrinsic_sym *isym;
3410   const char *name;
3411
3412   name = c->symtree->n.sym->name;
3413
3414   isym = find_subroutine (name);
3415   if (isym == NULL)
3416     return MATCH_NO;
3417
3418   gfc_suppress_error = !error_flag;
3419
3420   init_arglist (isym);
3421
3422   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3423     goto fail;
3424
3425   if (isym->check.f1 != NULL)
3426     {
3427       if (do_check (isym, c->ext.actual) == FAILURE)
3428         goto fail;
3429     }
3430   else
3431     {
3432       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3433         goto fail;
3434     }
3435
3436   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3437      seen at this point.  */
3438   gfc_suppress_error = 0;
3439
3440   if (isym->resolve.s1 != NULL)
3441     isym->resolve.s1 (c);
3442   else
3443     c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3444
3445   if (gfc_pure (NULL) && !isym->elemental)
3446     {
3447       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3448                  &c->loc);
3449       return MATCH_ERROR;
3450     }
3451
3452   c->resolved_sym->attr.noreturn = isym->noreturn;
3453   check_intrinsic_standard (name, isym->standard, &c->loc);
3454
3455   return MATCH_YES;
3456
3457 fail:
3458   gfc_suppress_error = 0;
3459   return MATCH_NO;
3460 }
3461
3462
3463 /* Call gfc_convert_type() with warning enabled.  */
3464
3465 try
3466 gfc_convert_type (gfc_expr * expr, gfc_typespec * ts, int eflag)
3467 {
3468   return gfc_convert_type_warn (expr, ts, eflag, 1);
3469 }
3470
3471
3472 /* Try to convert an expression (in place) from one type to another.
3473    'eflag' controls the behavior on error.
3474
3475    The possible values are:
3476
3477      1 Generate a gfc_error()
3478      2 Generate a gfc_internal_error().
3479
3480    'wflag' controls the warning related to conversion.  */
3481
3482 try
3483 gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
3484                        int wflag)
3485 {
3486   gfc_intrinsic_sym *sym;
3487   gfc_typespec from_ts;
3488   locus old_where;
3489   gfc_expr *new;
3490   int rank;
3491   mpz_t *shape;
3492
3493   from_ts = expr->ts;           /* expr->ts gets clobbered */
3494
3495   if (ts->type == BT_UNKNOWN)
3496     goto bad;
3497
3498   /* NULL and zero size arrays get their type here.  */
3499   if (expr->expr_type == EXPR_NULL
3500       || (expr->expr_type == EXPR_ARRAY
3501           && expr->value.constructor == NULL))
3502     {
3503       /* Sometimes the RHS acquire the type.  */
3504       expr->ts = *ts;
3505       return SUCCESS;
3506     }
3507
3508   if (expr->ts.type == BT_UNKNOWN)
3509     goto bad;
3510
3511   if (expr->ts.type == BT_DERIVED
3512       && ts->type == BT_DERIVED
3513       && gfc_compare_types (&expr->ts, ts))
3514     return SUCCESS;
3515
3516   sym = find_conv (&expr->ts, ts);
3517   if (sym == NULL)
3518     goto bad;
3519
3520   /* At this point, a conversion is necessary. A warning may be needed.  */
3521   if ((gfc_option.warn_std & sym->standard) != 0)
3522     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3523                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3524   else if (wflag && gfc_option.warn_conversion)
3525     gfc_warning_now ("Conversion from %s to %s at %L",
3526                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3527
3528   /* Insert a pre-resolved function call to the right function.  */
3529   old_where = expr->where;
3530   rank = expr->rank;
3531   shape = expr->shape;
3532
3533   new = gfc_get_expr ();
3534   *new = *expr;
3535
3536   new = gfc_build_conversion (new);
3537   new->value.function.name = sym->lib_name;
3538   new->value.function.isym = sym;
3539   new->where = old_where;
3540   new->rank = rank;
3541   new->shape = gfc_copy_shape (shape, rank);
3542
3543   gfc_get_ha_sym_tree (sym->name, &new->symtree);
3544   new->symtree->n.sym->ts = *ts;
3545   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3546   new->symtree->n.sym->attr.function = 1;
3547   new->symtree->n.sym->attr.intrinsic = 1;
3548   new->symtree->n.sym->attr.elemental = 1;
3549   new->symtree->n.sym->attr.pure = 1;
3550   new->symtree->n.sym->attr.referenced = 1;
3551   gfc_intrinsic_symbol(new->symtree->n.sym);
3552   gfc_commit_symbol (new->symtree->n.sym);
3553
3554   *expr = *new;
3555
3556   gfc_free (new);
3557   expr->ts = *ts;
3558
3559   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3560       && do_simplify (sym, expr) == FAILURE)
3561     {
3562
3563       if (eflag == 2)
3564         goto bad;
3565       return FAILURE;           /* Error already generated in do_simplify() */
3566     }
3567
3568   return SUCCESS;
3569
3570 bad:
3571   if (eflag == 1)
3572     {
3573       gfc_error ("Can't convert %s to %s at %L",
3574                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3575       return FAILURE;
3576     }
3577
3578   gfc_internal_error ("Can't convert %s to %s at %L",
3579                       gfc_typename (&from_ts), gfc_typename (ts),
3580                       &expr->where);
3581   /* Not reached */
3582 }