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