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