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