OSDN Git Service

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