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