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