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