projects / gcc.git / blob
? search:


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