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