projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
intrinsic.c (add_functions): New internal intrinsic function GFC_PREFIX ("stride").
[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 /* Obtain the stride for a given dimensions; to be used only internally.
2644 "make_from_module" makes inaccessible for external users. */
2645 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
2646 BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
2647 NULL, NULL, gfc_resolve_stride,
2648 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2649 make_from_module();
2650
2651 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2652 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2653 x, BT_UNKNOWN, 0, REQUIRED);
2654
2655 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2656
2657 /* C_SIZEOF is part of ISO_C_BINDING. */
2658 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
2659 BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
2660 x, BT_UNKNOWN, 0, REQUIRED);
2661 make_from_module();
2662
2663 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
2664 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
2665 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
2666 NULL, gfc_simplify_compiler_options, NULL);
2667 make_from_module();
2668
2669 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
2670 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
2671 NULL, gfc_simplify_compiler_version, NULL);
2672 make_from_module();
2673
2674 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2675 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2676 x, BT_REAL, dr, REQUIRED);
2677
2678 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2679
2680 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2681 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2682 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2683 ncopies, BT_INTEGER, di, REQUIRED);
2684
2685 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2686
2687 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2688 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2689 x, BT_REAL, dr, REQUIRED);
2690
2691 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2692 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2693 x, BT_REAL, dd, REQUIRED);
2694
2695 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2696 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2697 x, BT_COMPLEX, dz, REQUIRED);
2698
2699 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2700 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2701 x, BT_COMPLEX, dd, REQUIRED);
2702
2703 make_alias ("cdsqrt", GFC_STD_GNU);
2704
2705 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2706
2707 add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
2708 BT_INTEGER, di, GFC_STD_GNU,
2709 gfc_check_stat, NULL, gfc_resolve_stat,
2710 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2711 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
2712
2713 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2714
2715 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2716 BT_INTEGER, di, GFC_STD_F2008,
2717 gfc_check_storage_size, NULL, gfc_resolve_storage_size,
2718 a, BT_UNKNOWN, 0, REQUIRED,
2719 kind, BT_INTEGER, di, OPTIONAL);
2720
2721 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2722 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2723 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2724 msk, BT_LOGICAL, dl, OPTIONAL);
2725
2726 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2727
2728 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2729 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2730 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2731
2732 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2733
2734 add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2735 GFC_STD_GNU, NULL, NULL, NULL,
2736 com, BT_CHARACTER, dc, REQUIRED);
2737
2738 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2739
2740 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2741 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2742 x, BT_REAL, dr, REQUIRED);
2743
2744 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2745 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2746 x, BT_REAL, dd, REQUIRED);
2747
2748 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2749
2750 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2751 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2752 x, BT_REAL, dr, REQUIRED);
2753
2754 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2755 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2756 x, BT_REAL, dd, REQUIRED);
2757
2758 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2759
2760 add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2761 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
2762 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2763
2764 add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2765 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
2766
2767 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2768
2769 add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2770 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
2771
2772 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2773
2774 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2775 gfc_check_x, gfc_simplify_tiny, NULL,
2776 x, BT_REAL, dr, REQUIRED);
2777
2778 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2779
2780 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2781 BT_INTEGER, di, GFC_STD_F2008,
2782 gfc_check_i, gfc_simplify_trailz, NULL,
2783 i, BT_INTEGER, di, REQUIRED);
2784
2785 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2786
2787 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2788 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2789 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2790 sz, BT_INTEGER, di, OPTIONAL);
2791
2792 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2793
2794 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2795 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2796 m, BT_REAL, dr, REQUIRED);
2797
2798 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2799
2800 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2801 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2802 stg, BT_CHARACTER, dc, REQUIRED);
2803
2804 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2805
2806 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
2807 0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2808 ut, BT_INTEGER, di, REQUIRED);
2809
2810 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2811
2812 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2813 BT_INTEGER, di, GFC_STD_F95,
2814 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2815 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2816 kind, BT_INTEGER, di, OPTIONAL);
2817
2818 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2819
2820 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2821 BT_INTEGER, di, GFC_STD_F2008,
2822 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2823 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2824 kind, BT_INTEGER, di, OPTIONAL);
2825
2826 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
2827
2828 /* g77 compatibility for UMASK. */
2829 add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2830 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2831 msk, BT_INTEGER, di, REQUIRED);
2832
2833 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2834
2835 /* g77 compatibility for UNLINK. */
2836 add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2837 di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
2838 "path", BT_CHARACTER, dc, REQUIRED);
2839
2840 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2841
2842 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2843 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2844 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2845 f, BT_REAL, dr, REQUIRED);
2846
2847 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2848
2849 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2850 BT_INTEGER, di, GFC_STD_F95,
2851 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2852 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2853 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2854
2855 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2856
2857 add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2858 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2859 x, BT_UNKNOWN, 0, REQUIRED);
2860
2861 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2862 }
2863
2864
2865 /* Add intrinsic subroutines. */
2866
2867 static void
2868 add_subroutines (void)
2869 {
2870 /* Argument names as in the standard (to be used as argument keywords). */
2871 const char
2872 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2873 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2874 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2875 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2876 *com = "command", *length = "length", *st = "status",
2877 *val = "value", *num = "number", *name = "name",
2878 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2879 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2880 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2881 *p2 = "path2", *msk = "mask", *old = "old";
2882
2883 int di, dr, dc, dl, ii;
2884
2885 di = gfc_default_integer_kind;
2886 dr = gfc_default_real_kind;
2887 dc = gfc_default_character_kind;
2888 dl = gfc_default_logical_kind;
2889 ii = gfc_index_integer_kind;
2890
2891 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2892
2893 make_noreturn();
2894
2895 add_sym_2s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
2896 BT_UNKNOWN, 0, GFC_STD_F2008,
2897 gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
2898 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
2899 "value", BT_INTEGER, di, REQUIRED, INTENT_IN);
2900
2901 add_sym_2s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
2902 BT_UNKNOWN, 0, GFC_STD_F2008,
2903 gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
2904 "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
2905 "atom", BT_INTEGER, di, REQUIRED, INTENT_IN);
2906
2907 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
2908
2909 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
2910 GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2911 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2912
2913 /* More G77 compatibility garbage. */
2914 add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2915 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2916 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
2917 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
2918
2919 add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2920 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2921 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
2922
2923 add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2924 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2925 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
2926
2927 add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2928 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2929 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
2930 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
2931
2932 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
2933 GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2934 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
2935 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
2936
2937 add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
2938 GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2939 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2940
2941 add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2942 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2943 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2944 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2945
2946 add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2947 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2948 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2949 md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2950 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2951
2952 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
2953 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2954 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2955 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2956 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2957 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2958
2959 /* More G77 compatibility garbage. */
2960 add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2961 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2962 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
2963 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2964
2965 add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2966 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2967 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
2968 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2969
2970 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
2971 CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
2972 NULL, NULL, gfc_resolve_execute_command_line,
2973 "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2974 "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
2975 "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
2976 "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2977 "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
2978
2979 add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2980 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2981 dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
2982
2983 add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
2984 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
2985 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
2986
2987 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
2988 GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2989 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
2990 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2991
2992 add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
2993 0, GFC_STD_GNU, NULL, NULL, NULL,
2994 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2995 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
2996
2997 add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
2998 0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
2999 pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
3000 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3001
3002 add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
3003 0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
3004 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3005
3006 /* F2003 commandline routines. */
3007
3008 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
3009 BT_UNKNOWN, 0, GFC_STD_F2003,
3010 NULL, NULL, gfc_resolve_get_command,
3011 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3012 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3013 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3014
3015 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
3016 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
3017 gfc_resolve_get_command_argument,
3018 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3019 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3020 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3021 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3022
3023 /* F2003 subroutine to get environment variables. */
3024
3025 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
3026 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
3027 NULL, NULL, gfc_resolve_get_environment_variable,
3028 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3029 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3030 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3031 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3032 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
3033
3034 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
3035 GFC_STD_F2003,
3036 gfc_check_move_alloc, NULL, NULL,
3037 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
3038 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
3039
3040 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
3041 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
3042 gfc_resolve_mvbits,
3043 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
3044 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
3045 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
3046 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3047 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
3048
3049 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
3050 BT_UNKNOWN, 0, GFC_STD_F95,
3051 gfc_check_random_number, NULL, gfc_resolve_random_number,
3052 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
3053
3054 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
3055 BT_UNKNOWN, 0, GFC_STD_F95,
3056 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
3057 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3058 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3059 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3060
3061 /* More G77 compatibility garbage. */
3062 add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3063 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
3064 sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
3065 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3066 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3067
3068 add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
3069 di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
3070 "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
3071
3072 add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3073 gfc_check_exit, NULL, gfc_resolve_exit,
3074 st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
3075
3076 make_noreturn();
3077
3078 add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3079 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
3080 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3081 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3082 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3083
3084 add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3085 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
3086 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3087 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3088
3089 add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3090 gfc_check_flush, NULL, gfc_resolve_flush,
3091 ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
3092
3093 add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3094 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
3095 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3096 c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3097 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3098
3099 add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3100 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
3101 c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3102 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3103
3104 add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3105 gfc_check_free, NULL, gfc_resolve_free,
3106 ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
3107
3108 add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3109 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
3110 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3111 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
3112 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
3113 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3114
3115 add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3116 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
3117 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3118 of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
3119
3120 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
3121 GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
3122 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3123 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3124
3125 add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3126 gfc_check_kill_sub, NULL, gfc_resolve_kill_sub,
3127 c, BT_INTEGER, di, REQUIRED, INTENT_IN,
3128 val, BT_INTEGER, di, REQUIRED, INTENT_IN,
3129 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3130
3131 add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3132 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
3133 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3134 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3135 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3136
3137 add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
3138 0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
3139 "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
3140
3141 add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
3142 GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
3143 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3144 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3145 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3146
3147 add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3148 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
3149 sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
3150
3151 add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3152 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
3153 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3154 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3155 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3156
3157 add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3158 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
3159 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3160 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3161 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3162
3163 add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3164 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
3165 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3166 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3167 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3168
3169 add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
3170 GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
3171 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3172 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3173 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3174
3175 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3176 GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
3177 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3178 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3179 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3180
3181 add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
3182 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
3183 com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3184 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3185
3186 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
3187 BT_UNKNOWN, 0, GFC_STD_F95,
3188 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
3189 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3190 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3191 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3192
3193 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
3194 GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
3195 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3196 name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
3197
3198 add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3199 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
3200 msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
3201 old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3202
3203 add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3204 GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
3205 "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3206 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3207 }
3208
3209
3210 /* Add a function to the list of conversion symbols. */
3211
3212 static void
3213 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
3214 {
3215 gfc_typespec from, to;
3216 gfc_intrinsic_sym *sym;
3217
3218 if (sizing == SZ_CONVS)
3219 {
3220 nconv++;
3221 return;
3222 }
3223
3224 gfc_clear_ts (&from);
3225 from.type = from_type;
3226 from.kind = from_kind;
3227
3228 gfc_clear_ts (&to);
3229 to.type = to_type;
3230 to.kind = to_kind;
3231
3232 sym = conversion + nconv;
3233
3234 sym->name = conv_name (&from, &to);
3235 sym->lib_name = sym->name;
3236 sym->simplify.cc = gfc_convert_constant;
3237 sym->standard = standard;
3238 sym->elemental = 1;
3239 sym->pure = 1;
3240 sym->conversion = 1;
3241 sym->ts = to;
3242 sym->id = GFC_ISYM_CONVERSION;
3243
3244 nconv++;
3245 }
3246
3247
3248 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3249 functions by looping over the kind tables. */
3250
3251 static void
3252 add_conversions (void)
3253 {
3254 int i, j;
3255
3256 /* Integer-Integer conversions. */
3257 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3258 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
3259 {
3260 if (i == j)
3261 continue;
3262
3263 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3264 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
3265 }
3266
3267 /* Integer-Real/Complex conversions. */
3268 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3269 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3270 {
3271 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3272 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3273
3274 add_conv (BT_REAL, gfc_real_kinds[j].kind,
3275 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3276
3277 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3278 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3279
3280 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3281 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3282 }
3283
3284 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3285 {
3286 /* Hollerith-Integer conversions. */
3287 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3288 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3289 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3290 /* Hollerith-Real conversions. */
3291 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3292 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3293 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3294 /* Hollerith-Complex conversions. */
3295 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3296 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3297 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3298
3299 /* Hollerith-Character conversions. */
3300 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3301 gfc_default_character_kind, GFC_STD_LEGACY);
3302
3303 /* Hollerith-Logical conversions. */
3304 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3305 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3306 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3307 }
3308
3309 /* Real/Complex - Real/Complex conversions. */
3310 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3311 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3312 {
3313 if (i != j)
3314 {
3315 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3316 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3317
3318 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3319 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3320 }
3321
3322 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3323 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3324
3325 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3326 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3327 }
3328
3329 /* Logical/Logical kind conversion. */
3330 for (i = 0; gfc_logical_kinds[i].kind; i++)
3331 for (j = 0; gfc_logical_kinds[j].kind; j++)
3332 {
3333 if (i == j)
3334 continue;
3335
3336 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3337 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3338 }
3339
3340 /* Integer-Logical and Logical-Integer conversions. */
3341 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3342 for (i=0; gfc_integer_kinds[i].kind; i++)
3343 for (j=0; gfc_logical_kinds[j].kind; j++)
3344 {
3345 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3346 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3347 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3348 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3349 }
3350 }
3351
3352
3353 static void
3354 add_char_conversions (void)
3355 {
3356 int n, i, j;
3357
3358 /* Count possible conversions. */
3359 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3360 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3361 if (i != j)
3362 ncharconv++;
3363
3364 /* Allocate memory. */
3365 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3366
3367 /* Add the conversions themselves. */
3368 n = 0;
3369 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3370 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3371 {
3372 gfc_typespec from, to;
3373
3374 if (i == j)
3375 continue;
3376
3377 gfc_clear_ts (&from);
3378 from.type = BT_CHARACTER;
3379 from.kind = gfc_character_kinds[i].kind;
3380
3381 gfc_clear_ts (&to);
3382 to.type = BT_CHARACTER;
3383 to.kind = gfc_character_kinds[j].kind;
3384
3385 char_conversions[n].name = conv_name (&from, &to);
3386 char_conversions[n].lib_name = char_conversions[n].name;
3387 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3388 char_conversions[n].standard = GFC_STD_F2003;
3389 char_conversions[n].elemental = 1;
3390 char_conversions[n].pure = 1;
3391 char_conversions[n].conversion = 0;
3392 char_conversions[n].ts = to;
3393 char_conversions[n].id = GFC_ISYM_CONVERSION;
3394
3395 n++;
3396 }
3397 }
3398
3399
3400 /* Initialize the table of intrinsics. */
3401 void
3402 gfc_intrinsic_init_1 (void)
3403 {
3404 nargs = nfunc = nsub = nconv = 0;
3405
3406 /* Create a namespace to hold the resolved intrinsic symbols. */
3407 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3408
3409 sizing = SZ_FUNCS;
3410 add_functions ();
3411 sizing = SZ_SUBS;
3412 add_subroutines ();
3413 sizing = SZ_CONVS;
3414 add_conversions ();
3415
3416 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3417 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3418 + sizeof (gfc_intrinsic_arg) * nargs);
3419
3420 next_sym = functions;
3421 subroutines = functions + nfunc;
3422
3423 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3424
3425 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3426
3427 sizing = SZ_NOTHING;
3428 nconv = 0;
3429
3430 add_functions ();
3431 add_subroutines ();
3432 add_conversions ();
3433
3434 /* Character conversion intrinsics need to be treated separately. */
3435 add_char_conversions ();
3436 }
3437
3438
3439 void
3440 gfc_intrinsic_done_1 (void)
3441 {
3442 free (functions);
3443 free (conversion);
3444 free (char_conversions);
3445 gfc_free_namespace (gfc_intrinsic_namespace);
3446 }
3447
3448
3449 /******** Subroutines to check intrinsic interfaces ***********/
3450
3451 /* Given a formal argument list, remove any NULL arguments that may
3452 have been left behind by a sort against some formal argument list. */
3453
3454 static void
3455 remove_nullargs (gfc_actual_arglist **ap)
3456 {
3457 gfc_actual_arglist *head, *tail, *next;
3458
3459 tail = NULL;
3460
3461 for (head = *ap; head; head = next)
3462 {
3463 next = head->next;
3464
3465 if (head->expr == NULL && !head->label)
3466 {
3467 head->next = NULL;
3468 gfc_free_actual_arglist (head);
3469 }
3470 else
3471 {
3472 if (tail == NULL)
3473 *ap = head;
3474 else
3475 tail->next = head;
3476
3477 tail = head;
3478 tail->next = NULL;
3479 }
3480 }
3481
3482 if (tail == NULL)
3483 *ap = NULL;
3484 }
3485
3486
3487 /* Given an actual arglist and a formal arglist, sort the actual
3488 arglist so that its arguments are in a one-to-one correspondence
3489 with the format arglist. Arguments that are not present are given
3490 a blank gfc_actual_arglist structure. If something is obviously
3491 wrong (say, a missing required argument) we abort sorting and
3492 return FAILURE. */
3493
3494 static gfc_try
3495 sort_actual (const char *name, gfc_actual_arglist **ap,
3496 gfc_intrinsic_arg *formal, locus *where)
3497 {
3498 gfc_actual_arglist *actual, *a;
3499 gfc_intrinsic_arg *f;
3500
3501 remove_nullargs (ap);
3502 actual = *ap;
3503
3504 for (f = formal; f; f = f->next)
3505 f->actual = NULL;
3506
3507 f = formal;
3508 a = actual;
3509
3510 if (f == NULL && a == NULL) /* No arguments */
3511 return SUCCESS;
3512
3513 for (;;)
3514 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3515 if (f == NULL)
3516 break;
3517 if (a == NULL)
3518 goto optional;
3519
3520 if (a->name != NULL)
3521 goto keywords;
3522
3523 f->actual = a;
3524
3525 f = f->next;
3526 a = a->next;
3527 }
3528
3529 if (a == NULL)
3530 goto do_sort;
3531
3532 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3533 return FAILURE;
3534
3535 keywords:
3536 /* Associate the remaining actual arguments, all of which have
3537 to be keyword arguments. */
3538 for (; a; a = a->next)
3539 {
3540 for (f = formal; f; f = f->next)
3541 if (strcmp (a->name, f->name) == 0)
3542 break;
3543
3544 if (f == NULL)
3545 {
3546 if (a->name[0] == '%')
3547 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3548 "are not allowed in this context at %L", where);
3549 else
3550 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3551 a->name, name, where);
3552 return FAILURE;
3553 }
3554
3555 if (f->actual != NULL)
3556 {
3557 gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3558 f->name, name, where);
3559 return FAILURE;
3560 }
3561
3562 f->actual = a;
3563 }
3564
3565 optional:
3566 /* At this point, all unmatched formal args must be optional. */
3567 for (f = formal; f; f = f->next)
3568 {
3569 if (f->actual == NULL && f->optional == 0)
3570 {
3571 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3572 f->name, name, where);
3573 return FAILURE;
3574 }
3575 }
3576
3577 do_sort:
3578 /* Using the formal argument list, string the actual argument list
3579 together in a way that corresponds with the formal list. */
3580 actual = NULL;
3581
3582 for (f = formal; f; f = f->next)
3583 {
3584 if (f->actual && f->actual->label != NULL && f->ts.type)
3585 {
3586 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3587 return FAILURE;
3588 }
3589
3590 if (f->actual == NULL)
3591 {
3592 a = gfc_get_actual_arglist ();
3593 a->missing_arg_type = f->ts.type;
3594 }
3595 else
3596 a = f->actual;
3597
3598 if (actual == NULL)
3599 *ap = a;
3600 else
3601 actual->next = a;
3602
3603 actual = a;
3604 }
3605 actual->next = NULL; /* End the sorted argument list. */
3606
3607 return SUCCESS;
3608 }
3609
3610
3611 /* Compare an actual argument list with an intrinsic's formal argument
3612 list. The lists are checked for agreement of type. We don't check
3613 for arrayness here. */
3614
3615 static gfc_try
3616 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3617 int error_flag)
3618 {
3619 gfc_actual_arglist *actual;
3620 gfc_intrinsic_arg *formal;
3621 int i;
3622
3623 formal = sym->formal;
3624 actual = *ap;
3625
3626 i = 0;
3627 for (; formal; formal = formal->next, actual = actual->next, i++)
3628 {
3629 gfc_typespec ts;
3630
3631 if (actual->expr == NULL)
3632 continue;
3633
3634 ts = formal->ts;
3635
3636 /* A kind of 0 means we don't check for kind. */
3637 if (ts.kind == 0)
3638 ts.kind = actual->expr->ts.kind;
3639
3640 if (!gfc_compare_types (&ts, &actual->expr->ts))
3641 {
3642 if (error_flag)
3643 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3644 "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
3645 gfc_current_intrinsic, &actual->expr->where,
3646 gfc_typename (&formal->ts),
3647 gfc_typename (&actual->expr->ts));
3648 return FAILURE;
3649 }
3650
3651 /* If the formal argument is INTENT([IN]OUT), check for definability. */
3652 if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
3653 {
3654 const char* context = (error_flag
3655 ? _("actual argument to INTENT = OUT/INOUT")
3656 : NULL);
3657
3658 /* No pointer arguments for intrinsics. */
3659 if (gfc_check_vardef_context (actual->expr, false, false, false,
3660 context) == FAILURE)
3661 return FAILURE;
3662 }
3663 }
3664
3665 return SUCCESS;
3666 }
3667
3668
3669 /* Given a pointer to an intrinsic symbol and an expression node that
3670 represent the function call to that subroutine, figure out the type
3671 of the result. This may involve calling a resolution subroutine. */
3672
3673 static void
3674 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3675 {
3676 gfc_expr *a1, *a2, *a3, *a4, *a5;
3677 gfc_actual_arglist *arg;
3678
3679 if (specific->resolve.f1 == NULL)
3680 {
3681 if (e->value.function.name == NULL)
3682 e->value.function.name = specific->lib_name;
3683
3684 if (e->ts.type == BT_UNKNOWN)
3685 e->ts = specific->ts;
3686 return;
3687 }
3688
3689 arg = e->value.function.actual;
3690
3691 /* Special case hacks for MIN and MAX. */
3692 if (specific->resolve.f1m == gfc_resolve_max
3693 || specific->resolve.f1m == gfc_resolve_min)
3694 {
3695 (*specific->resolve.f1m) (e, arg);
3696 return;
3697 }
3698
3699 if (arg == NULL)
3700 {
3701 (*specific->resolve.f0) (e);
3702 return;
3703 }
3704
3705 a1 = arg->expr;
3706 arg = arg->next;
3707
3708 if (arg == NULL)
3709 {
3710 (*specific->resolve.f1) (e, a1);
3711 return;
3712 }
3713
3714 a2 = arg->expr;
3715 arg = arg->next;
3716
3717 if (arg == NULL)
3718 {
3719 (*specific->resolve.f2) (e, a1, a2);
3720 return;
3721 }
3722
3723 a3 = arg->expr;
3724 arg = arg->next;
3725
3726 if (arg == NULL)
3727 {
3728 (*specific->resolve.f3) (e, a1, a2, a3);
3729 return;
3730 }
3731
3732 a4 = arg->expr;
3733 arg = arg->next;
3734
3735 if (arg == NULL)
3736 {
3737 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3738 return;
3739 }
3740
3741 a5 = arg->expr;
3742 arg = arg->next;
3743
3744 if (arg == NULL)
3745 {
3746 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3747 return;
3748 }
3749
3750 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3751 }
3752
3753
3754 /* Given an intrinsic symbol node and an expression node, call the
3755 simplification function (if there is one), perhaps replacing the
3756 expression with something simpler. We return FAILURE on an error
3757 of the simplification, SUCCESS if the simplification worked, even
3758 if nothing has changed in the expression itself. */
3759
3760 static gfc_try
3761 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3762 {
3763 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3764 gfc_actual_arglist *arg;
3765
3766 /* Max and min require special handling due to the variable number
3767 of args. */
3768 if (specific->simplify.f1 == gfc_simplify_min)
3769 {
3770 result = gfc_simplify_min (e);
3771 goto finish;
3772 }
3773
3774 if (specific->simplify.f1 == gfc_simplify_max)
3775 {
3776 result = gfc_simplify_max (e);
3777 goto finish;
3778 }
3779
3780 if (specific->simplify.f1 == NULL)
3781 {
3782 result = NULL;
3783 goto finish;
3784 }
3785
3786 arg = e->value.function.actual;
3787
3788 if (arg == NULL)
3789 {
3790 result = (*specific->simplify.f0) ();
3791 goto finish;
3792 }
3793
3794 a1 = arg->expr;
3795 arg = arg->next;
3796
3797 if (specific->simplify.cc == gfc_convert_constant
3798 || specific->simplify.cc == gfc_convert_char_constant)
3799 {
3800 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3801 goto finish;
3802 }
3803
3804 if (arg == NULL)
3805 result = (*specific->simplify.f1) (a1);
3806 else
3807 {
3808 a2 = arg->expr;
3809 arg = arg->next;
3810
3811 if (arg == NULL)
3812 result = (*specific->simplify.f2) (a1, a2);
3813 else
3814 {
3815 a3 = arg->expr;
3816 arg = arg->next;
3817
3818 if (arg == NULL)
3819 result = (*specific->simplify.f3) (a1, a2, a3);
3820 else
3821 {
3822 a4 = arg->expr;
3823 arg = arg->next;
3824
3825 if (arg == NULL)
3826 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3827 else
3828 {
3829 a5 = arg->expr;
3830 arg = arg->next;
3831
3832 if (arg == NULL)
3833 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3834 else
3835 gfc_internal_error
3836 ("do_simplify(): Too many args for intrinsic");
3837 }
3838 }
3839 }
3840 }
3841
3842 finish:
3843 if (result == &gfc_bad_expr)
3844 return FAILURE;
3845
3846 if (result == NULL)
3847 resolve_intrinsic (specific, e); /* Must call at run-time */
3848 else
3849 {
3850 result->where = e->where;
3851 gfc_replace_expr (e, result);
3852 }
3853
3854 return SUCCESS;
3855 }
3856
3857
3858 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3859 error messages. This subroutine returns FAILURE if a subroutine
3860 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3861 list cannot match any intrinsic. */
3862
3863 static void
3864 init_arglist (gfc_intrinsic_sym *isym)
3865 {
3866 gfc_intrinsic_arg *formal;
3867 int i;
3868
3869 gfc_current_intrinsic = isym->name;
3870
3871 i = 0;
3872 for (formal = isym->formal; formal; formal = formal->next)
3873 {
3874 if (i >= MAX_INTRINSIC_ARGS)
3875 gfc_internal_error ("init_arglist(): too many arguments");
3876 gfc_current_intrinsic_arg[i++] = formal;
3877 }
3878 }
3879
3880
3881 /* Given a pointer to an intrinsic symbol and an expression consisting
3882 of a function call, see if the function call is consistent with the
3883 intrinsic's formal argument list. Return SUCCESS if the expression
3884 and intrinsic match, FAILURE otherwise. */
3885
3886 static gfc_try
3887 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3888 {
3889 gfc_actual_arglist *arg, **ap;
3890 gfc_try t;
3891
3892 ap = &expr->value.function.actual;
3893
3894 init_arglist (specific);
3895
3896 /* Don't attempt to sort the argument list for min or max. */
3897 if (specific->check.f1m == gfc_check_min_max
3898 || specific->check.f1m == gfc_check_min_max_integer
3899 || specific->check.f1m == gfc_check_min_max_real
3900 || specific->check.f1m == gfc_check_min_max_double)
3901 return (*specific->check.f1m) (*ap);
3902
3903 if (sort_actual (specific->name, ap, specific->formal,
3904 &expr->where) == FAILURE)
3905 return FAILURE;
3906
3907 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3908 /* This is special because we might have to reorder the argument list. */
3909 t = gfc_check_minloc_maxloc (*ap);
3910 else if (specific->check.f3red == gfc_check_minval_maxval)
3911 /* This is also special because we also might have to reorder the
3912 argument list. */
3913 t = gfc_check_minval_maxval (*ap);
3914 else if (specific->check.f3red == gfc_check_product_sum)
3915 /* Same here. The difference to the previous case is that we allow a
3916 general numeric type. */
3917 t = gfc_check_product_sum (*ap);
3918 else if (specific->check.f3red == gfc_check_transf_bit_intrins)
3919 /* Same as for PRODUCT and SUM, but different checks. */
3920 t = gfc_check_transf_bit_intrins (*ap);
3921 else
3922 {
3923 if (specific->check.f1 == NULL)
3924 {
3925 t = check_arglist (ap, specific, error_flag);
3926 if (t == SUCCESS)
3927 expr->ts = specific->ts;
3928 }
3929 else
3930 t = do_check (specific, *ap);
3931 }
3932
3933 /* Check conformance of elemental intrinsics. */
3934 if (t == SUCCESS && specific->elemental)
3935 {
3936 int n = 0;
3937 gfc_expr *first_expr;
3938 arg = expr->value.function.actual;
3939
3940 /* There is no elemental intrinsic without arguments. */
3941 gcc_assert(arg != NULL);
3942 first_expr = arg->expr;
3943
3944 for ( ; arg && arg->expr; arg = arg->next, n++)
3945 if (gfc_check_conformance (first_expr, arg->expr,
3946 "arguments '%s' and '%s' for "
3947 "intrinsic '%s'",
3948 gfc_current_intrinsic_arg[0]->name,
3949 gfc_current_intrinsic_arg[n]->name,
3950 gfc_current_intrinsic) == FAILURE)
3951 return FAILURE;
3952 }
3953
3954 if (t == FAILURE)
3955 remove_nullargs (ap);
3956
3957 return t;
3958 }
3959
3960
3961 /* Check whether an intrinsic belongs to whatever standard the user
3962 has chosen, taking also into account -fall-intrinsics. Here, no
3963 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3964 textual representation of the symbols standard status (like
3965 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3966 can be used to construct a detailed warning/error message in case of
3967 a FAILURE. */
3968
3969 gfc_try
3970 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3971 const char** symstd, bool silent, locus where)
3972 {
3973 const char* symstd_msg;
3974
3975 /* For -fall-intrinsics, just succeed. */
3976 if (gfc_option.flag_all_intrinsics)
3977 return SUCCESS;
3978
3979 /* Find the symbol's standard message for later usage. */
3980 switch (isym->standard)
3981 {
3982 case GFC_STD_F77:
3983 symstd_msg = "available since Fortran 77";
3984 break;
3985
3986 case GFC_STD_F95_OBS:
3987 symstd_msg = "obsolescent in Fortran 95";
3988 break;
3989
3990 case GFC_STD_F95_DEL:
3991 symstd_msg = "deleted in Fortran 95";
3992 break;
3993
3994 case GFC_STD_F95:
3995 symstd_msg = "new in Fortran 95";
3996 break;
3997
3998 case GFC_STD_F2003:
3999 symstd_msg = "new in Fortran 2003";
4000 break;
4001
4002 case GFC_STD_F2008:
4003 symstd_msg = "new in Fortran 2008";
4004 break;
4005
4006 case GFC_STD_F2008_TS:
4007 symstd_msg = "new in TS 29113";
4008 break;
4009
4010 case GFC_STD_GNU:
4011 symstd_msg = "a GNU Fortran extension";
4012 break;
4013
4014 case GFC_STD_LEGACY:
4015 symstd_msg = "for backward compatibility";
4016 break;
4017
4018 default:
4019 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
4020 isym->name, isym->standard);
4021 }
4022
4023 /* If warning about the standard, warn and succeed. */
4024 if (gfc_option.warn_std & isym->standard)
4025 {
4026 /* Do only print a warning if not a GNU extension. */
4027 if (!silent && isym->standard != GFC_STD_GNU)
4028 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
4029 isym->name, _(symstd_msg), &where);
4030
4031 return SUCCESS;
4032 }
4033
4034 /* If allowing the symbol's standard, succeed, too. */
4035 if (gfc_option.allow_std & isym->standard)
4036 return SUCCESS;
4037
4038 /* Otherwise, fail. */
4039 if (symstd)
4040 *symstd = _(symstd_msg);
4041 return FAILURE;
4042 }
4043
4044
4045 /* See if a function call corresponds to an intrinsic function call.
4046 We return:
4047
4048 MATCH_YES if the call corresponds to an intrinsic, simplification
4049 is done if possible.
4050
4051 MATCH_NO if the call does not correspond to an intrinsic
4052
4053 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4054 error during the simplification process.
4055
4056 The error_flag parameter enables an error reporting. */
4057
4058 match
4059 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
4060 {
4061 gfc_intrinsic_sym *isym, *specific;
4062 gfc_actual_arglist *actual;
4063 const char *name;
4064 int flag;
4065
4066 if (expr->value.function.isym != NULL)
4067 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
4068 ? MATCH_ERROR : MATCH_YES;
4069
4070 if (!error_flag)
4071 gfc_push_suppress_errors ();
4072 flag = 0;
4073
4074 for (actual = expr->value.function.actual; actual; actual = actual->next)
4075 if (actual->expr != NULL)
4076 flag |= (actual->expr->ts.type != BT_INTEGER
4077 && actual->expr->ts.type != BT_CHARACTER);
4078
4079 name = expr->symtree->n.sym->name;
4080
4081 if (expr->symtree->n.sym->intmod_sym_id)
4082 {
4083 int id = expr->symtree->n.sym->intmod_sym_id;
4084 isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
4085 }
4086 else
4087 isym = specific = gfc_find_function (name);
4088
4089 if (isym == NULL)
4090 {
4091 if (!error_flag)
4092 gfc_pop_suppress_errors ();
4093 return MATCH_NO;
4094 }
4095
4096 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
4097 || isym->id == GFC_ISYM_CMPLX)
4098 && gfc_init_expr_flag
4099 && gfc_notify_std (GFC_STD_F2003, "Function '%s' "
4100 "as initialization expression at %L", name,
4101 &expr->where) == FAILURE)
4102 {
4103 if (!error_flag)
4104 gfc_pop_suppress_errors ();
4105 return MATCH_ERROR;
4106 }
4107
4108 gfc_current_intrinsic_where = &expr->where;
4109
4110 /* Bypass the generic list for min and max. */
4111 if (isym->check.f1m == gfc_check_min_max)
4112 {
4113 init_arglist (isym);
4114
4115 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
4116 goto got_specific;
4117
4118 if (!error_flag)
4119 gfc_pop_suppress_errors ();
4120 return MATCH_NO;
4121 }
4122
4123 /* If the function is generic, check all of its specific
4124 incarnations. If the generic name is also a specific, we check
4125 that name last, so that any error message will correspond to the
4126 specific. */
4127 gfc_push_suppress_errors ();
4128
4129 if (isym->generic)
4130 {
4131 for (specific = isym->specific_head; specific;
4132 specific = specific->next)
4133 {
4134 if (specific == isym)
4135 continue;
4136 if (check_specific (specific, expr, 0) == SUCCESS)
4137 {
4138 gfc_pop_suppress_errors ();
4139 goto got_specific;
4140 }
4141 }
4142 }
4143
4144 gfc_pop_suppress_errors ();
4145
4146 if (check_specific (isym, expr, error_flag) == FAILURE)
4147 {
4148 if (!error_flag)
4149 gfc_pop_suppress_errors ();
4150 return MATCH_NO;
4151 }
4152
4153 specific = isym;
4154
4155 got_specific:
4156 expr->value.function.isym = specific;
4157 gfc_intrinsic_symbol (expr->symtree->n.sym);
4158
4159 if (!error_flag)
4160 gfc_pop_suppress_errors ();
4161
4162 if (do_simplify (specific, expr) == FAILURE)
4163 return MATCH_ERROR;
4164
4165 /* F95, 7.1.6.1, Initialization expressions
4166 (4) An elemental intrinsic function reference of type integer or
4167 character where each argument is an initialization expression
4168 of type integer or character
4169
4170 F2003, 7.1.7 Initialization expression
4171 (4) A reference to an elemental standard intrinsic function,
4172 where each argument is an initialization expression */
4173
4174 if (gfc_init_expr_flag && isym->elemental && flag
4175 && gfc_notify_std (GFC_STD_F2003, "Elemental function "
4176 "as initialization expression with non-integer/non-"
4177 "character arguments at %L", &expr->where) == FAILURE)
4178 return MATCH_ERROR;
4179
4180 return MATCH_YES;
4181 }
4182
4183
4184 /* See if a CALL statement corresponds to an intrinsic subroutine.
4185 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4186 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4187 correspond). */
4188
4189 match
4190 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
4191 {
4192 gfc_intrinsic_sym *isym;
4193 const char *name;
4194
4195 name = c->symtree->n.sym->name;
4196
4197 isym = gfc_find_subroutine (name);
4198 if (isym == NULL)
4199 return MATCH_NO;
4200
4201 if (!error_flag)
4202 gfc_push_suppress_errors ();
4203
4204 init_arglist (isym);
4205
4206 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
4207 goto fail;
4208
4209 if (isym->check.f1 != NULL)
4210 {
4211 if (do_check (isym, c->ext.actual) == FAILURE)
4212 goto fail;
4213 }
4214 else
4215 {
4216 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
4217 goto fail;
4218 }
4219
4220 /* The subroutine corresponds to an intrinsic. Allow errors to be
4221 seen at this point. */
4222 if (!error_flag)
4223 gfc_pop_suppress_errors ();
4224
4225 c->resolved_isym = isym;
4226 if (isym->resolve.s1 != NULL)
4227 isym->resolve.s1 (c);
4228 else
4229 {
4230 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
4231 c->resolved_sym->attr.elemental = isym->elemental;
4232 }
4233
4234 if (gfc_pure (NULL) && !isym->pure)
4235 {
4236 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
4237 &c->loc);
4238 return MATCH_ERROR;
4239 }
4240
4241 c->resolved_sym->attr.noreturn = isym->noreturn;
4242
4243 return MATCH_YES;
4244
4245 fail:
4246 if (!error_flag)
4247 gfc_pop_suppress_errors ();
4248 return MATCH_NO;
4249 }
4250
4251
4252 /* Call gfc_convert_type() with warning enabled. */
4253
4254 gfc_try
4255 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
4256 {
4257 return gfc_convert_type_warn (expr, ts, eflag, 1);
4258 }
4259
4260
4261 /* Try to convert an expression (in place) from one type to another.
4262 'eflag' controls the behavior on error.
4263
4264 The possible values are:
4265
4266 1 Generate a gfc_error()
4267 2 Generate a gfc_internal_error().
4268
4269 'wflag' controls the warning related to conversion. */
4270
4271 gfc_try
4272 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
4273 {
4274 gfc_intrinsic_sym *sym;
4275 gfc_typespec from_ts;
4276 locus old_where;
4277 gfc_expr *new_expr;
4278 int rank;
4279 mpz_t *shape;
4280
4281 from_ts = expr->ts; /* expr->ts gets clobbered */
4282
4283 if (ts->type == BT_UNKNOWN)
4284 goto bad;
4285
4286 /* NULL and zero size arrays get their type here. */
4287 if (expr->expr_type == EXPR_NULL
4288 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
4289 {
4290 /* Sometimes the RHS acquire the type. */
4291 expr->ts = *ts;
4292 return SUCCESS;
4293 }
4294
4295 if (expr->ts.type == BT_UNKNOWN)
4296 goto bad;
4297
4298 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4299 && gfc_compare_types (&expr->ts, ts))
4300 return SUCCESS;
4301
4302 sym = find_conv (&expr->ts, ts);
4303 if (sym == NULL)
4304 goto bad;
4305
4306 /* At this point, a conversion is necessary. A warning may be needed. */
4307 if ((gfc_option.warn_std & sym->standard) != 0)
4308 {
4309 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4310 gfc_typename (&from_ts), gfc_typename (ts),
4311 &expr->where);
4312 }
4313 else if (wflag)
4314 {
4315 if (gfc_option.flag_range_check
4316 && expr->expr_type == EXPR_CONSTANT
4317 && from_ts.type == ts->type)
4318 {
4319 /* Do nothing. Constants of the same type are range-checked
4320 elsewhere. If a value too large for the target type is
4321 assigned, an error is generated. Not checking here avoids
4322 duplications of warnings/errors.
4323 If range checking was disabled, but -Wconversion enabled,
4324 a non range checked warning is generated below. */
4325 }
4326 else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4327 {
4328 /* Do nothing. This block exists only to simplify the other
4329 else-if expressions.
4330 LOGICAL <> LOGICAL no warning, independent of kind values
4331 LOGICAL <> INTEGER extension, warned elsewhere
4332 LOGICAL <> REAL invalid, error generated elsewhere
4333 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4334 }
4335 else if (from_ts.type == ts->type
4336 || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4337 || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4338 || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4339 {
4340 /* Larger kinds can hold values of smaller kinds without problems.
4341 Hence, only warn if target kind is smaller than the source
4342 kind - or if -Wconversion-extra is specified. */
4343 if (gfc_option.warn_conversion_extra)
4344 gfc_warning_now ("Conversion from %s to %s at %L",
4345 gfc_typename (&from_ts), gfc_typename (ts),
4346 &expr->where);
4347 else if (gfc_option.gfc_warn_conversion
4348 && from_ts.kind > ts->kind)
4349 gfc_warning_now ("Possible change of value in conversion "
4350 "from %s to %s at %L", gfc_typename (&from_ts),
4351 gfc_typename (ts), &expr->where);
4352 }
4353 else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4354 || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4355 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4356 {
4357 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4358 usually comes with a loss of information, regardless of kinds. */
4359 if (gfc_option.warn_conversion_extra
4360 || gfc_option.gfc_warn_conversion)
4361 gfc_warning_now ("Possible change of value in conversion "
4362 "from %s to %s at %L", gfc_typename (&from_ts),
4363 gfc_typename (ts), &expr->where);
4364 }
4365 else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4366 {
4367 /* If HOLLERITH is involved, all bets are off. */
4368 if (gfc_option.warn_conversion_extra
4369 || gfc_option.gfc_warn_conversion)
4370 gfc_warning_now ("Conversion from %s to %s at %L",
4371 gfc_typename (&from_ts), gfc_typename (ts),
4372 &expr->where);
4373 }
4374 else
4375 gcc_unreachable ();
4376 }
4377
4378 /* Insert a pre-resolved function call to the right function. */
4379 old_where = expr->where;
4380 rank = expr->rank;
4381 shape = expr->shape;
4382
4383 new_expr = gfc_get_expr ();
4384 *new_expr = *expr;
4385
4386 new_expr = gfc_build_conversion (new_expr);
4387 new_expr->value.function.name = sym->lib_name;
4388 new_expr->value.function.isym = sym;
4389 new_expr->where = old_where;
4390 new_expr->rank = rank;
4391 new_expr->shape = gfc_copy_shape (shape, rank);
4392
4393 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4394 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4395 new_expr->symtree->n.sym->ts = *ts;
4396 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4397 new_expr->symtree->n.sym->attr.function = 1;
4398 new_expr->symtree->n.sym->attr.elemental = 1;
4399 new_expr->symtree->n.sym->attr.pure = 1;
4400 new_expr->symtree->n.sym->attr.referenced = 1;
4401 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4402 gfc_commit_symbol (new_expr->symtree->n.sym);
4403
4404 *expr = *new_expr;
4405
4406 free (new_expr);
4407 expr->ts = *ts;
4408
4409 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4410 && do_simplify (sym, expr) == FAILURE)
4411 {
4412
4413 if (eflag == 2)
4414 goto bad;
4415 return FAILURE; /* Error already generated in do_simplify() */
4416 }
4417
4418 return SUCCESS;
4419
4420 bad:
4421 if (eflag == 1)
4422 {
4423 gfc_error ("Can't convert %s to %s at %L",
4424 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4425 return FAILURE;
4426 }
4427
4428 gfc_internal_error ("Can't convert %s to %s at %L",
4429 gfc_typename (&from_ts), gfc_typename (ts),
4430 &expr->where);
4431 /* Not reached */
4432 }
4433
4434
4435 gfc_try
4436 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4437 {
4438 gfc_intrinsic_sym *sym;
4439 locus old_where;
4440 gfc_expr *new_expr;
4441 int rank;
4442 mpz_t *shape;
4443
4444 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4445
4446 sym = find_char_conv (&expr->ts, ts);
4447 gcc_assert (sym);
4448
4449 /* Insert a pre-resolved function call to the right function. */
4450 old_where = expr->where;
4451 rank = expr->rank;
4452 shape = expr->shape;
4453
4454 new_expr = gfc_get_expr ();
4455 *new_expr = *expr;
4456
4457 new_expr = gfc_build_conversion (new_expr);
4458 new_expr->value.function.name = sym->lib_name;
4459 new_expr->value.function.isym = sym;
4460 new_expr->where = old_where;
4461 new_expr->rank = rank;
4462 new_expr->shape = gfc_copy_shape (shape, rank);
4463
4464 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4465 new_expr->symtree->n.sym->ts = *ts;
4466 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4467 new_expr->symtree->n.sym->attr.function = 1;
4468 new_expr->symtree->n.sym->attr.elemental = 1;
4469 new_expr->symtree->n.sym->attr.referenced = 1;
4470 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4471 gfc_commit_symbol (new_expr->symtree->n.sym);
4472
4473 *expr = *new_expr;
4474
4475 free (new_expr);
4476 expr->ts = *ts;
4477
4478 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4479 && do_simplify (sym, expr) == FAILURE)
4480 {
4481 /* Error already generated in do_simplify() */
4482 return FAILURE;
4483 }
4484
4485 return SUCCESS;
4486 }
4487
4488
4489 /* Check if the passed name is name of an intrinsic (taking into account the
4490 current -std=* and -fall-intrinsic settings). If it is, see if we should
4491 warn about this as a user-procedure having the same name as an intrinsic
4492 (-Wintrinsic-shadow enabled) and do so if we should. */
4493
4494 void
4495 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4496 {
4497 gfc_intrinsic_sym* isym;
4498
4499 /* If the warning is disabled, do nothing at all. */
4500 if (!gfc_option.warn_intrinsic_shadow)
4501 return;
4502
4503 /* Try to find an intrinsic of the same name. */
4504 if (func)
4505 isym = gfc_find_function (sym->name);
4506 else
4507 isym = gfc_find_subroutine (sym->name);
4508
4509 /* If no intrinsic was found with this name or it's not included in the
4510 selected standard, everything's fine. */
4511 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4512 sym->declared_at) == FAILURE)
4513 return;
4514
4515 /* Emit the warning. */
4516 if (in_module || sym->ns->proc_name)
4517 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4518 " name. In order to call the intrinsic, explicit INTRINSIC"
4519 " declarations may be required.",
4520 sym->name, &sym->declared_at);
4521 else
4522 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4523 " only be called via an explicit interface or if declared"
4524 " EXTERNAL.", sym->name, &sym->declared_at);
4525 }