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