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