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