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