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