projects / gcc.git / blob
? search:


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