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