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_1 ("new_line", 0, 0, BT_CHARACTER, dc, GFC_STD_F2003,
1914              gfc_check_new_line, gfc_simplify_new_line, NULL,
1915              i, BT_CHARACTER, dc, REQUIRED);
1916
1917   add_sym_2 ("nint", 1, 1, BT_INTEGER, di, GFC_STD_F77,
1918              gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1919              a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1920
1921   add_sym_1 ("idnint", 1, 1, BT_INTEGER, di, GFC_STD_F77,
1922              gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1923              a, BT_REAL, dd, REQUIRED);
1924
1925   make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
1926
1927   add_sym_1 ("not", 1, 0, BT_INTEGER, di, GFC_STD_F95,
1928              gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1929              i, BT_INTEGER, di, REQUIRED);
1930
1931   make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
1932
1933   add_sym_1 ("null", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1934              gfc_check_null, gfc_simplify_null, NULL,
1935              mo, BT_INTEGER, di, OPTIONAL);
1936
1937   make_generic ("null", GFC_ISYM_NONE, GFC_STD_F95);
1938
1939   add_sym_3 ("pack", 0, 0, BT_REAL, dr, GFC_STD_F95,
1940              gfc_check_pack, NULL, gfc_resolve_pack,
1941              ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
1942              v, BT_REAL, dr, OPTIONAL);
1943
1944   make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
1945
1946   add_sym_1 ("precision", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1947              gfc_check_precision, gfc_simplify_precision, NULL,
1948              x, BT_UNKNOWN, 0, REQUIRED);
1949
1950   make_generic ("precision", GFC_ISYM_NONE, GFC_STD_F95);
1951
1952   add_sym_1 ("present", 0, 0, BT_LOGICAL, dl, GFC_STD_F95,
1953              gfc_check_present, NULL, NULL,
1954              a, BT_REAL, dr, REQUIRED);
1955
1956   make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
1957
1958   add_sym_3red ("product", 0, 0, BT_REAL, dr, GFC_STD_F95,
1959                 gfc_check_product_sum, NULL, gfc_resolve_product,
1960                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1961                 msk, BT_LOGICAL, dl, OPTIONAL);
1962
1963   make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
1964
1965   add_sym_1 ("radix", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1966              gfc_check_radix, gfc_simplify_radix, NULL,
1967              x, BT_UNKNOWN, 0, REQUIRED);
1968
1969   make_generic ("radix", GFC_ISYM_NONE, GFC_STD_F95);
1970
1971   /* The following function is for G77 compatibility.  */
1972   add_sym_1 ("rand", 0, 0, BT_REAL, 4, GFC_STD_GNU,
1973              gfc_check_rand, NULL, NULL,
1974              i, BT_INTEGER, 4, OPTIONAL);
1975
1976   /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
1977      use slightly different shoddy multiplicative congruential PRNG.  */
1978   make_alias ("ran", GFC_STD_GNU);
1979
1980   make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
1981
1982   add_sym_1 ("range", 0, 0, BT_INTEGER, di, GFC_STD_F95,
1983              gfc_check_range, gfc_simplify_range, NULL,
1984              x, BT_REAL, dr, REQUIRED);
1985
1986   make_generic ("range", GFC_ISYM_NONE, GFC_STD_F95);
1987
1988   add_sym_2 ("real", 1, 0, BT_REAL, dr, GFC_STD_F77,
1989              gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1990              a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1991
1992   /* This provides compatibility with g77.  */
1993   add_sym_1 ("realpart", 1, 0, BT_REAL, dr, GFC_STD_GNU,
1994              gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
1995              a, BT_UNKNOWN, dr, REQUIRED);
1996
1997   add_sym_1 ("float", 1, 0, BT_REAL, dr, GFC_STD_F77,
1998              gfc_check_i, gfc_simplify_float, NULL,
1999              a, BT_INTEGER, di, REQUIRED);
2000
2001   add_sym_1 ("sngl", 1, 0, BT_REAL, dr, GFC_STD_F77,
2002              NULL, gfc_simplify_sngl, NULL,
2003              a, BT_REAL, dd, REQUIRED);
2004
2005   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2006
2007   add_sym_2 ("rename", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2008              gfc_check_rename, NULL, gfc_resolve_rename,
2009              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2010
2011   make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2012
2013   add_sym_2 ("repeat", 0, 0, BT_CHARACTER, dc, GFC_STD_F95,
2014              gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2015              stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED);
2016
2017   make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2018
2019   add_sym_4 ("reshape", 0, 0, BT_REAL, dr, GFC_STD_F95,
2020              gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2021              src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2022              pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2023
2024   make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2025
2026   add_sym_1 ("rrspacing", 1, 0, BT_REAL, dr, GFC_STD_F95,
2027              gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2028              x, BT_REAL, dr, REQUIRED);
2029
2030   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2031
2032   add_sym_2 ("scale", 1, 0, BT_REAL, dr, GFC_STD_F95,
2033              gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2034              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2035
2036   make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2037
2038   add_sym_3 ("scan", 1, 0, BT_INTEGER, di, GFC_STD_F95,
2039              gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2040              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2041              bck, BT_LOGICAL, dl, OPTIONAL);
2042
2043   make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2044
2045   /* Added for G77 compatibility garbage.  */
2046   add_sym_0 ("second", 0, 0, BT_REAL, 4, GFC_STD_GNU,
2047              NULL, NULL, NULL);
2048
2049   make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2050
2051   /* Added for G77 compatibility.  */
2052   add_sym_1 ("secnds", 0, 0, BT_REAL, dr, GFC_STD_GNU,
2053              gfc_check_secnds, NULL, gfc_resolve_secnds,
2054              x, BT_REAL, dr, REQUIRED);
2055
2056   make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2057
2058   add_sym_1 ("selected_int_kind", 0, 0, BT_INTEGER, di,  GFC_STD_F95,
2059              gfc_check_selected_int_kind, gfc_simplify_selected_int_kind, NULL,
2060              r, BT_INTEGER, di, REQUIRED);
2061
2062   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2063
2064   add_sym_2 ("selected_real_kind", 0, 0, BT_INTEGER, di,  GFC_STD_F95,
2065              gfc_check_selected_real_kind, gfc_simplify_selected_real_kind,
2066              NULL,
2067              p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2068
2069   make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2070
2071   add_sym_2 ("set_exponent", 1, 0, BT_REAL, dr, GFC_STD_F95,
2072              gfc_check_set_exponent, gfc_simplify_set_exponent,
2073              gfc_resolve_set_exponent,
2074              x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2075
2076   make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2077
2078   add_sym_1 ("shape", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2079              gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2080              src, BT_REAL, dr, REQUIRED);
2081
2082   make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2083
2084   add_sym_2 ("sign", 1, 1, BT_REAL, dr, GFC_STD_F77,
2085              gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2086              a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2087
2088   add_sym_2 ("isign", 1, 1, BT_INTEGER, di, GFC_STD_F77,
2089              NULL, gfc_simplify_sign, gfc_resolve_sign,
2090              a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2091
2092   add_sym_2 ("dsign", 1, 1, BT_REAL, dd, GFC_STD_F77,
2093              NULL, gfc_simplify_sign, gfc_resolve_sign,
2094              a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2095
2096   make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2097
2098   add_sym_2 ("signal", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2099              gfc_check_signal, NULL, gfc_resolve_signal,
2100              num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2101
2102   make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2103
2104   add_sym_1 ("sin", 1, 1, BT_REAL, dr, GFC_STD_F77,
2105              gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2106              x, BT_REAL, dr, REQUIRED);
2107
2108   add_sym_1 ("dsin", 1, 1, BT_REAL, dd, GFC_STD_F77,
2109              NULL, gfc_simplify_sin, gfc_resolve_sin,
2110              x, BT_REAL, dd, REQUIRED);
2111
2112   add_sym_1 ("csin", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
2113              NULL, gfc_simplify_sin, gfc_resolve_sin,
2114              x, BT_COMPLEX, dz, REQUIRED);
2115
2116   add_sym_1 ("zsin", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU,
2117              NULL, gfc_simplify_sin, gfc_resolve_sin,
2118              x, BT_COMPLEX, dd, REQUIRED);
2119
2120   make_alias ("cdsin", GFC_STD_GNU);
2121
2122   make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2123
2124   add_sym_1 ("sinh", 1, 1, BT_REAL, dr, GFC_STD_F77,
2125              gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2126              x, BT_REAL, dr, REQUIRED);
2127
2128   add_sym_1 ("dsinh", 1, 1, BT_REAL, dd, GFC_STD_F77,
2129              NULL, gfc_simplify_sinh, gfc_resolve_sinh,
2130              x, BT_REAL, dd, REQUIRED);
2131
2132   make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2133
2134   add_sym_2 ("size", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2135              gfc_check_size, gfc_simplify_size, NULL,
2136              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2137
2138   make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2139
2140   add_sym_1 ("spacing", 1, 0, BT_REAL, dr, GFC_STD_F95,
2141              gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2142              x, BT_REAL, dr, REQUIRED);
2143
2144   make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2145
2146   add_sym_3 ("spread", 0, 0, BT_REAL, dr, GFC_STD_F95,
2147              gfc_check_spread, NULL, gfc_resolve_spread,
2148              src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2149              n, BT_INTEGER, di, REQUIRED);
2150
2151   make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2152
2153   add_sym_1 ("sqrt", 1, 1, BT_REAL, dr, GFC_STD_F77,
2154              gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2155              x, BT_REAL, dr, REQUIRED);
2156
2157   add_sym_1 ("dsqrt", 1, 1, BT_REAL, dd, GFC_STD_F77,
2158              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2159              x, BT_REAL, dd, REQUIRED);
2160
2161   add_sym_1 ("csqrt", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
2162              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2163              x, BT_COMPLEX, dz, REQUIRED);
2164
2165   add_sym_1 ("zsqrt", 1, 1, BT_COMPLEX, dd, GFC_STD_GNU,
2166              NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2167              x, BT_COMPLEX, dd, REQUIRED);
2168
2169   make_alias ("cdsqrt", GFC_STD_GNU);
2170
2171   make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2172
2173   add_sym_2 ("stat", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2174              gfc_check_stat, NULL, gfc_resolve_stat,
2175              a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2176
2177   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2178
2179   add_sym_3red ("sum", 0, 0, BT_UNKNOWN, 0, GFC_STD_F95,
2180                 gfc_check_product_sum, NULL, gfc_resolve_sum,
2181                 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2182                 msk, BT_LOGICAL, dl, OPTIONAL);
2183
2184   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2185
2186   add_sym_2 ("symlnk", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2187              gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2188              a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2189
2190   make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2191
2192   add_sym_1 ("system", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2193              NULL, NULL, NULL,
2194              c, BT_CHARACTER, dc, REQUIRED);
2195
2196   make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2197
2198   add_sym_1 ("tan", 1, 1, BT_REAL, dr, GFC_STD_F77,
2199              gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2200              x, BT_REAL, dr, REQUIRED);
2201
2202   add_sym_1 ("dtan", 1, 1, BT_REAL, dd, GFC_STD_F77,
2203              NULL, gfc_simplify_tan, gfc_resolve_tan,
2204              x, BT_REAL, dd, REQUIRED);
2205
2206   make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2207
2208   add_sym_1 ("tanh", 1, 1, BT_REAL, dr, GFC_STD_F77,
2209              gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2210              x, BT_REAL, dr, REQUIRED);
2211
2212   add_sym_1 ("dtanh", 1, 1, BT_REAL, dd, GFC_STD_F77,
2213              NULL, gfc_simplify_tanh, gfc_resolve_tanh,
2214              x, BT_REAL, dd, REQUIRED);
2215
2216   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2217
2218   add_sym_0 ("time", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2219              NULL, NULL, gfc_resolve_time);
2220
2221   make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2222
2223   add_sym_0 ("time8", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
2224              NULL, NULL, gfc_resolve_time8);
2225
2226   make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2227
2228   add_sym_1 ("tiny", 0, 0, BT_REAL, dr, GFC_STD_F95,
2229              gfc_check_x, gfc_simplify_tiny, NULL,
2230              x, BT_REAL, dr, REQUIRED);
2231
2232   make_generic ("tiny", GFC_ISYM_NONE, GFC_STD_F95);
2233
2234   add_sym_3 ("transfer", 0, 0, BT_REAL, dr, GFC_STD_F95,
2235              gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2236              src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2237              sz, BT_INTEGER, di, OPTIONAL);
2238
2239   make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2240
2241   add_sym_1 ("transpose", 0, 0, BT_REAL, dr, GFC_STD_F95,
2242              gfc_check_transpose, NULL, gfc_resolve_transpose,
2243              m, BT_REAL, dr, REQUIRED);
2244
2245   make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2246
2247   add_sym_1 ("trim", 0, 0, BT_CHARACTER, dc, GFC_STD_F95,
2248              gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2249              stg, BT_CHARACTER, dc, REQUIRED);
2250
2251   make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2252
2253   add_sym_1 ("ttynam", 0, 0, BT_CHARACTER, 0, GFC_STD_GNU,
2254               gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2255               ut, BT_INTEGER, di, REQUIRED);
2256
2257   make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2258
2259   add_sym_2 ("ubound", 0, 0, BT_INTEGER, di, GFC_STD_F95,
2260              gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2261              ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2262
2263   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2264
2265   /* g77 compatibility for UMASK.  */
2266   add_sym_1 ("umask", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2267              gfc_check_umask, NULL, gfc_resolve_umask,
2268              a, BT_INTEGER, di, REQUIRED);
2269
2270   make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2271
2272   /* g77 compatibility for UNLINK.  */
2273   add_sym_1 ("unlink", 0, 0, BT_INTEGER, di, GFC_STD_GNU,
2274              gfc_check_unlink, NULL, gfc_resolve_unlink,
2275              a, BT_CHARACTER, dc, REQUIRED);
2276
2277   make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2278
2279   add_sym_3 ("unpack", 0, 0, BT_REAL, dr, GFC_STD_F95,
2280              gfc_check_unpack, NULL, gfc_resolve_unpack,
2281              v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2282              f, BT_REAL, dr, REQUIRED);
2283
2284   make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2285
2286   add_sym_3 ("verify", 1, 0, BT_INTEGER, di, GFC_STD_F95,
2287              gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2288              stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2289              bck, BT_LOGICAL, dl, OPTIONAL);
2290
2291   make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2292
2293   add_sym_1 ("loc", 0, 0, BT_INTEGER, ii, GFC_STD_GNU,
2294             gfc_check_loc, NULL, gfc_resolve_loc,
2295             ar, BT_UNKNOWN, 0, REQUIRED);
2296
2297   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2298
2299 }
2300
2301
2302 /* Add intrinsic subroutines.  */
2303
2304 static void
2305 add_subroutines (void)
2306 {
2307   /* Argument names as in the standard (to be used as argument keywords).  */
2308   const char
2309     *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2310     *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2311     *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2312     *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2313     *com = "command", *length = "length", *st = "status",
2314     *val = "value", *num = "number", *name = "name",
2315     *trim_name = "trim_name", *ut = "unit", *han = "handler",
2316     *sec = "seconds", *res = "result", *of = "offset", *md = "mode";
2317
2318   int di, dr, dc, dl, ii;
2319
2320   di = gfc_default_integer_kind;
2321   dr = gfc_default_real_kind;
2322   dc = gfc_default_character_kind;
2323   dl = gfc_default_logical_kind;
2324   ii = gfc_index_integer_kind;
2325
2326   add_sym_0s ("abort", GFC_STD_GNU, NULL);
2327
2328   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2329     make_noreturn();
2330
2331   add_sym_1s ("cpu_time", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2332               gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2333               tm, BT_REAL, dr, REQUIRED);
2334
2335   /* More G77 compatibility garbage.  */
2336   add_sym_2s ("ctime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2337               gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2338               tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2339
2340   add_sym_1s ("idate", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2341               gfc_check_itime_idate, NULL, gfc_resolve_idate,
2342               vl, BT_INTEGER, 4, REQUIRED);
2343
2344   add_sym_1s ("itime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2345               gfc_check_itime_idate, NULL, gfc_resolve_itime,
2346               vl, BT_INTEGER, 4, REQUIRED);
2347
2348   add_sym_2s ("ltime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2349               gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2350               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2351
2352   add_sym_2s ("gmtime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2353               gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2354               tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2355
2356   add_sym_1s ("second", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2357               gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2358               tm, BT_REAL, dr, REQUIRED);
2359
2360   add_sym_2s ("chdir", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2361               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2362               name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2363
2364   add_sym_3s ("chmod", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2365               gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2366               name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2367               st, BT_INTEGER, di, OPTIONAL);
2368
2369   add_sym_4s ("date_and_time", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2370               gfc_check_date_and_time, NULL, NULL,
2371               dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2372               zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2373
2374   /* More G77 compatibility garbage.  */
2375   add_sym_2s ("etime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2376              gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2377               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2378
2379   add_sym_2s ("dtime", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2380              gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2381               vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2382
2383   add_sym_1s ("fdate", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2384              gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2385              dt, BT_CHARACTER, dc, REQUIRED);
2386
2387   add_sym_1s ("gerror", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2388               gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER,
2389               dc, REQUIRED);
2390
2391   add_sym_2s ("getcwd", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2392           gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2393               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2394
2395   add_sym_2s ("getenv", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2396               NULL, NULL, NULL,
2397               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2398
2399   add_sym_2s ("getarg", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2400               NULL, NULL, gfc_resolve_getarg,
2401               c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2402
2403   add_sym_1s ("getlog", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2404               gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2405               dc, REQUIRED);
2406
2407   /* F2003 commandline routines.  */
2408
2409   add_sym_3s ("get_command", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2410               NULL, NULL, gfc_resolve_get_command,
2411               com, BT_CHARACTER, dc, OPTIONAL, length, BT_INTEGER, di, OPTIONAL,
2412               st, BT_INTEGER, di, OPTIONAL);
2413
2414   add_sym_4s ("get_command_argument", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2415               NULL, NULL, gfc_resolve_get_command_argument,
2416               num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2417               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2418
2419   /* F2003 subroutine to get environment variables.  */
2420
2421   add_sym_5s ("get_environment_variable", 0, BT_UNKNOWN, 0, GFC_STD_F2003,
2422              NULL, NULL, gfc_resolve_get_environment_variable,
2423               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2424               length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2425               trim_name, BT_LOGICAL, dl, OPTIONAL);
2426
2427   add_sym_5s ("mvbits", 1, BT_UNKNOWN, 0, GFC_STD_F95,
2428               gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2429               f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2430               ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2431               tp, BT_INTEGER, di, REQUIRED);
2432
2433   add_sym_1s ("random_number", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2434               gfc_check_random_number, NULL, gfc_resolve_random_number,
2435               h, BT_REAL, dr, REQUIRED);
2436
2437   add_sym_3s ("random_seed", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2438              gfc_check_random_seed, NULL, NULL,
2439               sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2440               gt, BT_INTEGER, di, OPTIONAL);
2441
2442   /* More G77 compatibility garbage.  */
2443   add_sym_3s ("alarm", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2444               gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2445               sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2446               st, BT_INTEGER, di, OPTIONAL);
2447
2448   add_sym_1s ("srand", 0, BT_UNKNOWN, di, GFC_STD_GNU,
2449              gfc_check_srand, NULL, gfc_resolve_srand,
2450               c, BT_INTEGER, 4, REQUIRED);
2451
2452   add_sym_1s ("exit", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2453              gfc_check_exit, NULL, gfc_resolve_exit,
2454               c, BT_INTEGER, di, OPTIONAL);
2455
2456   if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2457     make_noreturn();
2458
2459   add_sym_3s ("fgetc", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2460               gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2461               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2462               st, BT_INTEGER, di, OPTIONAL);
2463
2464   add_sym_2s ("fget", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2465               gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2466               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2467
2468   add_sym_1s ("flush", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2469               gfc_check_flush, NULL, gfc_resolve_flush,
2470               c, BT_INTEGER, di, OPTIONAL);
2471
2472   add_sym_3s ("fputc", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2473               gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2474               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2475               st, BT_INTEGER, di, OPTIONAL);
2476
2477   add_sym_2s ("fput", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2478               gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2479               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2480
2481   add_sym_1s ("free", 0, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2482               NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2483
2484   add_sym_2s ("ftell", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2485               gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2486               ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2487
2488   add_sym_2s ("hostnm", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2489           gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2490               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2491
2492   add_sym_3s ("kill", 0, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2493               NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2494               val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2495
2496   add_sym_3s ("link", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2497               gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2498               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2499               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2500
2501   add_sym_1s ("perror", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2502           gfc_check_perror, NULL, gfc_resolve_perror,
2503               c, BT_CHARACTER, dc, REQUIRED);
2504
2505   add_sym_3s ("rename", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2506               gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2507               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2508               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2509
2510   add_sym_1s ("sleep", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2511               gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2512               val, BT_CHARACTER, dc, REQUIRED);
2513
2514   add_sym_3s ("fstat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2515               gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2516               ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2517               st, BT_INTEGER, di, OPTIONAL);
2518
2519   add_sym_3s ("lstat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2520               gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2521               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2522               st, BT_INTEGER, di, OPTIONAL);
2523
2524   add_sym_3s ("stat", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2525               gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2526               name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2527               st, BT_INTEGER, di, OPTIONAL);
2528
2529   add_sym_3s ("signal", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2530               gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2531               num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2532               st, BT_INTEGER, di, OPTIONAL);
2533
2534   add_sym_3s ("symlnk", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2535               gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2536               name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2537               dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2538
2539   add_sym_2s ("system", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2540               NULL, NULL, gfc_resolve_system_sub,
2541               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2542
2543   add_sym_3s ("system_clock", 0, BT_UNKNOWN, 0, GFC_STD_F95,
2544              gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2545               c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2546               cm, BT_INTEGER, di, OPTIONAL);
2547
2548   add_sym_2s ("ttynam", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2549               gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2550               ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
2551
2552   add_sym_2s ("umask", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2553           gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2554               val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2555
2556   add_sym_2s ("unlink", 0, BT_UNKNOWN, 0, GFC_STD_GNU,
2557           gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2558               c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2559
2560 }
2561
2562
2563 /* Add a function to the list of conversion symbols.  */
2564
2565 static void
2566 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2567 {
2568
2569   gfc_typespec from, to;
2570   gfc_intrinsic_sym *sym;
2571
2572   if (sizing == SZ_CONVS)
2573     {
2574       nconv++;
2575       return;
2576     }
2577
2578   gfc_clear_ts (&from);
2579   from.type = from_type;
2580   from.kind = from_kind;
2581
2582   gfc_clear_ts (&to);
2583   to.type = to_type;
2584   to.kind = to_kind;
2585
2586   sym = conversion + nconv;
2587
2588   sym->name = conv_name (&from, &to);
2589   sym->lib_name = sym->name;
2590   sym->simplify.cc = gfc_convert_constant;
2591   sym->standard = standard;
2592   sym->elemental = 1;
2593   sym->ts = to;
2594   sym->generic_id = GFC_ISYM_CONVERSION;
2595
2596   nconv++;
2597 }
2598
2599
2600 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2601    functions by looping over the kind tables.  */
2602
2603 static void
2604 add_conversions (void)
2605 {
2606   int i, j;
2607
2608   /* Integer-Integer conversions.  */
2609   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2610     for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2611       {
2612         if (i == j)
2613           continue;
2614
2615         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2616                   BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2617       }
2618
2619   /* Integer-Real/Complex conversions.  */
2620   for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2621     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2622       {
2623         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2624                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2625
2626         add_conv (BT_REAL, gfc_real_kinds[j].kind,
2627                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2628
2629         add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2630                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2631
2632         add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2633                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2634       }
2635
2636   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2637     {
2638       /* Hollerith-Integer conversions.  */
2639       for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2640         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2641                   BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2642       /* Hollerith-Real conversions.  */
2643       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2644         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2645                   BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2646       /* Hollerith-Complex conversions.  */
2647       for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2648         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2649                   BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2650
2651       /* Hollerith-Character conversions.  */
2652       add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2653                   gfc_default_character_kind, GFC_STD_LEGACY);
2654
2655       /* Hollerith-Logical conversions.  */
2656       for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2657         add_conv (BT_HOLLERITH, gfc_default_character_kind,
2658                   BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2659     }
2660
2661   /* Real/Complex - Real/Complex conversions.  */
2662   for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2663     for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2664       {
2665         if (i != j)
2666           {
2667             add_conv (BT_REAL, gfc_real_kinds[i].kind,
2668                       BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2669
2670             add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2671                       BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2672           }
2673
2674         add_conv (BT_REAL, gfc_real_kinds[i].kind,
2675                   BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2676
2677         add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2678                   BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2679       }
2680
2681   /* Logical/Logical kind conversion.  */
2682   for (i = 0; gfc_logical_kinds[i].kind; i++)
2683     for (j = 0; gfc_logical_kinds[j].kind; j++)
2684       {
2685         if (i == j)
2686           continue;
2687
2688         add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2689                   BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2690       }
2691
2692   /* Integer-Logical and Logical-Integer conversions.  */
2693   if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2694     for (i=0; gfc_integer_kinds[i].kind; i++)
2695       for (j=0; gfc_logical_kinds[j].kind; j++)
2696         {
2697           add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2698                     BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2699           add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2700                     BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2701         }
2702 }
2703
2704
2705 /* Initialize the table of intrinsics.  */
2706 void
2707 gfc_intrinsic_init_1 (void)
2708 {
2709   int i;
2710
2711   nargs = nfunc = nsub = nconv = 0;
2712
2713   /* Create a namespace to hold the resolved intrinsic symbols.  */
2714   gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2715
2716   sizing = SZ_FUNCS;
2717   add_functions ();
2718   sizing = SZ_SUBS;
2719   add_subroutines ();
2720   sizing = SZ_CONVS;
2721   add_conversions ();
2722
2723   functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2724                           + sizeof (gfc_intrinsic_arg) * nargs);
2725
2726   next_sym = functions;
2727   subroutines = functions + nfunc;
2728
2729   conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2730
2731   next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2732
2733   sizing = SZ_NOTHING;
2734   nconv = 0;
2735
2736   add_functions ();
2737   add_subroutines ();
2738   add_conversions ();
2739
2740   /* Set the pure flag.  All intrinsic functions are pure, and
2741      intrinsic subroutines are pure if they are elemental.  */
2742
2743   for (i = 0; i < nfunc; i++)
2744     functions[i].pure = 1;
2745
2746   for (i = 0; i < nsub; i++)
2747     subroutines[i].pure = subroutines[i].elemental;
2748 }
2749
2750
2751 void
2752 gfc_intrinsic_done_1 (void)
2753 {
2754   gfc_free (functions);
2755   gfc_free (conversion);
2756   gfc_free_namespace (gfc_intrinsic_namespace);
2757 }
2758
2759
2760 /******** Subroutines to check intrinsic interfaces ***********/
2761
2762 /* Given a formal argument list, remove any NULL arguments that may
2763    have been left behind by a sort against some formal argument list.  */
2764
2765 static void
2766 remove_nullargs (gfc_actual_arglist ** ap)
2767 {
2768   gfc_actual_arglist *head, *tail, *next;
2769
2770   tail = NULL;
2771
2772   for (head = *ap; head; head = next)
2773     {
2774       next = head->next;
2775
2776       if (head->expr == NULL)
2777         {
2778           head->next = NULL;
2779           gfc_free_actual_arglist (head);
2780         }
2781       else
2782         {
2783           if (tail == NULL)
2784             *ap = head;
2785           else
2786             tail->next = head;
2787
2788           tail = head;
2789           tail->next = NULL;
2790         }
2791     }
2792
2793   if (tail == NULL)
2794     *ap = NULL;
2795 }
2796
2797
2798 /* Given an actual arglist and a formal arglist, sort the actual
2799    arglist so that its arguments are in a one-to-one correspondence
2800    with the format arglist.  Arguments that are not present are given
2801    a blank gfc_actual_arglist structure.  If something is obviously
2802    wrong (say, a missing required argument) we abort sorting and
2803    return FAILURE.  */
2804
2805 static try
2806 sort_actual (const char *name, gfc_actual_arglist ** ap,
2807              gfc_intrinsic_arg * formal, locus * where)
2808 {
2809
2810   gfc_actual_arglist *actual, *a;
2811   gfc_intrinsic_arg *f;
2812
2813   remove_nullargs (ap);
2814   actual = *ap;
2815
2816   for (f = formal; f; f = f->next)
2817     f->actual = NULL;
2818
2819   f = formal;
2820   a = actual;
2821
2822   if (f == NULL && a == NULL)   /* No arguments */
2823     return SUCCESS;
2824
2825   for (;;)
2826     {                           /* Put the nonkeyword arguments in a 1:1 correspondence */
2827       if (f == NULL)
2828         break;
2829       if (a == NULL)
2830         goto optional;
2831
2832       if (a->name != NULL)
2833         goto keywords;
2834
2835       f->actual = a;
2836
2837       f = f->next;
2838       a = a->next;
2839     }
2840
2841   if (a == NULL)
2842     goto do_sort;
2843
2844   gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2845   return FAILURE;
2846
2847 keywords:
2848   /* Associate the remaining actual arguments, all of which have
2849      to be keyword arguments.  */
2850   for (; a; a = a->next)
2851     {
2852       for (f = formal; f; f = f->next)
2853         if (strcmp (a->name, f->name) == 0)
2854           break;
2855
2856       if (f == NULL)
2857         {
2858           gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2859                      a->name, name, where);
2860           return FAILURE;
2861         }
2862
2863       if (f->actual != NULL)
2864         {
2865           gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2866                      f->name, name, where);
2867           return FAILURE;
2868         }
2869
2870       f->actual = a;
2871     }
2872
2873 optional:
2874   /* At this point, all unmatched formal args must be optional.  */
2875   for (f = formal; f; f = f->next)
2876     {
2877       if (f->actual == NULL && f->optional == 0)
2878         {
2879           gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2880                      f->name, name, where);
2881           return FAILURE;
2882         }
2883     }
2884
2885 do_sort:
2886   /* Using the formal argument list, string the actual argument list
2887      together in a way that corresponds with the formal list.  */
2888   actual = NULL;
2889
2890   for (f = formal; f; f = f->next)
2891     {
2892       if (f->actual == NULL)
2893         {
2894           a = gfc_get_actual_arglist ();
2895           a->missing_arg_type = f->ts.type;
2896         }
2897       else
2898         a = f->actual;
2899
2900       if (actual == NULL)
2901         *ap = a;
2902       else
2903         actual->next = a;
2904
2905       actual = a;
2906     }
2907   actual->next = NULL;          /* End the sorted argument list.  */
2908
2909   return SUCCESS;
2910 }
2911
2912
2913 /* Compare an actual argument list with an intrinsic's formal argument
2914    list.  The lists are checked for agreement of type.  We don't check
2915    for arrayness here.  */
2916
2917 static try
2918 check_arglist (gfc_actual_arglist ** ap, gfc_intrinsic_sym * sym,
2919                int error_flag)
2920 {
2921   gfc_actual_arglist *actual;
2922   gfc_intrinsic_arg *formal;
2923   int i;
2924
2925   formal = sym->formal;
2926   actual = *ap;
2927
2928   i = 0;
2929   for (; formal; formal = formal->next, actual = actual->next, i++)
2930     {
2931       if (actual->expr == NULL)
2932         continue;
2933
2934       if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2935         {
2936           if (error_flag)
2937             gfc_error
2938               ("Type of argument '%s' in call to '%s' at %L should be "
2939                "%s, not %s", gfc_current_intrinsic_arg[i],
2940                gfc_current_intrinsic, &actual->expr->where,
2941                gfc_typename (&formal->ts), gfc_typename (&actual->expr->ts));
2942           return FAILURE;
2943         }
2944     }
2945
2946   return SUCCESS;
2947 }
2948
2949
2950 /* Given a pointer to an intrinsic symbol and an expression node that
2951    represent the function call to that subroutine, figure out the type
2952    of the result.  This may involve calling a resolution subroutine.  */
2953
2954 static void
2955 resolve_intrinsic (gfc_intrinsic_sym * specific, gfc_expr * e)
2956 {
2957   gfc_expr *a1, *a2, *a3, *a4, *a5;
2958   gfc_actual_arglist *arg;
2959
2960   if (specific->resolve.f1 == NULL)
2961     {
2962       if (e->value.function.name == NULL)
2963         e->value.function.name = specific->lib_name;
2964
2965       if (e->ts.type == BT_UNKNOWN)
2966         e->ts = specific->ts;
2967       return;
2968     }
2969
2970   arg = e->value.function.actual;
2971
2972   /* Special case hacks for MIN and MAX.  */
2973   if (specific->resolve.f1m == gfc_resolve_max
2974       || specific->resolve.f1m == gfc_resolve_min)
2975     {
2976       (*specific->resolve.f1m) (e, arg);
2977       return;
2978     }
2979
2980   if (arg == NULL)
2981     {
2982       (*specific->resolve.f0) (e);
2983       return;
2984     }
2985
2986   a1 = arg->expr;
2987   arg = arg->next;
2988
2989   if (arg == NULL)
2990     {
2991       (*specific->resolve.f1) (e, a1);
2992       return;
2993     }
2994
2995   a2 = arg->expr;
2996   arg = arg->next;
2997
2998   if (arg == NULL)
2999     {
3000       (*specific->resolve.f2) (e, a1, a2);
3001       return;
3002     }
3003
3004   a3 = arg->expr;
3005   arg = arg->next;
3006
3007   if (arg == NULL)
3008     {
3009       (*specific->resolve.f3) (e, a1, a2, a3);
3010       return;
3011     }
3012
3013   a4 = arg->expr;
3014   arg = arg->next;
3015
3016   if (arg == NULL)
3017     {
3018       (*specific->resolve.f4) (e, a1, a2, a3, a4);
3019       return;
3020     }
3021
3022   a5 = arg->expr;
3023   arg = arg->next;
3024
3025   if (arg == NULL)
3026     {
3027       (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3028       return;
3029     }
3030
3031   gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3032 }
3033
3034
3035 /* Given an intrinsic symbol node and an expression node, call the
3036    simplification function (if there is one), perhaps replacing the
3037    expression with something simpler.  We return FAILURE on an error
3038    of the simplification, SUCCESS if the simplification worked, even
3039    if nothing has changed in the expression itself.  */
3040
3041 static try
3042 do_simplify (gfc_intrinsic_sym * specific, gfc_expr * e)
3043 {
3044   gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3045   gfc_actual_arglist *arg;
3046
3047   /* Check the arguments if there are Hollerith constants. We deal with
3048      them at run-time.  */
3049   for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
3050     {
3051       if (arg->expr && arg->expr->from_H)
3052         {
3053           result = NULL;
3054           goto finish;
3055         }
3056     }
3057   /* Max and min require special handling due to the variable number
3058      of args.  */
3059   if (specific->simplify.f1 == gfc_simplify_min)
3060     {
3061       result = gfc_simplify_min (e);
3062       goto finish;
3063     }
3064
3065   if (specific->simplify.f1 == gfc_simplify_max)
3066     {
3067       result = gfc_simplify_max (e);
3068       goto finish;
3069     }
3070
3071   if (specific->simplify.f1 == NULL)
3072     {
3073       result = NULL;
3074       goto finish;
3075     }
3076
3077   arg = e->value.function.actual;
3078
3079   if (arg == NULL)
3080     {
3081       result = (*specific->simplify.f0) ();
3082       goto finish;
3083     }
3084
3085   a1 = arg->expr;
3086   arg = arg->next;
3087
3088   if (specific->simplify.cc == gfc_convert_constant)
3089     {
3090       result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3091       goto finish;
3092     }
3093
3094   /* TODO: Warn if -pedantic and initialization expression and arg
3095      types not integer or character */
3096
3097   if (arg == NULL)
3098     result = (*specific->simplify.f1) (a1);
3099   else
3100     {
3101       a2 = arg->expr;
3102       arg = arg->next;
3103
3104       if (arg == NULL)
3105         result = (*specific->simplify.f2) (a1, a2);
3106       else
3107         {
3108           a3 = arg->expr;
3109           arg = arg->next;
3110
3111           if (arg == NULL)
3112             result = (*specific->simplify.f3) (a1, a2, a3);
3113           else
3114             {
3115               a4 = arg->expr;
3116               arg = arg->next;
3117
3118               if (arg == NULL)
3119                 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3120               else
3121                 {
3122                   a5 = arg->expr;
3123                   arg = arg->next;
3124
3125                   if (arg == NULL)
3126                     result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3127                   else
3128                     gfc_internal_error
3129                       ("do_simplify(): Too many args for intrinsic");
3130                 }
3131             }
3132         }
3133     }
3134
3135 finish:
3136   if (result == &gfc_bad_expr)
3137     return FAILURE;
3138
3139   if (result == NULL)
3140     resolve_intrinsic (specific, e);    /* Must call at run-time */
3141   else
3142     {
3143       result->where = e->where;
3144       gfc_replace_expr (e, result);
3145     }
3146
3147   return SUCCESS;
3148 }
3149
3150
3151 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3152    error messages.  This subroutine returns FAILURE if a subroutine
3153    has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3154    list cannot match any intrinsic.  */
3155
3156 static void
3157 init_arglist (gfc_intrinsic_sym * isym)
3158 {
3159   gfc_intrinsic_arg *formal;
3160   int i;
3161
3162   gfc_current_intrinsic = isym->name;
3163
3164   i = 0;
3165   for (formal = isym->formal; formal; formal = formal->next)
3166     {
3167       if (i >= MAX_INTRINSIC_ARGS)
3168         gfc_internal_error ("init_arglist(): too many arguments");
3169       gfc_current_intrinsic_arg[i++] = formal->name;
3170     }
3171 }
3172
3173
3174 /* Given a pointer to an intrinsic symbol and an expression consisting
3175    of a function call, see if the function call is consistent with the
3176    intrinsic's formal argument list.  Return SUCCESS if the expression
3177    and intrinsic match, FAILURE otherwise.  */
3178
3179 static try
3180 check_specific (gfc_intrinsic_sym * specific, gfc_expr * expr, int error_flag)
3181 {
3182   gfc_actual_arglist *arg, **ap;
3183   int r;
3184   try t;
3185
3186   ap = &expr->value.function.actual;
3187
3188   init_arglist (specific);
3189
3190   /* Don't attempt to sort the argument list for min or max.  */
3191   if (specific->check.f1m == gfc_check_min_max
3192       || specific->check.f1m == gfc_check_min_max_integer
3193       || specific->check.f1m == gfc_check_min_max_real
3194       || specific->check.f1m == gfc_check_min_max_double)
3195     return (*specific->check.f1m) (*ap);
3196
3197   if (sort_actual (specific->name, ap, specific->formal,
3198                    &expr->where) == FAILURE)
3199     return FAILURE;
3200
3201   if (specific->check.f3ml == gfc_check_minloc_maxloc)
3202     /* This is special because we might have to reorder the argument
3203        list.  */
3204     t = gfc_check_minloc_maxloc (*ap);
3205   else if (specific->check.f3red == gfc_check_minval_maxval)
3206     /* This is also special because we also might have to reorder the
3207        argument list.  */
3208     t = gfc_check_minval_maxval (*ap);
3209   else if (specific->check.f3red == gfc_check_product_sum)
3210     /* Same here. The difference to the previous case is that we allow a
3211        general numeric type.  */
3212     t = gfc_check_product_sum (*ap);
3213   else
3214      {
3215        if (specific->check.f1 == NULL)
3216          {
3217            t = check_arglist (ap, specific, error_flag);
3218            if (t == SUCCESS)
3219              expr->ts = specific->ts;
3220          }
3221        else
3222          t = do_check (specific, *ap);
3223      }
3224
3225   /* Check ranks for elemental intrinsics.  */
3226   if (t == SUCCESS && specific->elemental)
3227     {
3228       r = 0;
3229       for (arg = expr->value.function.actual; arg; arg = arg->next)
3230         {
3231           if (arg->expr == NULL || arg->expr->rank == 0)
3232             continue;
3233           if (r == 0)
3234             {
3235               r = arg->expr->rank;
3236               continue;
3237             }
3238
3239           if (arg->expr->rank != r)
3240             {
3241               gfc_error
3242                 ("Ranks of arguments to elemental intrinsic '%s' differ "
3243                  "at %L", specific->name, &arg->expr->where);
3244               return FAILURE;
3245             }
3246         }
3247     }
3248
3249   if (t == FAILURE)
3250     remove_nullargs (ap);
3251
3252   return t;
3253 }
3254
3255
3256 /* See if an intrinsic is one of the intrinsics we evaluate
3257    as an extension.  */
3258
3259 static int
3260 gfc_init_expr_extensions (gfc_intrinsic_sym *isym)
3261 {
3262   /* FIXME: This should be moved into the intrinsic definitions.  */
3263   static const char * const init_expr_extensions[] = {
3264     "digits", "epsilon", "huge", "kind", "maxexponent", "minexponent",
3265     "precision", "present", "radix", "range", "selected_real_kind",
3266     "tiny", NULL
3267   };
3268
3269   int i;
3270
3271   for (i = 0; init_expr_extensions[i]; i++)
3272     if (strcmp (init_expr_extensions[i], isym->name) == 0)
3273       return 0;
3274
3275   return 1;
3276 }
3277
3278
3279 /* Check whether an intrinsic belongs to whatever standard the user
3280    has chosen.  */
3281
3282 static void
3283 check_intrinsic_standard (const char *name, int standard, locus * where)
3284 {
3285   if (!gfc_option.warn_nonstd_intrinsics)
3286     return;
3287
3288   gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3289                   "in the selected standard", name, where);
3290 }
3291
3292
3293 /* See if a function call corresponds to an intrinsic function call.
3294    We return:
3295
3296     MATCH_YES    if the call corresponds to an intrinsic, simplification
3297                  is done if possible.
3298
3299     MATCH_NO     if the call does not correspond to an intrinsic
3300
3301     MATCH_ERROR  if the call corresponds to an intrinsic but there was an
3302                  error during the simplification process.
3303
3304    The error_flag parameter enables an error reporting.  */
3305
3306 match
3307 gfc_intrinsic_func_interface (gfc_expr * expr, int error_flag)
3308 {
3309   gfc_intrinsic_sym *isym, *specific;
3310   gfc_actual_arglist *actual;
3311   const char *name;
3312   int flag;
3313
3314   if (expr->value.function.isym != NULL)
3315     return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3316       ? MATCH_ERROR : MATCH_YES;
3317
3318   gfc_suppress_error = !error_flag;
3319   flag = 0;
3320
3321   for (actual = expr->value.function.actual; actual; actual = actual->next)
3322     if (actual->expr != NULL)
3323       flag |= (actual->expr->ts.type != BT_INTEGER
3324                && actual->expr->ts.type != BT_CHARACTER);
3325
3326   name = expr->symtree->n.sym->name;
3327
3328   isym = specific = gfc_find_function (name);
3329   if (isym == NULL)
3330     {
3331       gfc_suppress_error = 0;
3332       return MATCH_NO;
3333     }
3334
3335   gfc_current_intrinsic_where = &expr->where;
3336
3337   /* Bypass the generic list for min and max.  */
3338   if (isym->check.f1m == gfc_check_min_max)
3339     {
3340       init_arglist (isym);
3341
3342       if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3343         goto got_specific;
3344
3345       gfc_suppress_error = 0;
3346       return MATCH_NO;
3347     }
3348
3349   /* If the function is generic, check all of its specific
3350      incarnations.  If the generic name is also a specific, we check
3351      that name last, so that any error message will correspond to the
3352      specific.  */
3353   gfc_suppress_error = 1;
3354
3355   if (isym->generic)
3356     {
3357       for (specific = isym->specific_head; specific;
3358            specific = specific->next)
3359         {
3360           if (specific == isym)
3361             continue;
3362           if (check_specific (specific, expr, 0) == SUCCESS)
3363             goto got_specific;
3364         }
3365     }
3366
3367   gfc_suppress_error = !error_flag;
3368
3369   if (check_specific (isym, expr, error_flag) == FAILURE)
3370     {
3371       gfc_suppress_error = 0;
3372       return MATCH_NO;
3373     }
3374
3375   specific = isym;
3376
3377 got_specific:
3378   expr->value.function.isym = specific;
3379   gfc_intrinsic_symbol (expr->symtree->n.sym);
3380
3381   gfc_suppress_error = 0;
3382   if (do_simplify (specific, expr) == FAILURE)
3383     return MATCH_ERROR;
3384
3385   /* TODO: We should probably only allow elemental functions here.  */
3386   flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER);
3387
3388   if (pedantic && gfc_init_expr
3389       && flag && gfc_init_expr_extensions (specific))
3390     {
3391       if (gfc_notify_std (GFC_STD_GNU, "Extension: Evaluation of "
3392             "nonstandard initialization expression at %L", &expr->where)
3393           == FAILURE)
3394         {
3395           return MATCH_ERROR;
3396         }
3397     }
3398
3399   check_intrinsic_standard (name, isym->standard, &expr->where);
3400
3401   return MATCH_YES;
3402 }
3403
3404
3405 /* See if a CALL statement corresponds to an intrinsic subroutine.
3406    Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3407    MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3408    correspond).  */
3409
3410 match
3411 gfc_intrinsic_sub_interface (gfc_code * c, int error_flag)
3412 {
3413   gfc_intrinsic_sym *isym;
3414   const char *name;
3415
3416   name = c->symtree->n.sym->name;
3417
3418   isym = find_subroutine (name);
3419   if (isym == NULL)
3420     return MATCH_NO;
3421
3422   gfc_suppress_error = !error_flag;
3423
3424   init_arglist (isym);
3425
3426   if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3427     goto fail;
3428
3429   if (isym->check.f1 != NULL)
3430     {
3431       if (do_check (isym, c->ext.actual) == FAILURE)
3432         goto fail;
3433     }
3434   else
3435     {
3436       if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3437         goto fail;
3438     }
3439
3440   /* The subroutine corresponds to an intrinsic.  Allow errors to be
3441      seen at this point.  */
3442   gfc_suppress_error = 0;
3443
3444   if (isym->resolve.s1 != NULL)
3445     isym->resolve.s1 (c);
3446   else
3447     c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3448
3449   if (gfc_pure (NULL) && !isym->elemental)
3450     {
3451       gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3452                  &c->loc);
3453       return MATCH_ERROR;
3454     }
3455
3456   c->resolved_sym->attr.noreturn = isym->noreturn;
3457   check_intrinsic_standard (name, isym->standard, &c->loc);
3458
3459   return MATCH_YES;
3460
3461 fail:
3462   gfc_suppress_error = 0;
3463   return MATCH_NO;
3464 }
3465
3466
3467 /* Call gfc_convert_type() with warning enabled.  */
3468
3469 try
3470 gfc_convert_type (gfc_expr * expr, gfc_typespec * ts, int eflag)
3471 {
3472   return gfc_convert_type_warn (expr, ts, eflag, 1);
3473 }
3474
3475
3476 /* Try to convert an expression (in place) from one type to another.
3477    'eflag' controls the behavior on error.
3478
3479    The possible values are:
3480
3481      1 Generate a gfc_error()
3482      2 Generate a gfc_internal_error().
3483
3484    'wflag' controls the warning related to conversion.  */
3485
3486 try
3487 gfc_convert_type_warn (gfc_expr * expr, gfc_typespec * ts, int eflag,
3488                        int wflag)
3489 {
3490   gfc_intrinsic_sym *sym;
3491   gfc_typespec from_ts;
3492   locus old_where;
3493   gfc_expr *new;
3494   int rank;
3495   mpz_t *shape;
3496
3497   from_ts = expr->ts;           /* expr->ts gets clobbered */
3498
3499   if (ts->type == BT_UNKNOWN)
3500     goto bad;
3501
3502   /* NULL and zero size arrays get their type here.  */
3503   if (expr->expr_type == EXPR_NULL
3504       || (expr->expr_type == EXPR_ARRAY
3505           && expr->value.constructor == NULL))
3506     {
3507       /* Sometimes the RHS acquire the type.  */
3508       expr->ts = *ts;
3509       return SUCCESS;
3510     }
3511
3512   if (expr->ts.type == BT_UNKNOWN)
3513     goto bad;
3514
3515   if (expr->ts.type == BT_DERIVED
3516       && ts->type == BT_DERIVED
3517       && gfc_compare_types (&expr->ts, ts))
3518     return SUCCESS;
3519
3520   sym = find_conv (&expr->ts, ts);
3521   if (sym == NULL)
3522     goto bad;
3523
3524   /* At this point, a conversion is necessary. A warning may be needed.  */
3525   if ((gfc_option.warn_std & sym->standard) != 0)
3526     gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3527                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3528   else if (wflag && gfc_option.warn_conversion)
3529     gfc_warning_now ("Conversion from %s to %s at %L",
3530                      gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3531
3532   /* Insert a pre-resolved function call to the right function.  */
3533   old_where = expr->where;
3534   rank = expr->rank;
3535   shape = expr->shape;
3536
3537   new = gfc_get_expr ();
3538   *new = *expr;
3539
3540   new = gfc_build_conversion (new);
3541   new->value.function.name = sym->lib_name;
3542   new->value.function.isym = sym;
3543   new->where = old_where;
3544   new->rank = rank;
3545   new->shape = gfc_copy_shape (shape, rank);
3546
3547   gfc_get_ha_sym_tree (sym->name, &new->symtree);
3548   new->symtree->n.sym->ts = *ts;
3549   new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3550   new->symtree->n.sym->attr.function = 1;
3551   new->symtree->n.sym->attr.intrinsic = 1;
3552   new->symtree->n.sym->attr.elemental = 1;
3553   new->symtree->n.sym->attr.pure = 1;
3554   new->symtree->n.sym->attr.referenced = 1;
3555   gfc_intrinsic_symbol(new->symtree->n.sym);
3556   gfc_commit_symbol (new->symtree->n.sym);
3557
3558   *expr = *new;
3559
3560   gfc_free (new);
3561   expr->ts = *ts;
3562
3563   if (gfc_is_constant_expr (expr->value.function.actual->expr)
3564       && do_simplify (sym, expr) == FAILURE)
3565     {
3566
3567       if (eflag == 2)
3568         goto bad;
3569       return FAILURE;           /* Error already generated in do_simplify() */
3570     }
3571
3572   return SUCCESS;
3573
3574 bad:
3575   if (eflag == 1)
3576     {
3577       gfc_error ("Can't convert %s to %s at %L",
3578                  gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3579       return FAILURE;
3580     }
3581
3582   gfc_internal_error ("Can't convert %s to %s at %L",
3583                       gfc_typename (&from_ts), gfc_typename (ts),
3584                       &expr->where);
3585   /* Not reached */
3586 }