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