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