?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
libcpp, c, middle-end: Optimize initializers using #embed in C
[official-gcc.git] / gcc / fortran / intrinsic.cc
blobc6fb0a6de45a6369199f3a910f2d67db0024d6d4
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_UNSIGNED, 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 add_sym_1 ("selected_unsigned_kind", GFC_ISYM_SU_KIND,
2970 CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2971 GFC_STD_UNSIGNED, gfc_check_selected_int_kind,
2972 gfc_simplify_selected_unsigned_kind, NULL, r, BT_INTEGER, di,
2973 REQUIRED);
2974
2975 make_generic ("selected_unsigned_kind", GFC_ISYM_SU_KIND, GFC_STD_GNU);
2976
2977 add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2978 GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
2979 gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2980
2981 make_generic ("selected_logical_kind", GFC_ISYM_SL_KIND, GFC_STD_F2023);
2982
2983 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2984 GFC_STD_F95, gfc_check_selected_real_kind,
2985 gfc_simplify_selected_real_kind, NULL,
2986 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2987 "radix", BT_INTEGER, di, OPTIONAL);
2988
2989 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2990
2991 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2992 gfc_check_set_exponent, gfc_simplify_set_exponent,
2993 gfc_resolve_set_exponent,
2994 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2995
2996 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2997
2998 add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2999 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
3000 src, BT_REAL, dr, REQUIRED,
3001 kind, BT_INTEGER, di, OPTIONAL);
3002
3003 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
3004
3005 add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
3006 BT_INTEGER, di, GFC_STD_F2008,
3007 gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
3008 i, BT_INTEGER, di, REQUIRED,
3009 sh, BT_INTEGER, di, REQUIRED);
3010
3011 make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
3012
3013 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
3014 BT_INTEGER, di, GFC_STD_F2008,
3015 gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
3016 i, BT_INTEGER, di, REQUIRED,
3017 sh, BT_INTEGER, di, REQUIRED);
3018
3019 make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
3020
3021 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
3022 BT_INTEGER, di, GFC_STD_F2008,
3023 gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
3024 i, BT_INTEGER, di, REQUIRED,
3025 sh, BT_INTEGER, di, REQUIRED);
3026
3027 make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
3028
3029 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3030 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
3031 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
3032
3033 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
3034 NULL, gfc_simplify_sign, gfc_resolve_sign,
3035 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
3036
3037 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3038 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
3039 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
3040
3041 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
3042
3043 add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3044 di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
3045 num, BT_INTEGER, di, REQUIRED, han, BT_VOID, 0, REQUIRED);
3046
3047 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
3048
3049 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3050 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
3051 x, BT_REAL, dr, REQUIRED);
3052
3053 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3054 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
3055 x, BT_REAL, dd, REQUIRED);
3056
3057 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
3058 NULL, gfc_simplify_sin, gfc_resolve_sin,
3059 x, BT_COMPLEX, dz, REQUIRED);
3060
3061 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
3062 NULL, gfc_simplify_sin, gfc_resolve_sin,
3063 x, BT_COMPLEX, dd, REQUIRED);
3064
3065 make_alias ("cdsin", GFC_STD_GNU);
3066
3067 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
3068
3069 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3070 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
3071 x, BT_REAL, dr, REQUIRED);
3072
3073 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3074 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
3075 x, BT_REAL, dd, REQUIRED);
3076
3077 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
3078
3079 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
3080 BT_INTEGER, di, GFC_STD_F95,
3081 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
3082 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3083 kind, BT_INTEGER, di, OPTIONAL);
3084
3085 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
3086
3087 /* Obtain the stride for a given dimensions; to be used only internally.
3088 "make_from_module" makes it inaccessible for external users. */
3089 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
3090 BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
3091 NULL, NULL, gfc_resolve_stride,
3092 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
3093 make_from_module();
3094
3095 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
3096 BT_INTEGER, ii, GFC_STD_GNU,
3097 gfc_check_sizeof, gfc_simplify_sizeof, NULL,
3098 x, BT_UNKNOWN, 0, REQUIRED);
3099
3100 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
3101
3102 /* The following functions are part of ISO_C_BINDING. */
3103 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
3104 BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
3105 c_ptr_1, BT_VOID, 0, REQUIRED,
3106 c_ptr_2, BT_VOID, 0, OPTIONAL);
3107 make_from_module();
3108
3109 add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
3110 BT_VOID, 0, GFC_STD_F2003,
3111 gfc_check_c_loc, NULL, gfc_resolve_c_loc,
3112 x, BT_UNKNOWN, 0, REQUIRED);
3113 make_from_module();
3114
3115 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
3116 BT_VOID, 0, GFC_STD_F2003,
3117 gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
3118 x, BT_UNKNOWN, 0, REQUIRED);
3119 make_from_module();
3120
3121 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
3122 BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
3123 gfc_check_c_sizeof, gfc_simplify_sizeof, NULL,
3124 x, BT_UNKNOWN, 0, REQUIRED);
3125 make_from_module();
3126
3127 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
3128 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
3129 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
3130 NULL, gfc_simplify_compiler_options, NULL);
3131 make_from_module();
3132
3133 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
3134 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
3135 NULL, gfc_simplify_compiler_version, NULL);
3136 make_from_module();
3137
3138 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
3139 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_spacing, gfc_resolve_spacing,
3140 x, BT_REAL, dr, REQUIRED);
3141
3142 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
3143
3144 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3145 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
3146 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
3147 ncopies, BT_INTEGER, di, REQUIRED);
3148
3149 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
3150
3151 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3152 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
3153 x, BT_REAL, dr, REQUIRED);
3154
3155 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3156 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
3157 x, BT_REAL, dd, REQUIRED);
3158
3159 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
3160 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
3161 x, BT_COMPLEX, dz, REQUIRED);
3162
3163 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
3164 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
3165 x, BT_COMPLEX, dd, REQUIRED);
3166
3167 make_alias ("cdsqrt", GFC_STD_GNU);
3168
3169 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
3170
3171 add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
3172 BT_INTEGER, di, GFC_STD_GNU,
3173 gfc_check_stat, NULL, gfc_resolve_stat,
3174 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3175 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
3176
3177 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
3178
3179 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
3180 ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
3181 gfc_check_failed_or_stopped_images,
3182 gfc_simplify_failed_or_stopped_images,
3183 gfc_resolve_stopped_images, team, BT_VOID, di, OPTIONAL,
3184 kind, BT_INTEGER, di, OPTIONAL);
3185
3186 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
3187 BT_INTEGER, di, GFC_STD_F2008,
3188 gfc_check_storage_size, gfc_simplify_storage_size,
3189 gfc_resolve_storage_size,
3190 a, BT_UNKNOWN, 0, REQUIRED,
3191 kind, BT_INTEGER, di, OPTIONAL);
3192
3193 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3194 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
3195 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3196 msk, BT_LOGICAL, dl, OPTIONAL);
3197
3198 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
3199
3200 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
3201 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
3202 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
3203
3204 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
3205
3206 add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
3207 GFC_STD_GNU, NULL, NULL, NULL,
3208 com, BT_CHARACTER, dc, REQUIRED);
3209
3210 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
3211
3212 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3213 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
3214 x, BT_REAL, dr, REQUIRED);
3215
3216 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3217 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
3218 x, BT_REAL, dd, REQUIRED);
3219
3220 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
3221
3222 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
3223 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
3224 x, BT_REAL, dr, REQUIRED);
3225
3226 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
3227 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
3228 x, BT_REAL, dd, REQUIRED);
3229
3230 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
3231
3232 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER, CLASS_TRANSFORMATIONAL,
3233 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
3234 gfc_check_team_number, NULL, gfc_resolve_team_number,
3235 team, BT_DERIVED, di, OPTIONAL);
3236
3237 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
3238 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
3239 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
3240 dist, BT_INTEGER, di, OPTIONAL);
3241
3242 add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3243 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
3244
3245 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
3246
3247 add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3248 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
3249
3250 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
3251
3252 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3253 gfc_check_fn_r, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED);
3254
3255 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
3256
3257 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
3258 BT_INTEGER, di, GFC_STD_F2008,
3259 gfc_check_i, gfc_simplify_trailz, NULL,
3260 i, BT_INTEGER, di, REQUIRED);
3261
3262 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
3263
3264 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3265 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
3266 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
3267 sz, BT_INTEGER, di, OPTIONAL);
3268
3269 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
3270
3271 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3272 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
3273 m, BT_REAL, dr, REQUIRED);
3274
3275 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
3276
3277 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
3278 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
3279 stg, BT_CHARACTER, dc, REQUIRED);
3280
3281 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
3282
3283 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
3284 0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
3285 ut, BT_INTEGER, di, REQUIRED);
3286
3287 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
3288
3289 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
3290 BT_INTEGER, di, GFC_STD_F95,
3291 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
3292 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3293 kind, BT_INTEGER, di, OPTIONAL);
3294
3295 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
3296
3297 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
3298 BT_INTEGER, di, GFC_STD_F2008,
3299 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
3300 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3301 kind, BT_INTEGER, di, OPTIONAL);
3302
3303 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
3304
3305 /* g77 compatibility for UMASK. */
3306 add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
3307 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
3308 msk, BT_INTEGER, di, REQUIRED);
3309
3310 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
3311
3312 /* g77 compatibility for UNLINK. */
3313 add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3314 di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
3315 "path", BT_CHARACTER, dc, REQUIRED);
3316
3317 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
3318
3319 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
3320 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
3321 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
3322 f, BT_REAL, dr, REQUIRED);
3323
3324 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
3325
3326 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
3327 BT_INTEGER, di, GFC_STD_F95,
3328 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
3329 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
3330 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
3331
3332 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
3333
3334 add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
3335 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
3336 x, BT_UNKNOWN, 0, REQUIRED);
3337
3338 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
3339
3340
3341 /* The degree trigonometric functions were added as part of the DEC
3342 Fortran compatibility effort, and were hidden behind a -fdec-math
3343 option. Fortran 2023 has added some of these functions to Fortran
3344 standard as generic subprogram, e.g., acosd() is added while dacosd()
3345 is not. So, update GFC_STD_GNU to GFC_STD_F2023 for the generic
3346 functions. */
3347
3348 add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
3349 BT_REAL, dr, GFC_STD_F2023,
3350 gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd,
3351 x, BT_REAL, dr, REQUIRED);
3352
3353 make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_F2023);
3354
3355 add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
3356 BT_REAL, dd, GFC_STD_GNU,
3357 gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd,
3358 x, BT_REAL, dd, REQUIRED);
3359
3360 add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
3361 BT_REAL, dr, GFC_STD_F2023,
3362 gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd,
3363 x, BT_REAL, dr, REQUIRED);
3364
3365 make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_F2023);
3366
3367 add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
3368 BT_REAL, dd, GFC_STD_GNU,
3369 gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd,
3370 x, BT_REAL, dd, REQUIRED);
3371
3372 add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
3373 BT_REAL, dr, GFC_STD_F2023,
3374 gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
3375 x, BT_REAL, dr, REQUIRED);
3376
3377 make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_F2023);
3378
3379 add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
3380 BT_REAL, dd, GFC_STD_GNU,
3381 gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd,
3382 x, BT_REAL, dd, REQUIRED);
3383
3384 add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
3385 BT_REAL, dr, GFC_STD_F2023,
3386 gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
3387 y, BT_REAL, dr, REQUIRED,
3388 x, BT_REAL, dr, REQUIRED);
3389
3390 make_generic ("atan2d", GFC_ISYM_ATAN2D, GFC_STD_F2023);
3391
3392 add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
3393 BT_REAL, dd, GFC_STD_GNU,
3394 gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
3395 y, BT_REAL, dd, REQUIRED,
3396 x, BT_REAL, dd, REQUIRED);
3397
3398 add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
3399 BT_REAL, dr, GFC_STD_F2023,
3400 gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd,
3401 x, BT_REAL, dr, REQUIRED);
3402
3403 make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_F2023);
3404
3405 add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
3406 BT_REAL, dd, GFC_STD_GNU,
3407 gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd,
3408 x, BT_REAL, dd, REQUIRED);
3409
3410 add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3411 BT_REAL, dr, GFC_STD_GNU,
3412 gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd,
3413 x, BT_REAL, dr, REQUIRED);
3414
3415 add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3416 BT_REAL, dd, GFC_STD_GNU,
3417 gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trigd,
3418 x, BT_REAL, dd, REQUIRED);
3419
3420 add_sym_1 ("ccotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3421 BT_COMPLEX, dz, GFC_STD_GNU,
3422 NULL, gfc_simplify_cotan, gfc_resolve_trigd,
3423 x, BT_COMPLEX, dz, REQUIRED);
3424
3425 add_sym_1 ("zcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3426 BT_COMPLEX, dd, GFC_STD_GNU,
3427 NULL, gfc_simplify_cotan, gfc_resolve_trigd,
3428 x, BT_COMPLEX, dd, REQUIRED);
3429
3430 make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
3431
3432 add_sym_1 ("cotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
3433 BT_REAL, dr, GFC_STD_GNU,
3434 gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trigd,
3435 x, BT_REAL, dr, REQUIRED);
3436
3437 add_sym_1 ("dcotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
3438 BT_REAL, dd, GFC_STD_GNU,
3439 gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trigd,
3440 x, BT_REAL, dd, REQUIRED);
3441
3442 make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU);
3443
3444 add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
3445 BT_REAL, dr, GFC_STD_F2023,
3446 gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd,
3447 x, BT_REAL, dr, REQUIRED);
3448
3449 make_generic ("sind", GFC_ISYM_SIND, GFC_STD_F2023);
3450
3451 add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
3452 BT_REAL, dd, GFC_STD_GNU,
3453 gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd,
3454 x, BT_REAL, dd, REQUIRED);
3455
3456 add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
3457 BT_REAL, dr, GFC_STD_F2023,
3458 gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd,
3459 x, BT_REAL, dr, REQUIRED);
3460
3461 make_generic ("tand", GFC_ISYM_TAND, GFC_STD_F2023);
3462
3463 add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
3464 BT_REAL, dd, GFC_STD_GNU,
3465 gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd,
3466 x, BT_REAL, dd, REQUIRED);
3467
3468 /* The following function is internally used for coarray libray functions.
3469 "make_from_module" makes it inaccessible for external users. */
3470 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
3471 BT_REAL, dr, GFC_STD_GNU, NULL, NULL, NULL,
3472 x, BT_REAL, dr, REQUIRED);
3473 make_from_module();
3474 }
3475
3476
3477 /* Add intrinsic subroutines. */
3478
3479 static void
3480 add_subroutines (void)
3481 {
3482 /* Argument names. These are used as argument keywords and so need to
3483 match the documentation. Please keep this list in sorted order. */
3484 static const char
3485 *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
3486 *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
3487 *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
3488 *length = "length", *ln = "len", *md = "mode", *msk = "mask",
3489 *name = "name", *num = "number", *of = "offset", *old = "old",
3490 *p1 = "path1", *p2 = "path2", *pid = "pid", *pos = "pos",
3491 *pt = "put", *ptr = "ptr", *res = "result",
3492 *result_image = "result_image", *sec = "seconds", *sig = "sig",
3493 *st = "status", *stat = "stat", *sz = "size", *t = "to",
3494 *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
3495 *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
3496
3497 int di, dr, dc, dl, ii;
3498
3499 di = gfc_default_integer_kind;
3500 dr = gfc_default_real_kind;
3501 dc = gfc_default_character_kind;
3502 dl = gfc_default_logical_kind;
3503 ii = gfc_index_integer_kind;
3504
3505 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
3506
3507 make_noreturn();
3508
3509 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
3510 BT_UNKNOWN, 0, GFC_STD_F2008,
3511 gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
3512 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3513 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3514 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3515
3516 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
3517 BT_UNKNOWN, 0, GFC_STD_F2008,
3518 gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
3519 "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3520 "atom", BT_INTEGER, di, REQUIRED, INTENT_IN,
3521 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3522
3523 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS, CLASS_ATOMIC,
3524 BT_UNKNOWN, 0, GFC_STD_F2018,
3525 gfc_check_atomic_cas, NULL, NULL,
3526 "atom", BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3527 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3528 "compare", BT_INTEGER, di, REQUIRED, INTENT_IN,
3529 "new", BT_INTEGER, di, REQUIRED, INTENT_IN,
3530 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3531
3532 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD, CLASS_ATOMIC,
3533 BT_UNKNOWN, 0, GFC_STD_F2018,
3534 gfc_check_atomic_op, NULL, NULL,
3535 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3536 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3537 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3538
3539 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND, CLASS_ATOMIC,
3540 BT_UNKNOWN, 0, GFC_STD_F2018,
3541 gfc_check_atomic_op, NULL, NULL,
3542 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3543 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3544 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3545
3546 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR, CLASS_ATOMIC,
3547 BT_UNKNOWN, 0, GFC_STD_F2018,
3548 gfc_check_atomic_op, NULL, NULL,
3549 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3550 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3551 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3552
3553 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR, CLASS_ATOMIC,
3554 BT_UNKNOWN, 0, GFC_STD_F2018,
3555 gfc_check_atomic_op, NULL, NULL,
3556 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3557 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3558 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3559
3560 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD, CLASS_ATOMIC,
3561 BT_UNKNOWN, 0, GFC_STD_F2018,
3562 gfc_check_atomic_fetch_op, NULL, NULL,
3563 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3564 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3565 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3566 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3567
3568 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND, CLASS_ATOMIC,
3569 BT_UNKNOWN, 0, GFC_STD_F2018,
3570 gfc_check_atomic_fetch_op, NULL, NULL,
3571 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3572 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3573 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3574 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3575
3576 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR, CLASS_ATOMIC,
3577 BT_UNKNOWN, 0, GFC_STD_F2018,
3578 gfc_check_atomic_fetch_op, NULL, NULL,
3579 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3580 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3581 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3582 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3583
3584 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR, CLASS_ATOMIC,
3585 BT_UNKNOWN, 0, GFC_STD_F2018,
3586 gfc_check_atomic_fetch_op, NULL, NULL,
3587 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3588 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3589 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3590 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3591
3592 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
3593
3594 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3595 GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
3596 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
3597
3598 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY, CLASS_ATOMIC,
3599 BT_UNKNOWN, 0, GFC_STD_F2018,
3600 gfc_check_event_query, NULL, gfc_resolve_event_query,
3601 "event", BT_INTEGER, di, REQUIRED, INTENT_IN,
3602 c, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3603 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3604
3605 /* More G77 compatibility garbage. */
3606 add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3607 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
3608 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3609 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3610
3611 add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3612 gfc_check_itime_idate, NULL, gfc_resolve_idate,
3613 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
3614
3615 add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3616 gfc_check_itime_idate, NULL, gfc_resolve_itime,
3617 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
3618
3619 add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3620 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
3621 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3622 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
3623
3624 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3625 GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
3626 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3627 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
3628
3629 add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
3630 GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
3631 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
3632
3633 add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3634 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
3635 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3636 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3637
3638 add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3639 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
3640 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3641 md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3642 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3643
3644 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
3645 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
3646 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3647 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3648 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3649 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3650
3651 /* More G77 compatibility garbage. */
3652 add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3653 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
3654 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3655 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
3656
3657 add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3658 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
3659 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3660 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
3661
3662 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
3663 CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
3664 NULL, NULL, gfc_resolve_execute_command_line,
3665 "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3666 "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
3667 "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
3668 "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3669 "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3670
3671 add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3672 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
3673 dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3674
3675 add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
3676 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
3677 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3678
3679 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
3680 GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
3681 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3682 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3683
3684 add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
3685 0, GFC_STD_GNU, NULL, NULL, NULL,
3686 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3687 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3688
3689 add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
3690 0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
3691 pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
3692 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3693
3694 add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
3695 0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
3696 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3697
3698 /* F2003 commandline routines. */
3699
3700 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
3701 BT_UNKNOWN, 0, GFC_STD_F2003,
3702 NULL, NULL, gfc_resolve_get_command,
3703 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3704 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3705 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3706
3707 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
3708 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
3709 gfc_resolve_get_command_argument,
3710 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3711 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3712 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3713 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3714
3715 /* F2003 subroutine to get environment variables. */
3716
3717 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
3718 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
3719 NULL, NULL, gfc_resolve_get_environment_variable,
3720 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3721 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3722 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3723 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3724 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
3725
3726 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
3727 GFC_STD_F2003,
3728 gfc_check_move_alloc, NULL, NULL,
3729 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
3730 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
3731
3732 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
3733 GFC_STD_F95, gfc_check_mvbits, NULL, gfc_resolve_mvbits,
3734 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
3735 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
3736 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
3737 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3738 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
3739
3740 if (flag_dec_intrinsic_ints)
3741 {
3742 make_alias ("bmvbits", GFC_STD_GNU);
3743 make_alias ("imvbits", GFC_STD_GNU);
3744 make_alias ("jmvbits", GFC_STD_GNU);
3745 make_alias ("kmvbits", GFC_STD_GNU);
3746 }
3747
3748 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
3749 BT_UNKNOWN, 0, GFC_STD_F2018,
3750 gfc_check_random_init, NULL, gfc_resolve_random_init,
3751 "repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN,
3752 "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
3753
3754 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
3755 BT_UNKNOWN, 0, GFC_STD_F95,
3756 gfc_check_random_number, NULL, gfc_resolve_random_number,
3757 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
3758
3759 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
3760 BT_UNKNOWN, 0, GFC_STD_F95,
3761 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
3762 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3763 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3764 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3765
3766 /* The following subroutines are part of ISO_C_BINDING. */
3767
3768 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
3769 GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
3770 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3771 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
3772 "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
3773 make_from_module();
3774
3775 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
3776 BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
3777 NULL, NULL,
3778 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3779 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
3780 make_from_module();
3781
3782 /* Internal subroutine for emitting a runtime error. */
3783
3784 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR, CLASS_IMPURE,
3785 BT_UNKNOWN, 0, GFC_STD_GNU,
3786 gfc_check_fe_runtime_error, NULL, gfc_resolve_fe_runtime_error,
3787 "msg", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
3788
3789 make_noreturn ();
3790 make_vararg ();
3791 make_from_module ();
3792
3793 /* Coarray collectives. */
3794 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST, CLASS_IMPURE,
3795 BT_UNKNOWN, 0, GFC_STD_F2018,
3796 gfc_check_co_broadcast, NULL, NULL,
3797 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3798 "source_image", BT_INTEGER, di, REQUIRED, INTENT_IN,
3799 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3800 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3801
3802 add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
3803 BT_UNKNOWN, 0, GFC_STD_F2018,
3804 gfc_check_co_minmax, NULL, NULL,
3805 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3806 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3807 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3808 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3809
3810 add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
3811 BT_UNKNOWN, 0, GFC_STD_F2018,
3812 gfc_check_co_minmax, NULL, NULL,
3813 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3814 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3815 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3816 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3817
3818 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
3819 BT_UNKNOWN, 0, GFC_STD_F2018,
3820 gfc_check_co_sum, NULL, NULL,
3821 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3822 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3823 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3824 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3825
3826 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE, CLASS_IMPURE,
3827 BT_UNKNOWN, 0, GFC_STD_F2018,
3828 gfc_check_co_reduce, NULL, NULL,
3829 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3830 "operation", BT_INTEGER, di, REQUIRED, INTENT_IN,
3831 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3832 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3833 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3834
3835
3836 /* The following subroutine is internally used for coarray libray functions.
3837 "make_from_module" makes it inaccessible for external users. */
3838 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
3839 BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
3840 "x", BT_REAL, dr, REQUIRED, INTENT_OUT,
3841 "y", BT_REAL, dr, REQUIRED, INTENT_IN);
3842 make_from_module();
3843
3844
3845 /* More G77 compatibility garbage. */
3846 add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3847 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
3848 sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
3849 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3850 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3851
3852 add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
3853 di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
3854 "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
3855
3856 add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3857 gfc_check_exit, NULL, gfc_resolve_exit,
3858 st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
3859
3860 make_noreturn();
3861
3862 add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3863 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
3864 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3865 c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3866 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3867
3868 add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3869 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
3870 c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3871 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3872
3873 add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3874 gfc_check_flush, NULL, gfc_resolve_flush,
3875 ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
3876
3877 add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3878 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
3879 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3880 c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3881 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3882
3883 add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3884 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
3885 c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3886 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3887
3888 add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3889 gfc_check_free, NULL, NULL,
3890 ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
3891
3892 add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3893 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
3894 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3895 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
3896 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
3897 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3898
3899 add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3900 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
3901 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3902 of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
3903
3904 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
3905 GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
3906 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3907 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3908
3909 add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3910 gfc_check_kill_sub, NULL, NULL,
3911 pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
3912 sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
3913 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3914
3915 add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3916 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
3917 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3918 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3919 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3920
3921 add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
3922 0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
3923 "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
3924
3925 add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
3926 GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
3927 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3928 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3929 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3930
3931 add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3932 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
3933 sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
3934
3935 add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3936 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
3937 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3938 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3939 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3940
3941 add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3942 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
3943 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3944 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3945 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3946
3947 add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3948 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
3949 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3950 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3951 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3952
3953 add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
3954 GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
3955 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3956 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3957 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3958
3959 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3960 GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
3961 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3962 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3963 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3964
3965 add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
3966 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
3967 com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3968 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3969
3970 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
3971 BT_UNKNOWN, 0, GFC_STD_F95,
3972 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
3973 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3974 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3975 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3976
3977 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
3978 GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
3979 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3980 name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3981
3982 add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3983 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
3984 msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
3985 old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3986
3987 add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3988 GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
3989 "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3990 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3991 }
3992
3993
3994 /* Add a function to the list of conversion symbols. */
3995
3996 static void
3997 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
3998 {
3999 gfc_typespec from, to;
4000 gfc_intrinsic_sym *sym;
4001
4002 if (sizing == SZ_CONVS)
4003 {
4004 nconv++;
4005 return;
4006 }
4007
4008 gfc_clear_ts (&from);
4009 from.type = from_type;
4010 from.kind = from_kind;
4011
4012 gfc_clear_ts (&to);
4013 to.type = to_type;
4014 to.kind = to_kind;
4015
4016 sym = conversion + nconv;
4017
4018 sym->name = conv_name (&from, &to);
4019 sym->lib_name = sym->name;
4020 sym->simplify.cc = gfc_convert_constant;
4021 sym->standard = standard;
4022 sym->elemental = 1;
4023 sym->pure = 1;
4024 sym->conversion = 1;
4025 sym->ts = to;
4026 sym->id = GFC_ISYM_CONVERSION;
4027
4028 nconv++;
4029 }
4030
4031
4032 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
4033 functions by looping over the kind tables. */
4034
4035 static void
4036 add_conversions (void)
4037 {
4038 int i, j;
4039
4040 /* Integer-Integer conversions. */
4041 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4042 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
4043 {
4044 if (i == j)
4045 continue;
4046
4047 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4048 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
4049 }
4050
4051 /* Integer-Real/Complex conversions. */
4052 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4053 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
4054 {
4055 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4056 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
4057
4058 add_conv (BT_REAL, gfc_real_kinds[j].kind,
4059 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
4060
4061 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4062 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
4063
4064 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
4065 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
4066 }
4067
4068 if (flag_unsigned)
4069 {
4070 for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
4071 for (j = 0; gfc_unsigned_kinds[j].kind != 0; j++)
4072 if (i != j)
4073 add_conv (BT_UNSIGNED, gfc_unsigned_kinds[i].kind,
4074 BT_UNSIGNED, gfc_unsigned_kinds[j].kind, GFC_STD_GNU);
4075 }
4076
4077 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
4078 {
4079 /* Hollerith-Integer conversions. */
4080 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4081 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4082 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4083 /* Hollerith-Real conversions. */
4084 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4085 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4086 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4087 /* Hollerith-Complex conversions. */
4088 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4089 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4090 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4091
4092 /* Hollerith-Character conversions. */
4093 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
4094 gfc_default_character_kind, GFC_STD_LEGACY);
4095
4096 /* Hollerith-Logical conversions. */
4097 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
4098 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4099 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
4100 }
4101
4102 /* Real/Complex - Real/Complex conversions. */
4103 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4104 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
4105 {
4106 if (i != j)
4107 {
4108 add_conv (BT_REAL, gfc_real_kinds[i].kind,
4109 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
4110
4111 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
4112 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
4113 }
4114
4115 add_conv (BT_REAL, gfc_real_kinds[i].kind,
4116 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
4117
4118 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
4119 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
4120 }
4121
4122 /* Logical/Logical kind conversion. */
4123 for (i = 0; gfc_logical_kinds[i].kind; i++)
4124 for (j = 0; gfc_logical_kinds[j].kind; j++)
4125 {
4126 if (i == j)
4127 continue;
4128
4129 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
4130 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
4131 }
4132
4133 /* Integer-Logical and Logical-Integer conversions. */
4134 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
4135 for (i=0; gfc_integer_kinds[i].kind; i++)
4136 for (j=0; gfc_logical_kinds[j].kind; j++)
4137 {
4138 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4139 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
4140 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
4141 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4142 }
4143
4144 /* DEC legacy feature allows character conversions similar to Hollerith
4145 conversions - the character data will transferred on a byte by byte
4146 basis. */
4147 if (flag_dec_char_conversions)
4148 {
4149 /* Character-Integer conversions. */
4150 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4151 add_conv (BT_CHARACTER, gfc_default_character_kind,
4152 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4153 /* Character-Real conversions. */
4154 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4155 add_conv (BT_CHARACTER, gfc_default_character_kind,
4156 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4157 /* Character-Complex conversions. */
4158 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4159 add_conv (BT_CHARACTER, gfc_default_character_kind,
4160 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4161 /* Character-Logical conversions. */
4162 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
4163 add_conv (BT_CHARACTER, gfc_default_character_kind,
4164 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
4165 }
4166 }
4167
4168
4169 static void
4170 add_char_conversions (void)
4171 {
4172 int n, i, j;
4173
4174 /* Count possible conversions. */
4175 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4176 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4177 if (i != j)
4178 ncharconv++;
4179
4180 /* Allocate memory. */
4181 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
4182
4183 /* Add the conversions themselves. */
4184 n = 0;
4185 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4186 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4187 {
4188 gfc_typespec from, to;
4189
4190 if (i == j)
4191 continue;
4192
4193 gfc_clear_ts (&from);
4194 from.type = BT_CHARACTER;
4195 from.kind = gfc_character_kinds[i].kind;
4196
4197 gfc_clear_ts (&to);
4198 to.type = BT_CHARACTER;
4199 to.kind = gfc_character_kinds[j].kind;
4200
4201 char_conversions[n].name = conv_name (&from, &to);
4202 char_conversions[n].lib_name = char_conversions[n].name;
4203 char_conversions[n].simplify.cc = gfc_convert_char_constant;
4204 char_conversions[n].standard = GFC_STD_F2003;
4205 char_conversions[n].elemental = 1;
4206 char_conversions[n].pure = 1;
4207 char_conversions[n].conversion = 0;
4208 char_conversions[n].ts = to;
4209 char_conversions[n].id = GFC_ISYM_CONVERSION;
4210
4211 n++;
4212 }
4213 }
4214
4215
4216 /* Initialize the table of intrinsics. */
4217 void
4218 gfc_intrinsic_init_1 (void)
4219 {
4220 nargs = nfunc = nsub = nconv = 0;
4221
4222 /* Create a namespace to hold the resolved intrinsic symbols. */
4223 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
4224
4225 sizing = SZ_FUNCS;
4226 add_functions ();
4227 sizing = SZ_SUBS;
4228 add_subroutines ();
4229 sizing = SZ_CONVS;
4230 add_conversions ();
4231
4232 functions = XCNEWVAR (struct gfc_intrinsic_sym,
4233 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
4234 + sizeof (gfc_intrinsic_arg) * nargs);
4235
4236 next_sym = functions;
4237 subroutines = functions + nfunc;
4238
4239 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
4240
4241 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
4242
4243 sizing = SZ_NOTHING;
4244 nconv = 0;
4245
4246 add_functions ();
4247 add_subroutines ();
4248 add_conversions ();
4249
4250 /* Character conversion intrinsics need to be treated separately. */
4251 add_char_conversions ();
4252 }
4253
4254
4255 void
4256 gfc_intrinsic_done_1 (void)
4257 {
4258 free (functions);
4259 free (conversion);
4260 free (char_conversions);
4261 gfc_free_namespace (gfc_intrinsic_namespace);
4262 }
4263
4264
4265 /******** Subroutines to check intrinsic interfaces ***********/
4266
4267 /* Given a formal argument list, remove any NULL arguments that may
4268 have been left behind by a sort against some formal argument list. */
4269
4270 static void
4271 remove_nullargs (gfc_actual_arglist **ap)
4272 {
4273 gfc_actual_arglist *head, *tail, *next;
4274
4275 tail = NULL;
4276
4277 for (head = *ap; head; head = next)
4278 {
4279 next = head->next;
4280
4281 if (head->expr == NULL && !head->label)
4282 {
4283 head->next = NULL;
4284 gfc_free_actual_arglist (head);
4285 }
4286 else
4287 {
4288 if (tail == NULL)
4289 *ap = head;
4290 else
4291 tail->next = head;
4292
4293 tail = head;
4294 tail->next = NULL;
4295 }
4296 }
4297
4298 if (tail == NULL)
4299 *ap = NULL;
4300 }
4301
4302
4303 static void
4304 set_intrinsic_dummy_arg (gfc_dummy_arg *&dummy_arg,
4305 gfc_intrinsic_arg *intrinsic)
4306 {
4307 if (dummy_arg == NULL)
4308 dummy_arg = gfc_get_dummy_arg ();
4309
4310 dummy_arg->intrinsicness = GFC_INTRINSIC_DUMMY_ARG;
4311 dummy_arg->u.intrinsic = intrinsic;
4312 }
4313
4314
4315 /* Given an actual arglist and a formal arglist, sort the actual
4316 arglist so that its arguments are in a one-to-one correspondence
4317 with the format arglist. Arguments that are not present are given
4318 a blank gfc_actual_arglist structure. If something is obviously
4319 wrong (say, a missing required argument) we abort sorting and
4320 return false. */
4321
4322 static bool
4323 sort_actual (const char *name, gfc_actual_arglist **ap,
4324 gfc_intrinsic_arg *formal, locus *where)
4325 {
4326 gfc_actual_arglist *actual, *a;
4327 gfc_intrinsic_arg *f;
4328
4329 remove_nullargs (ap);
4330 actual = *ap;
4331
4332 auto_vec<gfc_intrinsic_arg *> dummy_args;
4333 auto_vec<gfc_actual_arglist *> ordered_actual_args;
4334
4335 for (f = formal; f; f = f->next)
4336 dummy_args.safe_push (f);
4337
4338 ordered_actual_args.safe_grow_cleared (dummy_args.length (),
4339 /* exact = */true);
4340
4341 f = formal;
4342 a = actual;
4343
4344 if (f == NULL && a == NULL) /* No arguments */
4345 return true;
4346
4347 /* ALLOCATED has two mutually exclusive keywords, but only one
4348 can be present at time and neither is optional. */
4349 if (strcmp (name, "allocated") == 0)
4350 {
4351 if (!a)
4352 {
4353 gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
4354 "allocatable entity", where);
4355 return false;
4356 }
4357
4358 if (a->name)
4359 {
4360 if (strcmp (a->name, "scalar") == 0)
4361 {
4362 if (a->next)
4363 goto whoops;
4364 if (a->expr->rank != 0)
4365 {
4366 gfc_error ("Scalar entity required at %L", &a->expr->where);
4367 return false;
4368 }
4369 return true;
4370 }
4371 else if (strcmp (a->name, "array") == 0)
4372 {
4373 if (a->next)
4374 goto whoops;
4375 if (a->expr->rank == 0)
4376 {
4377 gfc_error ("Array entity required at %L", &a->expr->where);
4378 return false;
4379 }
4380 return true;
4381 }
4382 else
4383 {
4384 gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
4385 a->name, name, &a->expr->where);
4386 return false;
4387 }
4388 }
4389 }
4390
4391 for (int i = 0;; i++)
4392 { /* Put the nonkeyword arguments in a 1:1 correspondence */
4393 if (f == NULL)
4394 break;
4395 if (a == NULL)
4396 goto optional;
4397
4398 if (a->name != NULL)
4399 goto keywords;
4400
4401 ordered_actual_args[i] = a;
4402
4403 f = f->next;
4404 a = a->next;
4405 }
4406
4407 if (a == NULL)
4408 goto do_sort;
4409
4410 whoops:
4411 gfc_error ("Too many arguments in call to %qs at %L", name, where);
4412 return false;
4413
4414 keywords:
4415 /* Associate the remaining actual arguments, all of which have
4416 to be keyword arguments. */
4417 for (; a; a = a->next)
4418 {
4419 int idx;
4420 FOR_EACH_VEC_ELT (dummy_args, idx, f)
4421 if (strcmp (a->name, f->name) == 0)
4422 break;
4423
4424 if (f == NULL)
4425 {
4426 if (a->name[0] == '%')
4427 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4428 "are not allowed in this context at %L", where);
4429 else
4430 gfc_error ("Cannot find keyword named %qs in call to %qs at %L",
4431 a->name, name, where);
4432 return false;
4433 }
4434
4435 if (ordered_actual_args[idx] != NULL)
4436 {
4437 gfc_error ("Argument %qs appears twice in call to %qs at %L",
4438 f->name, name, where);
4439 return false;
4440 }
4441 ordered_actual_args[idx] = a;
4442 }
4443
4444 optional:
4445 /* At this point, all unmatched formal args must be optional. */
4446 int idx;
4447 FOR_EACH_VEC_ELT (dummy_args, idx, f)
4448 {
4449 if (ordered_actual_args[idx] == NULL && f->optional == 0)
4450 {
4451 gfc_error ("Missing actual argument %qs in call to %qs at %L",
4452 f->name, name, where);
4453 return false;
4454 }
4455 }
4456
4457 do_sort:
4458 /* Using the formal argument list, string the actual argument list
4459 together in a way that corresponds with the formal list. */
4460 actual = NULL;
4461
4462 FOR_EACH_VEC_ELT (dummy_args, idx, f)
4463 {
4464 a = ordered_actual_args[idx];
4465 if (a && a->label != NULL)
4466 {
4467 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
4468 return false;
4469 }
4470
4471 if (a == NULL)
4472 a = gfc_get_actual_arglist ();
4473
4474 set_intrinsic_dummy_arg (a->associated_dummy, f);
4475
4476 if (actual == NULL)
4477 *ap = a;
4478 else
4479 actual->next = a;
4480
4481 actual = a;
4482 }
4483 actual->next = NULL; /* End the sorted argument list. */
4484
4485 return true;
4486 }
4487
4488
4489 /* Compare an actual argument list with an intrinsic's formal argument
4490 list. The lists are checked for agreement of type. We don't check
4491 for arrayness here. */
4492
4493 static bool
4494 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
4495 int error_flag)
4496 {
4497 gfc_actual_arglist *actual;
4498 gfc_intrinsic_arg *formal;
4499 int i;
4500
4501 formal = sym->formal;
4502 actual = *ap;
4503
4504 i = 0;
4505 for (; formal; formal = formal->next, actual = actual->next, i++)
4506 {
4507 gfc_typespec ts;
4508
4509 if (actual->expr == NULL)
4510 continue;
4511
4512 ts = formal->ts;
4513
4514 /* A kind of 0 means we don't check for kind. */
4515 if (ts.kind == 0)
4516 ts.kind = actual->expr->ts.kind;
4517
4518 if (!gfc_compare_types (&ts, &actual->expr->ts))
4519 {
4520 if (error_flag)
4521 gfc_error ("In call to %qs at %L, type mismatch in argument "
4522 "%qs; pass %qs to %qs", gfc_current_intrinsic,
4523 &actual->expr->where,
4524 gfc_current_intrinsic_arg[i]->name,
4525 gfc_typename (actual->expr),
4526 gfc_dummy_typename (&formal->ts));
4527 return false;
4528 }
4529
4530 /* F2018, p. 328: An argument to an intrinsic procedure other than
4531 ASSOCIATED, NULL, or PRESENT shall be a data object. An EXPR_NULL
4532 is not a data object. */
4533 if (actual->expr->expr_type == EXPR_NULL
4534 && (!(sym->id == GFC_ISYM_ASSOCIATED
4535 || sym->id == GFC_ISYM_NULL
4536 || sym->id == GFC_ISYM_PRESENT)))
4537 {
4538 gfc_invalid_null_arg (actual->expr);
4539 return false;
4540 }
4541
4542 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4543 if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
4544 {
4545 const char* context = (error_flag
4546 ? _("actual argument to INTENT = OUT/INOUT")
4547 : NULL);
4548
4549 /* No pointer arguments for intrinsics. */
4550 if (!gfc_check_vardef_context (actual->expr, false, false, false, context))
4551 return false;
4552 }
4553 }
4554
4555 return true;
4556 }
4557
4558
4559 /* Given a pointer to an intrinsic symbol and an expression node that
4560 represent the function call to that subroutine, figure out the type
4561 of the result. This may involve calling a resolution subroutine. */
4562
4563 static void
4564 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
4565 {
4566 gfc_expr *a1, *a2, *a3, *a4, *a5, *a6;
4567 gfc_actual_arglist *arg;
4568
4569 if (specific->resolve.f1 == NULL)
4570 {
4571 if (e->value.function.name == NULL)
4572 e->value.function.name = specific->lib_name;
4573
4574 if (e->ts.type == BT_UNKNOWN)
4575 e->ts = specific->ts;
4576 return;
4577 }
4578
4579 arg = e->value.function.actual;
4580
4581 /* Special case hacks for MIN and MAX. */
4582 if (specific->resolve.f1m == gfc_resolve_max
4583 || specific->resolve.f1m == gfc_resolve_min)
4584 {
4585 (*specific->resolve.f1m) (e, arg);
4586 return;
4587 }
4588
4589 if (arg == NULL)
4590 {
4591 (*specific->resolve.f0) (e);
4592 return;
4593 }
4594
4595 a1 = arg->expr;
4596 arg = arg->next;
4597
4598 if (arg == NULL)
4599 {
4600 (*specific->resolve.f1) (e, a1);
4601 return;
4602 }
4603
4604 a2 = arg->expr;
4605 arg = arg->next;
4606
4607 if (arg == NULL)
4608 {
4609 (*specific->resolve.f2) (e, a1, a2);
4610 return;
4611 }
4612
4613 a3 = arg->expr;
4614 arg = arg->next;
4615
4616 if (arg == NULL)
4617 {
4618 (*specific->resolve.f3) (e, a1, a2, a3);
4619 return;
4620 }
4621
4622 a4 = arg->expr;
4623 arg = arg->next;
4624
4625 if (arg == NULL)
4626 {
4627 (*specific->resolve.f4) (e, a1, a2, a3, a4);
4628 return;
4629 }
4630
4631 a5 = arg->expr;
4632 arg = arg->next;
4633
4634 if (arg == NULL)
4635 {
4636 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
4637 return;
4638 }
4639
4640 a6 = arg->expr;
4641 arg = arg->next;
4642
4643 if (arg == NULL)
4644 {
4645 (*specific->resolve.f6) (e, a1, a2, a3, a4, a5, a6);
4646 return;
4647 }
4648
4649 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4650 }
4651
4652
4653 /* Given an intrinsic symbol node and an expression node, call the
4654 simplification function (if there is one), perhaps replacing the
4655 expression with something simpler. We return false on an error
4656 of the simplification, true if the simplification worked, even
4657 if nothing has changed in the expression itself. */
4658
4659 static bool
4660 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
4661 {
4662 gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
4663 gfc_actual_arglist *arg;
4664 int old_errorcount = errorcount;
4665
4666 /* Max and min require special handling due to the variable number
4667 of args. */
4668 if (specific->simplify.f1 == gfc_simplify_min)
4669 {
4670 result = gfc_simplify_min (e);
4671 goto finish;
4672 }
4673
4674 if (specific->simplify.f1 == gfc_simplify_max)
4675 {
4676 result = gfc_simplify_max (e);
4677 goto finish;
4678 }
4679
4680 if (specific->simplify.f1 == NULL)
4681 {
4682 result = NULL;
4683 goto finish;
4684 }
4685
4686 arg = e->value.function.actual;
4687
4688 if (arg == NULL)
4689 {
4690 result = (*specific->simplify.f0) ();
4691 goto finish;
4692 }
4693
4694 a1 = arg->expr;
4695 arg = arg->next;
4696
4697 if (specific->simplify.cc == gfc_convert_constant
4698 || specific->simplify.cc == gfc_convert_char_constant)
4699 {
4700 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
4701 goto finish;
4702 }
4703
4704 if (arg == NULL)
4705 result = (*specific->simplify.f1) (a1);
4706 else
4707 {
4708 a2 = arg->expr;
4709 arg = arg->next;
4710
4711 if (arg == NULL)
4712 result = (*specific->simplify.f2) (a1, a2);
4713 else
4714 {
4715 a3 = arg->expr;
4716 arg = arg->next;
4717
4718 if (arg == NULL)
4719 result = (*specific->simplify.f3) (a1, a2, a3);
4720 else
4721 {
4722 a4 = arg->expr;
4723 arg = arg->next;
4724
4725 if (arg == NULL)
4726 result = (*specific->simplify.f4) (a1, a2, a3, a4);
4727 else
4728 {
4729 a5 = arg->expr;
4730 arg = arg->next;
4731
4732 if (arg == NULL)
4733 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
4734 else
4735 {
4736 a6 = arg->expr;
4737 arg = arg->next;
4738
4739 if (arg == NULL)
4740 result = (*specific->simplify.f6)
4741 (a1, a2, a3, a4, a5, a6);
4742 else
4743 gfc_internal_error
4744 ("do_simplify(): Too many args for intrinsic");
4745 }
4746 }
4747 }
4748 }
4749 }
4750
4751 finish:
4752 if (result == &gfc_bad_expr)
4753 {
4754 if (errorcount == old_errorcount
4755 && (!gfc_buffered_p () || !gfc_error_flag_test ()))
4756 gfc_error ("Cannot simplify expression at %L", &e->where);
4757 return false;
4758 }
4759
4760 if (result == NULL)
4761 resolve_intrinsic (specific, e); /* Must call at run-time */
4762 else
4763 {
4764 result->where = e->where;
4765 gfc_replace_expr (e, result);
4766 }
4767
4768 return true;
4769 }
4770
4771
4772 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4773 error messages. This subroutine returns false if a subroutine
4774 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4775 list cannot match any intrinsic. */
4776
4777 static void
4778 init_arglist (gfc_intrinsic_sym *isym)
4779 {
4780 gfc_intrinsic_arg *formal;
4781 int i;
4782
4783 gfc_current_intrinsic = isym->name;
4784
4785 i = 0;
4786 for (formal = isym->formal; formal; formal = formal->next)
4787 {
4788 if (i >= MAX_INTRINSIC_ARGS)
4789 gfc_internal_error ("init_arglist(): too many arguments");
4790 gfc_current_intrinsic_arg[i++] = formal;
4791 }
4792 }
4793
4794
4795 /* Given a pointer to an intrinsic symbol and an expression consisting
4796 of a function call, see if the function call is consistent with the
4797 intrinsic's formal argument list. Return true if the expression
4798 and intrinsic match, false otherwise. */
4799
4800 static bool
4801 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
4802 {
4803 gfc_actual_arglist *arg, **ap;
4804 bool t;
4805
4806 ap = &expr->value.function.actual;
4807
4808 init_arglist (specific);
4809
4810 /* Don't attempt to sort the argument list for min or max. */
4811 if (specific->check.f1m == gfc_check_min_max
4812 || specific->check.f1m == gfc_check_min_max_integer
4813 || specific->check.f1m == gfc_check_min_max_real
4814 || specific->check.f1m == gfc_check_min_max_double)
4815 {
4816 if (!do_ts29113_check (specific, *ap))
4817 return false;
4818 return (*specific->check.f1m) (*ap);
4819 }
4820
4821 if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
4822 return false;
4823
4824 if (!do_ts29113_check (specific, *ap))
4825 return false;
4826
4827 if (specific->check.f5ml == gfc_check_minloc_maxloc)
4828 /* This is special because we might have to reorder the argument list. */
4829 t = gfc_check_minloc_maxloc (*ap);
4830 else if (specific->check.f6fl == gfc_check_findloc)
4831 t = gfc_check_findloc (*ap);
4832 else if (specific->check.f3red == gfc_check_minval_maxval)
4833 /* This is also special because we also might have to reorder the
4834 argument list. */
4835 t = gfc_check_minval_maxval (*ap);
4836 else if (specific->check.f3red == gfc_check_product_sum)
4837 /* Same here. The difference to the previous case is that we allow a
4838 general numeric type. */
4839 t = gfc_check_product_sum (*ap);
4840 else if (specific->check.f3red == gfc_check_transf_bit_intrins)
4841 /* Same as for PRODUCT and SUM, but different checks. */
4842 t = gfc_check_transf_bit_intrins (*ap);
4843 else
4844 {
4845 if (specific->check.f1 == NULL)
4846 {
4847 t = check_arglist (ap, specific, error_flag);
4848 if (t)
4849 expr->ts = specific->ts;
4850 }
4851 else
4852 t = do_check (specific, *ap);
4853 }
4854
4855 /* Check conformance of elemental intrinsics. */
4856 if (t && specific->elemental)
4857 {
4858 int n = 0;
4859 gfc_expr *first_expr;
4860 arg = expr->value.function.actual;
4861
4862 /* There is no elemental intrinsic without arguments. */
4863 gcc_assert(arg != NULL);
4864 first_expr = arg->expr;
4865
4866 for ( ; arg && arg->expr; arg = arg->next, n++)
4867 if (!gfc_check_conformance (first_expr, arg->expr,
4868 _("arguments '%s' and '%s' for "
4869 "intrinsic '%s'"),
4870 gfc_current_intrinsic_arg[0]->name,
4871 gfc_current_intrinsic_arg[n]->name,
4872 gfc_current_intrinsic))
4873 return false;
4874 }
4875
4876 if (!t)
4877 remove_nullargs (ap);
4878
4879 return t;
4880 }
4881
4882
4883 /* Check whether an intrinsic belongs to whatever standard the user
4884 has chosen, taking also into account -fall-intrinsics. Here, no
4885 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4886 textual representation of the symbols standard status (like
4887 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4888 can be used to construct a detailed warning/error message in case of
4889 a false. */
4890
4891 bool
4892 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
4893 const char** symstd, bool silent, locus where)
4894 {
4895 const char* symstd_msg;
4896
4897 /* For -fall-intrinsics, just succeed. */
4898 if (flag_all_intrinsics)
4899 return true;
4900
4901 /* Find the symbol's standard message for later usage. */
4902 switch (isym->standard)
4903 {
4904 case GFC_STD_F77:
4905 symstd_msg = _("available since Fortran 77");
4906 break;
4907
4908 case GFC_STD_F95_OBS:
4909 symstd_msg = _("obsolescent in Fortran 95");
4910 break;
4911
4912 case GFC_STD_F95_DEL:
4913 symstd_msg = _("deleted in Fortran 95");
4914 break;
4915
4916 case GFC_STD_F95:
4917 symstd_msg = _("new in Fortran 95");
4918 break;
4919
4920 case GFC_STD_F2003:
4921 symstd_msg = _("new in Fortran 2003");
4922 break;
4923
4924 case GFC_STD_F2008:
4925 symstd_msg = _("new in Fortran 2008");
4926 break;
4927
4928 case GFC_STD_F2018:
4929 symstd_msg = _("new in Fortran 2018");
4930 break;
4931
4932 case GFC_STD_F2023:
4933 symstd_msg = _("new in Fortran 2023");
4934 break;
4935
4936 case GFC_STD_GNU:
4937 symstd_msg = _("a GNU Fortran extension");
4938 break;
4939
4940 case GFC_STD_LEGACY:
4941 symstd_msg = _("for backward compatibility");
4942 break;
4943
4944 case GFC_STD_UNSIGNED:
4945 symstd_msg = _("unsigned");
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