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