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