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