?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merged trunk at revision 161680 into branch.
[official-gcc.git] / gcc / fortran / intrinsic.c
blob833fd30beb182f48ddb22a222b90d73eeb98fc95
1 /* Build up a list of intrinsic subroutines and functions for the
2 name-resolution stage.
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
4 2009, 2010
5 Free Software Foundation, Inc.
6 Contributed by Andy Vaught & Katherine Holcomb
7
8 This file is part of GCC.
9
10 GCC is free software; you can redistribute it and/or modify it under
11 the terms of the GNU General Public License as published by the Free
12 Software Foundation; either version 3, or (at your option) any later
13 version.
14
15 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
16 WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with GCC; see the file COPYING3. If not see
22 <http://www.gnu.org/licenses/>. */
23
24 #include "config.h"
25 #include "system.h"
26 #include "flags.h"
27 #include "gfortran.h"
28 #include "intrinsic.h"
29
30 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
31 static gfc_namespace *gfc_intrinsic_namespace;
32
33 bool gfc_init_expr_flag = false;
34
35 /* Pointers to an intrinsic function and its argument names that are being
36 checked. */
37
38 const char *gfc_current_intrinsic;
39 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
40 locus *gfc_current_intrinsic_where;
41
42 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
43 static gfc_intrinsic_sym *char_conversions;
44 static gfc_intrinsic_arg *next_arg;
45
46 static int nfunc, nsub, nargs, nconv, ncharconv;
47
48 static enum
49 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
50 sizing;
51
52 enum klass
53 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
54
55 #define ACTUAL_NO 0
56 #define ACTUAL_YES 1
57
58 #define REQUIRED 0
59 #define OPTIONAL 1
60
61
62 /* Return a letter based on the passed type. Used to construct the
63 name of a type-dependent subroutine. */
64
65 char
66 gfc_type_letter (bt type)
67 {
68 char c;
69
70 switch (type)
71 {
72 case BT_LOGICAL:
73 c = 'l';
74 break;
75 case BT_CHARACTER:
76 c = 's';
77 break;
78 case BT_INTEGER:
79 c = 'i';
80 break;
81 case BT_REAL:
82 c = 'r';
83 break;
84 case BT_COMPLEX:
85 c = 'c';
86 break;
87
88 case BT_HOLLERITH:
89 c = 'h';
90 break;
91
92 default:
93 c = 'u';
94 break;
95 }
96
97 return c;
98 }
99
100
101 /* Get a symbol for a resolved name. Note, if needed be, the elemental
102 attribute has be added afterwards. */
103
104 gfc_symbol *
105 gfc_get_intrinsic_sub_symbol (const char *name)
106 {
107 gfc_symbol *sym;
108
109 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
110 sym->attr.always_explicit = 1;
111 sym->attr.subroutine = 1;
112 sym->attr.flavor = FL_PROCEDURE;
113 sym->attr.proc = PROC_INTRINSIC;
114
115 return sym;
116 }
117
118
119 /* Return a pointer to the name of a conversion function given two
120 typespecs. */
121
122 static const char *
123 conv_name (gfc_typespec *from, gfc_typespec *to)
124 {
125 return gfc_get_string ("__convert_%c%d_%c%d",
126 gfc_type_letter (from->type), from->kind,
127 gfc_type_letter (to->type), to->kind);
128 }
129
130
131 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
132 corresponds to the conversion. Returns NULL if the conversion
133 isn't found. */
134
135 static gfc_intrinsic_sym *
136 find_conv (gfc_typespec *from, gfc_typespec *to)
137 {
138 gfc_intrinsic_sym *sym;
139 const char *target;
140 int i;
141
142 target = conv_name (from, to);
143 sym = conversion;
144
145 for (i = 0; i < nconv; i++, sym++)
146 if (target == sym->name)
147 return sym;
148
149 return NULL;
150 }
151
152
153 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
154 that corresponds to the conversion. Returns NULL if the conversion
155 isn't found. */
156
157 static gfc_intrinsic_sym *
158 find_char_conv (gfc_typespec *from, gfc_typespec *to)
159 {
160 gfc_intrinsic_sym *sym;
161 const char *target;
162 int i;
163
164 target = conv_name (from, to);
165 sym = char_conversions;
166
167 for (i = 0; i < ncharconv; i++, sym++)
168 if (target == sym->name)
169 return sym;
170
171 return NULL;
172 }
173
174
175 /* Interface to the check functions. We break apart an argument list
176 and call the proper check function rather than forcing each
177 function to manipulate the argument list. */
178
179 static gfc_try
180 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
181 {
182 gfc_expr *a1, *a2, *a3, *a4, *a5;
183
184 if (arg == NULL)
185 return (*specific->check.f0) ();
186
187 a1 = arg->expr;
188 arg = arg->next;
189 if (arg == NULL)
190 return (*specific->check.f1) (a1);
191
192 a2 = arg->expr;
193 arg = arg->next;
194 if (arg == NULL)
195 return (*specific->check.f2) (a1, a2);
196
197 a3 = arg->expr;
198 arg = arg->next;
199 if (arg == NULL)
200 return (*specific->check.f3) (a1, a2, a3);
201
202 a4 = arg->expr;
203 arg = arg->next;
204 if (arg == NULL)
205 return (*specific->check.f4) (a1, a2, a3, a4);
206
207 a5 = arg->expr;
208 arg = arg->next;
209 if (arg == NULL)
210 return (*specific->check.f5) (a1, a2, a3, a4, a5);
211
212 gfc_internal_error ("do_check(): too many args");
213 }
214
215
216 /*********** Subroutines to build the intrinsic list ****************/
217
218 /* Add a single intrinsic symbol to the current list.
219
220 Argument list:
221 char * name of function
222 int whether function is elemental
223 int If the function can be used as an actual argument [1]
224 bt return type of function
225 int kind of return type of function
226 int Fortran standard version
227 check pointer to check function
228 simplify pointer to simplification function
229 resolve pointer to resolution function
230
231 Optional arguments come in multiples of five:
232 char * name of argument
233 bt type of argument
234 int kind of argument
235 int arg optional flag (1=optional, 0=required)
236 sym_intent intent of argument
237
238 The sequence is terminated by a NULL name.
239
240
241 [1] Whether a function can or cannot be used as an actual argument is
242 determined by its presence on the 13.6 list in Fortran 2003. The
243 following intrinsics, which are GNU extensions, are considered allowed
244 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
245 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
246
247 static void
248 add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
249 int standard, gfc_check_f check, gfc_simplify_f simplify,
250 gfc_resolve_f resolve, ...)
251 {
252 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
253 int optional, first_flag;
254 sym_intent intent;
255 va_list argp;
256
257 switch (sizing)
258 {
259 case SZ_SUBS:
260 nsub++;
261 break;
262
263 case SZ_FUNCS:
264 nfunc++;
265 break;
266
267 case SZ_NOTHING:
268 next_sym->name = gfc_get_string (name);
269
270 strcpy (buf, "_gfortran_");
271 strcat (buf, name);
272 next_sym->lib_name = gfc_get_string (buf);
273
274 next_sym->elemental = (cl == CLASS_ELEMENTAL);
275 next_sym->inquiry = (cl == CLASS_INQUIRY);
276 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
277 next_sym->actual_ok = actual_ok;
278 next_sym->ts.type = type;
279 next_sym->ts.kind = kind;
280 next_sym->standard = standard;
281 next_sym->simplify = simplify;
282 next_sym->check = check;
283 next_sym->resolve = resolve;
284 next_sym->specific = 0;
285 next_sym->generic = 0;
286 next_sym->conversion = 0;
287 next_sym->id = id;
288 break;
289
290 default:
291 gfc_internal_error ("add_sym(): Bad sizing mode");
292 }
293
294 va_start (argp, resolve);
295
296 first_flag = 1;
297
298 for (;;)
299 {
300 name = va_arg (argp, char *);
301 if (name == NULL)
302 break;
303
304 type = (bt) va_arg (argp, int);
305 kind = va_arg (argp, int);
306 optional = va_arg (argp, int);
307 intent = (sym_intent) va_arg (argp, int);
308
309 if (sizing != SZ_NOTHING)
310 nargs++;
311 else
312 {
313 next_arg++;
314
315 if (first_flag)
316 next_sym->formal = next_arg;
317 else
318 (next_arg - 1)->next = next_arg;
319
320 first_flag = 0;
321
322 strcpy (next_arg->name, name);
323 next_arg->ts.type = type;
324 next_arg->ts.kind = kind;
325 next_arg->optional = optional;
326 next_arg->intent = intent;
327 }
328 }
329
330 va_end (argp);
331
332 next_sym++;
333 }
334
335
336 /* Add a symbol to the function list where the function takes
337 0 arguments. */
338
339 static void
340 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
341 int kind, int standard,
342 gfc_try (*check) (void),
343 gfc_expr *(*simplify) (void),
344 void (*resolve) (gfc_expr *))
345 {
346 gfc_simplify_f sf;
347 gfc_check_f cf;
348 gfc_resolve_f rf;
349
350 cf.f0 = check;
351 sf.f0 = simplify;
352 rf.f0 = resolve;
353
354 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
355 (void *) 0);
356 }
357
358
359 /* Add a symbol to the subroutine list where the subroutine takes
360 0 arguments. */
361
362 static void
363 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
364 {
365 gfc_check_f cf;
366 gfc_simplify_f sf;
367 gfc_resolve_f rf;
368
369 cf.f1 = NULL;
370 sf.f1 = NULL;
371 rf.s1 = resolve;
372
373 add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
374 (void *) 0);
375 }
376
377
378 /* Add a symbol to the function list where the function takes
379 1 arguments. */
380
381 static void
382 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
383 int kind, int standard,
384 gfc_try (*check) (gfc_expr *),
385 gfc_expr *(*simplify) (gfc_expr *),
386 void (*resolve) (gfc_expr *, gfc_expr *),
387 const char *a1, bt type1, int kind1, int optional1)
388 {
389 gfc_check_f cf;
390 gfc_simplify_f sf;
391 gfc_resolve_f rf;
392
393 cf.f1 = check;
394 sf.f1 = simplify;
395 rf.f1 = resolve;
396
397 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
398 a1, type1, kind1, optional1, INTENT_IN,
399 (void *) 0);
400 }
401
402
403 /* Add a symbol to the subroutine list where the subroutine takes
404 1 arguments. */
405
406 static void
407 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
408 gfc_try (*check) (gfc_expr *),
409 gfc_expr *(*simplify) (gfc_expr *),
410 void (*resolve) (gfc_code *),
411 const char *a1, bt type1, int kind1, int optional1)
412 {
413 gfc_check_f cf;
414 gfc_simplify_f sf;
415 gfc_resolve_f rf;
416
417 cf.f1 = check;
418 sf.f1 = simplify;
419 rf.s1 = resolve;
420
421 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
422 a1, type1, kind1, optional1, INTENT_IN,
423 (void *) 0);
424 }
425
426
427 /* Add a symbol to the function list where the function takes
428 1 arguments, specifying the intent of the argument. */
429
430 static void
431 add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
432 int actual_ok, bt type, int kind, int standard,
433 gfc_try (*check) (gfc_expr *),
434 gfc_expr *(*simplify) (gfc_expr *),
435 void (*resolve) (gfc_expr *, gfc_expr *),
436 const char *a1, bt type1, int kind1, int optional1,
437 sym_intent intent1)
438 {
439 gfc_check_f cf;
440 gfc_simplify_f sf;
441 gfc_resolve_f rf;
442
443 cf.f1 = check;
444 sf.f1 = simplify;
445 rf.f1 = resolve;
446
447 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
448 a1, type1, kind1, optional1, intent1,
449 (void *) 0);
450 }
451
452
453 /* Add a symbol to the subroutine list where the subroutine takes
454 1 arguments, specifying the intent of the argument. */
455
456 static void
457 add_sym_1s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
458 int kind, int standard,
459 gfc_try (*check) (gfc_expr *),
460 gfc_expr *(*simplify) (gfc_expr *),
461 void (*resolve) (gfc_code *),
462 const char *a1, bt type1, int kind1, int optional1,
463 sym_intent intent1)
464 {
465 gfc_check_f cf;
466 gfc_simplify_f sf;
467 gfc_resolve_f rf;
468
469 cf.f1 = check;
470 sf.f1 = simplify;
471 rf.s1 = resolve;
472
473 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
474 a1, type1, kind1, optional1, intent1,
475 (void *) 0);
476 }
477
478
479 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
480 function. MAX et al take 2 or more arguments. */
481
482 static void
483 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
484 int kind, int standard,
485 gfc_try (*check) (gfc_actual_arglist *),
486 gfc_expr *(*simplify) (gfc_expr *),
487 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
488 const char *a1, bt type1, int kind1, int optional1,
489 const char *a2, bt type2, int kind2, int optional2)
490 {
491 gfc_check_f cf;
492 gfc_simplify_f sf;
493 gfc_resolve_f rf;
494
495 cf.f1m = check;
496 sf.f1 = simplify;
497 rf.f1m = resolve;
498
499 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
500 a1, type1, kind1, optional1, INTENT_IN,
501 a2, type2, kind2, optional2, INTENT_IN,
502 (void *) 0);
503 }
504
505
506 /* Add a symbol to the function list where the function takes
507 2 arguments. */
508
509 static void
510 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
511 int kind, int standard,
512 gfc_try (*check) (gfc_expr *, gfc_expr *),
513 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
514 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
515 const char *a1, bt type1, int kind1, int optional1,
516 const char *a2, bt type2, int kind2, int optional2)
517 {
518 gfc_check_f cf;
519 gfc_simplify_f sf;
520 gfc_resolve_f rf;
521
522 cf.f2 = check;
523 sf.f2 = simplify;
524 rf.f2 = resolve;
525
526 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
527 a1, type1, kind1, optional1, INTENT_IN,
528 a2, type2, kind2, optional2, INTENT_IN,
529 (void *) 0);
530 }
531
532
533 /* Add a symbol to the subroutine list where the subroutine takes
534 2 arguments. */
535
536 static void
537 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
538 gfc_try (*check) (gfc_expr *, gfc_expr *),
539 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
540 void (*resolve) (gfc_code *),
541 const char *a1, bt type1, int kind1, int optional1,
542 const char *a2, bt type2, int kind2, int optional2)
543 {
544 gfc_check_f cf;
545 gfc_simplify_f sf;
546 gfc_resolve_f rf;
547
548 cf.f2 = check;
549 sf.f2 = simplify;
550 rf.s1 = resolve;
551
552 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
553 a1, type1, kind1, optional1, INTENT_IN,
554 a2, type2, kind2, optional2, INTENT_IN,
555 (void *) 0);
556 }
557
558
559 /* Add a symbol to the subroutine list where the subroutine takes
560 2 arguments, specifying the intent of the arguments. */
561
562 static void
563 add_sym_2s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
564 int kind, int standard,
565 gfc_try (*check) (gfc_expr *, gfc_expr *),
566 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
567 void (*resolve) (gfc_code *),
568 const char *a1, bt type1, int kind1, int optional1,
569 sym_intent intent1, const char *a2, bt type2, int kind2,
570 int optional2, sym_intent intent2)
571 {
572 gfc_check_f cf;
573 gfc_simplify_f sf;
574 gfc_resolve_f rf;
575
576 cf.f2 = check;
577 sf.f2 = simplify;
578 rf.s1 = resolve;
579
580 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
581 a1, type1, kind1, optional1, intent1,
582 a2, type2, kind2, optional2, intent2,
583 (void *) 0);
584 }
585
586
587 /* Add a symbol to the function list where the function takes
588 3 arguments. */
589
590 static void
591 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
592 int kind, int standard,
593 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
594 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
595 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
596 const char *a1, bt type1, int kind1, int optional1,
597 const char *a2, bt type2, int kind2, int optional2,
598 const char *a3, bt type3, int kind3, int optional3)
599 {
600 gfc_check_f cf;
601 gfc_simplify_f sf;
602 gfc_resolve_f rf;
603
604 cf.f3 = check;
605 sf.f3 = simplify;
606 rf.f3 = resolve;
607
608 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
609 a1, type1, kind1, optional1, INTENT_IN,
610 a2, type2, kind2, optional2, INTENT_IN,
611 a3, type3, kind3, optional3, INTENT_IN,
612 (void *) 0);
613 }
614
615
616 /* MINLOC and MAXLOC get special treatment because their argument
617 might have to be reordered. */
618
619 static void
620 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
621 int kind, int standard,
622 gfc_try (*check) (gfc_actual_arglist *),
623 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
624 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
625 const char *a1, bt type1, int kind1, int optional1,
626 const char *a2, bt type2, int kind2, int optional2,
627 const char *a3, bt type3, int kind3, int optional3)
628 {
629 gfc_check_f cf;
630 gfc_simplify_f sf;
631 gfc_resolve_f rf;
632
633 cf.f3ml = check;
634 sf.f3 = simplify;
635 rf.f3 = resolve;
636
637 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
638 a1, type1, kind1, optional1, INTENT_IN,
639 a2, type2, kind2, optional2, INTENT_IN,
640 a3, type3, kind3, optional3, INTENT_IN,
641 (void *) 0);
642 }
643
644
645 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
646 their argument also might have to be reordered. */
647
648 static void
649 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
650 int kind, int standard,
651 gfc_try (*check) (gfc_actual_arglist *),
652 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
653 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
654 const char *a1, bt type1, int kind1, int optional1,
655 const char *a2, bt type2, int kind2, int optional2,
656 const char *a3, bt type3, int kind3, int optional3)
657 {
658 gfc_check_f cf;
659 gfc_simplify_f sf;
660 gfc_resolve_f rf;
661
662 cf.f3red = check;
663 sf.f3 = simplify;
664 rf.f3 = resolve;
665
666 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
667 a1, type1, kind1, optional1, INTENT_IN,
668 a2, type2, kind2, optional2, INTENT_IN,
669 a3, type3, kind3, optional3, INTENT_IN,
670 (void *) 0);
671 }
672
673
674 /* Add a symbol to the subroutine list where the subroutine takes
675 3 arguments. */
676
677 static void
678 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
679 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
680 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
681 void (*resolve) (gfc_code *),
682 const char *a1, bt type1, int kind1, int optional1,
683 const char *a2, bt type2, int kind2, int optional2,
684 const char *a3, bt type3, int kind3, int optional3)
685 {
686 gfc_check_f cf;
687 gfc_simplify_f sf;
688 gfc_resolve_f rf;
689
690 cf.f3 = check;
691 sf.f3 = simplify;
692 rf.s1 = resolve;
693
694 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
695 a1, type1, kind1, optional1, INTENT_IN,
696 a2, type2, kind2, optional2, INTENT_IN,
697 a3, type3, kind3, optional3, INTENT_IN,
698 (void *) 0);
699 }
700
701
702 /* Add a symbol to the subroutine list where the subroutine takes
703 3 arguments, specifying the intent of the arguments. */
704
705 static void
706 add_sym_3s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
707 int kind, int standard,
708 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
709 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
710 void (*resolve) (gfc_code *),
711 const char *a1, bt type1, int kind1, int optional1,
712 sym_intent intent1, const char *a2, bt type2, int kind2,
713 int optional2, sym_intent intent2, const char *a3, bt type3,
714 int kind3, int optional3, sym_intent intent3)
715 {
716 gfc_check_f cf;
717 gfc_simplify_f sf;
718 gfc_resolve_f rf;
719
720 cf.f3 = check;
721 sf.f3 = simplify;
722 rf.s1 = resolve;
723
724 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
725 a1, type1, kind1, optional1, intent1,
726 a2, type2, kind2, optional2, intent2,
727 a3, type3, kind3, optional3, intent3,
728 (void *) 0);
729 }
730
731
732 /* Add a symbol to the function list where the function takes
733 4 arguments. */
734
735 static void
736 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
737 int kind, int standard,
738 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
739 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
740 gfc_expr *),
741 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
742 gfc_expr *),
743 const char *a1, bt type1, int kind1, int optional1,
744 const char *a2, bt type2, int kind2, int optional2,
745 const char *a3, bt type3, int kind3, int optional3,
746 const char *a4, bt type4, int kind4, int optional4 )
747 {
748 gfc_check_f cf;
749 gfc_simplify_f sf;
750 gfc_resolve_f rf;
751
752 cf.f4 = check;
753 sf.f4 = simplify;
754 rf.f4 = resolve;
755
756 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
757 a1, type1, kind1, optional1, INTENT_IN,
758 a2, type2, kind2, optional2, INTENT_IN,
759 a3, type3, kind3, optional3, INTENT_IN,
760 a4, type4, kind4, optional4, INTENT_IN,
761 (void *) 0);
762 }
763
764
765 /* Add a symbol to the subroutine list where the subroutine takes
766 4 arguments. */
767
768 static void
769 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
770 int standard,
771 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
772 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
773 gfc_expr *),
774 void (*resolve) (gfc_code *),
775 const char *a1, bt type1, int kind1, int optional1,
776 sym_intent intent1, const char *a2, bt type2, int kind2,
777 int optional2, sym_intent intent2, const char *a3, bt type3,
778 int kind3, int optional3, sym_intent intent3, const char *a4,
779 bt type4, int kind4, int optional4, sym_intent intent4)
780 {
781 gfc_check_f cf;
782 gfc_simplify_f sf;
783 gfc_resolve_f rf;
784
785 cf.f4 = check;
786 sf.f4 = simplify;
787 rf.s1 = resolve;
788
789 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
790 a1, type1, kind1, optional1, intent1,
791 a2, type2, kind2, optional2, intent2,
792 a3, type3, kind3, optional3, intent3,
793 a4, type4, kind4, optional4, intent4,
794 (void *) 0);
795 }
796
797
798 /* Add a symbol to the subroutine list where the subroutine takes
799 5 arguments. */
800
801 static void
802 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
803 int standard,
804 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
805 gfc_expr *),
806 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
807 gfc_expr *, gfc_expr *),
808 void (*resolve) (gfc_code *),
809 const char *a1, bt type1, int kind1, int optional1,
810 sym_intent intent1, const char *a2, bt type2, int kind2,
811 int optional2, sym_intent intent2, const char *a3, bt type3,
812 int kind3, int optional3, sym_intent intent3, const char *a4,
813 bt type4, int kind4, int optional4, sym_intent intent4,
814 const char *a5, bt type5, int kind5, int optional5,
815 sym_intent intent5)
816 {
817 gfc_check_f cf;
818 gfc_simplify_f sf;
819 gfc_resolve_f rf;
820
821 cf.f5 = check;
822 sf.f5 = simplify;
823 rf.s1 = resolve;
824
825 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
826 a1, type1, kind1, optional1, intent1,
827 a2, type2, kind2, optional2, intent2,
828 a3, type3, kind3, optional3, intent3,
829 a4, type4, kind4, optional4, intent4,
830 a5, type5, kind5, optional5, intent5,
831 (void *) 0);
832 }
833
834
835 /* Locate an intrinsic symbol given a base pointer, number of elements
836 in the table and a pointer to a name. Returns the NULL pointer if
837 a name is not found. */
838
839 static gfc_intrinsic_sym *
840 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
841 {
842 /* name may be a user-supplied string, so we must first make sure
843 that we're comparing against a pointer into the global string
844 table. */
845 const char *p = gfc_get_string (name);
846
847 while (n > 0)
848 {
849 if (p == start->name)
850 return start;
851
852 start++;
853 n--;
854 }
855
856 return NULL;
857 }
858
859
860 /* Given a name, find a function in the intrinsic function table.
861 Returns NULL if not found. */
862
863 gfc_intrinsic_sym *
864 gfc_find_function (const char *name)
865 {
866 gfc_intrinsic_sym *sym;
867
868 sym = find_sym (functions, nfunc, name);
869 if (!sym)
870 sym = find_sym (conversion, nconv, name);
871
872 return sym;
873 }
874
875
876 /* Given a name, find a function in the intrinsic subroutine table.
877 Returns NULL if not found. */
878
879 gfc_intrinsic_sym *
880 gfc_find_subroutine (const char *name)
881 {
882 return find_sym (subroutines, nsub, name);
883 }
884
885
886 /* Given a string, figure out if it is the name of a generic intrinsic
887 function or not. */
888
889 int
890 gfc_generic_intrinsic (const char *name)
891 {
892 gfc_intrinsic_sym *sym;
893
894 sym = gfc_find_function (name);
895 return (sym == NULL) ? 0 : sym->generic;
896 }
897
898
899 /* Given a string, figure out if it is the name of a specific
900 intrinsic function or not. */
901
902 int
903 gfc_specific_intrinsic (const char *name)
904 {
905 gfc_intrinsic_sym *sym;
906
907 sym = gfc_find_function (name);
908 return (sym == NULL) ? 0 : sym->specific;
909 }
910
911
912 /* Given a string, figure out if it is the name of an intrinsic function
913 or subroutine allowed as an actual argument or not. */
914 int
915 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
916 {
917 gfc_intrinsic_sym *sym;
918
919 /* Intrinsic subroutines are not allowed as actual arguments. */
920 if (subroutine_flag)
921 return 0;
922 else
923 {
924 sym = gfc_find_function (name);
925 return (sym == NULL) ? 0 : sym->actual_ok;
926 }
927 }
928
929
930 /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
931 it's name refers to an intrinsic but this intrinsic is not included in the
932 selected standard, this returns FALSE and sets the symbol's external
933 attribute. */
934
935 bool
936 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
937 {
938 gfc_intrinsic_sym* isym;
939 const char* symstd;
940
941 /* If INTRINSIC/EXTERNAL state is already known, return. */
942 if (sym->attr.intrinsic)
943 return true;
944 if (sym->attr.external)
945 return false;
946
947 if (subroutine_flag)
948 isym = gfc_find_subroutine (sym->name);
949 else
950 isym = gfc_find_function (sym->name);
951
952 /* No such intrinsic available at all? */
953 if (!isym)
954 return false;
955
956 /* See if this intrinsic is allowed in the current standard. */
957 if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
958 {
959 if (sym->attr.proc == PROC_UNKNOWN
960 && gfc_option.warn_intrinsics_std)
961 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
962 " selected standard but %s and '%s' will be"
963 " treated as if declared EXTERNAL. Use an"
964 " appropriate -std=* option or define"
965 " -fall-intrinsics to allow this intrinsic.",
966 sym->name, &loc, symstd, sym->name);
967
968 return false;
969 }
970
971 return true;
972 }
973
974
975 /* Collect a set of intrinsic functions into a generic collection.
976 The first argument is the name of the generic function, which is
977 also the name of a specific function. The rest of the specifics
978 currently in the table are placed into the list of specific
979 functions associated with that generic.
980
981 PR fortran/32778
982 FIXME: Remove the argument STANDARD if no regressions are
983 encountered. Change all callers (approx. 360).
984 */
985
986 static void
987 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
988 {
989 gfc_intrinsic_sym *g;
990
991 if (sizing != SZ_NOTHING)
992 return;
993
994 g = gfc_find_function (name);
995 if (g == NULL)
996 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
997 name);
998
999 gcc_assert (g->id == id);
1000
1001 g->generic = 1;
1002 g->specific = 1;
1003 if ((g + 1)->name != NULL)
1004 g->specific_head = g + 1;
1005 g++;
1006
1007 while (g->name != NULL)
1008 {
1009 g->next = g + 1;
1010 g->specific = 1;
1011 g++;
1012 }
1013
1014 g--;
1015 g->next = NULL;
1016 }
1017
1018
1019 /* Create a duplicate intrinsic function entry for the current
1020 function, the only differences being the alternate name and
1021 a different standard if necessary. Note that we use argument
1022 lists more than once, but all argument lists are freed as a
1023 single block. */
1024
1025 static void
1026 make_alias (const char *name, int standard)
1027 {
1028 switch (sizing)
1029 {
1030 case SZ_FUNCS:
1031 nfunc++;
1032 break;
1033
1034 case SZ_SUBS:
1035 nsub++;
1036 break;
1037
1038 case SZ_NOTHING:
1039 next_sym[0] = next_sym[-1];
1040 next_sym->name = gfc_get_string (name);
1041 next_sym->standard = standard;
1042 next_sym++;
1043 break;
1044
1045 default:
1046 break;
1047 }
1048 }
1049
1050
1051 /* Make the current subroutine noreturn. */
1052
1053 static void
1054 make_noreturn (void)
1055 {
1056 if (sizing == SZ_NOTHING)
1057 next_sym[-1].noreturn = 1;
1058 }
1059
1060
1061 /* Add intrinsic functions. */
1062
1063 static void
1064 add_functions (void)
1065 {
1066 /* Argument names as in the standard (to be used as argument keywords). */
1067 const char
1068 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1069 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1070 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1071 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1072 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1073 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1074 *p = "p", *ar = "array", *shp = "shape", *src = "source",
1075 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1076 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1077 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1078 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1079 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1080 *num = "number", *tm = "time", *nm = "name", *md = "mode",
1081 *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
1082 *ca = "coarray", *sub = "sub";
1083
1084 int di, dr, dd, dl, dc, dz, ii;
1085
1086 di = gfc_default_integer_kind;
1087 dr = gfc_default_real_kind;
1088 dd = gfc_default_double_kind;
1089 dl = gfc_default_logical_kind;
1090 dc = gfc_default_character_kind;
1091 dz = gfc_default_complex_kind;
1092 ii = gfc_index_integer_kind;
1093
1094 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1095 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1096 a, BT_REAL, dr, REQUIRED);
1097
1098 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1099 NULL, gfc_simplify_abs, gfc_resolve_abs,
1100 a, BT_INTEGER, di, REQUIRED);
1101
1102 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1103 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1104 a, BT_REAL, dd, REQUIRED);
1105
1106 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1107 NULL, gfc_simplify_abs, gfc_resolve_abs,
1108 a, BT_COMPLEX, dz, REQUIRED);
1109
1110 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1111 NULL, gfc_simplify_abs, gfc_resolve_abs,
1112 a, BT_COMPLEX, dd, REQUIRED);
1113
1114 make_alias ("cdabs", GFC_STD_GNU);
1115
1116 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1117
1118 /* The checking function for ACCESS is called gfc_check_access_func
1119 because the name gfc_check_access is already used in module.c. */
1120 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1121 gfc_check_access_func, NULL, gfc_resolve_access,
1122 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1123
1124 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1125
1126 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1127 BT_CHARACTER, dc, GFC_STD_F95,
1128 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1129 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1130
1131 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1132
1133 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1134 gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1135 x, BT_REAL, dr, REQUIRED);
1136
1137 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1138 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1139 x, BT_REAL, dd, REQUIRED);
1140
1141 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1142
1143 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1144 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1145 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1146
1147 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1148 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1149 x, BT_REAL, dd, REQUIRED);
1150
1151 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1152
1153 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1154 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1155 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1156
1157 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1158
1159 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1160 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1161 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1162
1163 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1164
1165 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1166 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1167 z, BT_COMPLEX, dz, REQUIRED);
1168
1169 make_alias ("imag", GFC_STD_GNU);
1170 make_alias ("imagpart", GFC_STD_GNU);
1171
1172 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1173 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1174 z, BT_COMPLEX, dd, REQUIRED);
1175
1176 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1177
1178 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1179 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1180 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1181
1182 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1183 NULL, gfc_simplify_dint, gfc_resolve_dint,
1184 a, BT_REAL, dd, REQUIRED);
1185
1186 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1187
1188 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1189 gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1190 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1191
1192 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1193
1194 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1195 gfc_check_allocated, NULL, NULL,
1196 ar, BT_UNKNOWN, 0, REQUIRED);
1197
1198 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1199
1200 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1201 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1202 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1203
1204 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1205 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1206 a, BT_REAL, dd, REQUIRED);
1207
1208 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1209
1210 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1211 gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1212 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1213
1214 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1215
1216 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1217 gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1218 x, BT_REAL, dr, REQUIRED);
1219
1220 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1221 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1222 x, BT_REAL, dd, REQUIRED);
1223
1224 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1225
1226 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1227 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1228 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1229
1230 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1231 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1232 x, BT_REAL, dd, REQUIRED);
1233
1234 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1235
1236 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1237 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1238 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1239
1240 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1241
1242 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1243 gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1244 x, BT_REAL, dr, REQUIRED);
1245
1246 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1247 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1248 x, BT_REAL, dd, REQUIRED);
1249
1250 /* Two-argument version of atan, equivalent to atan2. */
1251 add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1252 gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1253 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1254
1255 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1256
1257 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1258 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1259 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1260
1261 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1262 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1263 x, BT_REAL, dd, REQUIRED);
1264
1265 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1266
1267 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1268 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1269 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1270
1271 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1272 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1273 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1274
1275 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1276
1277 /* Bessel and Neumann functions for G77 compatibility. */
1278 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1279 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1280 x, BT_REAL, dr, REQUIRED);
1281
1282 make_alias ("bessel_j0", GFC_STD_F2008);
1283
1284 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1285 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1286 x, BT_REAL, dd, REQUIRED);
1287
1288 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1289
1290 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1291 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1292 x, BT_REAL, dr, REQUIRED);
1293
1294 make_alias ("bessel_j1", GFC_STD_F2008);
1295
1296 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1297 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1298 x, BT_REAL, dd, REQUIRED);
1299
1300 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1301
1302 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1303 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1304 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1305
1306 make_alias ("bessel_jn", GFC_STD_F2008);
1307
1308 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1309 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1310 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1311
1312 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1313
1314 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1315 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1316 x, BT_REAL, dr, REQUIRED);
1317
1318 make_alias ("bessel_y0", GFC_STD_F2008);
1319
1320 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1321 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1322 x, BT_REAL, dd, REQUIRED);
1323
1324 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1325
1326 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1327 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1328 x, BT_REAL, dr, REQUIRED);
1329
1330 make_alias ("bessel_y1", GFC_STD_F2008);
1331
1332 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1333 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1334 x, BT_REAL, dd, REQUIRED);
1335
1336 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1337
1338 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1339 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1340 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1341
1342 make_alias ("bessel_yn", GFC_STD_F2008);
1343
1344 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1345 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1346 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1347
1348 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1349
1350 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1351 gfc_check_i, gfc_simplify_bit_size, NULL,
1352 i, BT_INTEGER, di, REQUIRED);
1353
1354 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1355
1356 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1357 gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
1358 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1359
1360 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1361
1362 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1363 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1364 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1365
1366 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1367
1368 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1369 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1370 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1371
1372 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1373
1374 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1375 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1376 nm, BT_CHARACTER, dc, REQUIRED);
1377
1378 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1379
1380 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1381 gfc_check_chmod, NULL, gfc_resolve_chmod,
1382 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1383
1384 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1385
1386 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1387 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1388 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1389 kind, BT_INTEGER, di, OPTIONAL);
1390
1391 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1392
1393 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1394 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1395
1396 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1397 GFC_STD_F2003);
1398
1399 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1400 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1401 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1402
1403 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1404
1405 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1406 complex instead of the default complex. */
1407
1408 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1409 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1410 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1411
1412 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1413
1414 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1415 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1416 z, BT_COMPLEX, dz, REQUIRED);
1417
1418 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1419 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1420 z, BT_COMPLEX, dd, REQUIRED);
1421
1422 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1423
1424 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1425 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1426 x, BT_REAL, dr, REQUIRED);
1427
1428 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1429 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1430 x, BT_REAL, dd, REQUIRED);
1431
1432 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1433 NULL, gfc_simplify_cos, gfc_resolve_cos,
1434 x, BT_COMPLEX, dz, REQUIRED);
1435
1436 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1437 NULL, gfc_simplify_cos, gfc_resolve_cos,
1438 x, BT_COMPLEX, dd, REQUIRED);
1439
1440 make_alias ("cdcos", GFC_STD_GNU);
1441
1442 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1443
1444 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1445 gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1446 x, BT_REAL, dr, REQUIRED);
1447
1448 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1449 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1450 x, BT_REAL, dd, REQUIRED);
1451
1452 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1453
1454 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1455 BT_INTEGER, di, GFC_STD_F95,
1456 gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1457 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1458 kind, BT_INTEGER, di, OPTIONAL);
1459
1460 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1461
1462 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1463 gfc_check_cshift, NULL, gfc_resolve_cshift,
1464 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1465 dm, BT_INTEGER, ii, OPTIONAL);
1466
1467 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1468
1469 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1470 gfc_check_ctime, NULL, gfc_resolve_ctime,
1471 tm, BT_INTEGER, di, REQUIRED);
1472
1473 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1474
1475 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1476 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1477 a, BT_REAL, dr, REQUIRED);
1478
1479 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1480
1481 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1482 gfc_check_digits, gfc_simplify_digits, NULL,
1483 x, BT_UNKNOWN, dr, REQUIRED);
1484
1485 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1486
1487 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1488 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1489 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1490
1491 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1492 NULL, gfc_simplify_dim, gfc_resolve_dim,
1493 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1494
1495 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1496 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1497 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1498
1499 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1500
1501 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1502 GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1503 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1504
1505 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1506
1507 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1508 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1509 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1510
1511 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1512
1513 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1514 NULL, NULL, NULL,
1515 a, BT_COMPLEX, dd, REQUIRED);
1516
1517 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1518
1519 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1520 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1521 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1522 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1523
1524 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1525
1526 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1527 gfc_check_x, gfc_simplify_epsilon, NULL,
1528 x, BT_REAL, dr, REQUIRED);
1529
1530 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1531
1532 /* G77 compatibility for the ERF() and ERFC() functions. */
1533 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1534 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1535 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1536
1537 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1538 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1539 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1540
1541 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1542
1543 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1544 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1545 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1546
1547 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1548 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1549 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1550
1551 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1552
1553 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1554 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1555 gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1556 dr, REQUIRED);
1557
1558 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1559
1560 /* G77 compatibility */
1561 add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1562 gfc_check_dtime_etime, NULL, NULL,
1563 x, BT_REAL, 4, REQUIRED);
1564
1565 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1566
1567 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1568 gfc_check_dtime_etime, NULL, NULL,
1569 x, BT_REAL, 4, REQUIRED);
1570
1571 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1572
1573 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1574 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1575 x, BT_REAL, dr, REQUIRED);
1576
1577 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1578 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1579 x, BT_REAL, dd, REQUIRED);
1580
1581 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1582 NULL, gfc_simplify_exp, gfc_resolve_exp,
1583 x, BT_COMPLEX, dz, REQUIRED);
1584
1585 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1586 NULL, gfc_simplify_exp, gfc_resolve_exp,
1587 x, BT_COMPLEX, dd, REQUIRED);
1588
1589 make_alias ("cdexp", GFC_STD_GNU);
1590
1591 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1592
1593 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1594 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1595 x, BT_REAL, dr, REQUIRED);
1596
1597 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1598
1599 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1600 ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1601 gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1602 a, BT_UNKNOWN, 0, REQUIRED,
1603 mo, BT_UNKNOWN, 0, REQUIRED);
1604
1605 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1606 NULL, NULL, gfc_resolve_fdate);
1607
1608 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1609
1610 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1611 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1612 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1613
1614 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1615
1616 /* G77 compatible fnum */
1617 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1618 gfc_check_fnum, NULL, gfc_resolve_fnum,
1619 ut, BT_INTEGER, di, REQUIRED);
1620
1621 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1622
1623 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1624 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1625 x, BT_REAL, dr, REQUIRED);
1626
1627 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1628
1629 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1630 GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1631 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1632
1633 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1634
1635 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1636 gfc_check_ftell, NULL, gfc_resolve_ftell,
1637 ut, BT_INTEGER, di, REQUIRED);
1638
1639 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1640
1641 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1642 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1643 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1644
1645 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1646
1647 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1648 gfc_check_fgetput, NULL, gfc_resolve_fget,
1649 c, BT_CHARACTER, dc, REQUIRED);
1650
1651 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1652
1653 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1654 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1655 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1656
1657 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1658
1659 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1660 gfc_check_fgetput, NULL, gfc_resolve_fput,
1661 c, BT_CHARACTER, dc, REQUIRED);
1662
1663 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1664
1665 add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1666 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1667 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1668
1669 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1670 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1671 x, BT_REAL, dr, REQUIRED);
1672
1673 make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1674
1675 /* Unix IDs (g77 compatibility) */
1676 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1677 NULL, NULL, gfc_resolve_getcwd,
1678 c, BT_CHARACTER, dc, REQUIRED);
1679
1680 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1681
1682 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1683 NULL, NULL, gfc_resolve_getgid);
1684
1685 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1686
1687 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1688 NULL, NULL, gfc_resolve_getpid);
1689
1690 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1691
1692 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1693 NULL, NULL, gfc_resolve_getuid);
1694
1695 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1696
1697 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1698 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1699 a, BT_CHARACTER, dc, REQUIRED);
1700
1701 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1702
1703 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1704 gfc_check_huge, gfc_simplify_huge, NULL,
1705 x, BT_UNKNOWN, dr, REQUIRED);
1706
1707 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1708
1709 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1710 BT_REAL, dr, GFC_STD_F2008,
1711 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1712 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1713
1714 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1715
1716 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1717 BT_INTEGER, di, GFC_STD_F95,
1718 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1719 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1720
1721 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1722
1723 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1724 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1725 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1726
1727 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1728
1729 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1730 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1731 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1732
1733 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1734
1735 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1736 NULL, NULL, NULL);
1737
1738 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1739
1740 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1741 gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1742 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1743
1744 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1745
1746 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1747 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1748 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1749 ln, BT_INTEGER, di, REQUIRED);
1750
1751 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1752
1753 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1754 gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1755 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1756
1757 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1758
1759 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1760 BT_INTEGER, di, GFC_STD_F77,
1761 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1762 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1763
1764 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1765
1766 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1767 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1768 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1769
1770 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1771
1772 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1773 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1774 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1775
1776 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1777
1778 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1779 NULL, NULL, gfc_resolve_ierrno);
1780
1781 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1782
1783 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1784 gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
1785 ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1786
1787 /* The resolution function for INDEX is called gfc_resolve_index_func
1788 because the name gfc_resolve_index is already used in resolve.c. */
1789 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1790 BT_INTEGER, di, GFC_STD_F77,
1791 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1792 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1793 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1794
1795 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1796
1797 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1798 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1799 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1800
1801 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1802 NULL, gfc_simplify_ifix, NULL,
1803 a, BT_REAL, dr, REQUIRED);
1804
1805 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1806 NULL, gfc_simplify_idint, NULL,
1807 a, BT_REAL, dd, REQUIRED);
1808
1809 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1810
1811 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1812 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1813 a, BT_REAL, dr, REQUIRED);
1814
1815 make_alias ("short", GFC_STD_GNU);
1816
1817 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1818
1819 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1820 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1821 a, BT_REAL, dr, REQUIRED);
1822
1823 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1824
1825 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1826 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1827 a, BT_REAL, dr, REQUIRED);
1828
1829 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1830
1831 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1832 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1833 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1834
1835 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1836
1837 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1838 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1839 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1840
1841 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1842
1843 /* The following function is for G77 compatibility. */
1844 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1845 gfc_check_irand, NULL, NULL,
1846 i, BT_INTEGER, 4, OPTIONAL);
1847
1848 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1849
1850 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1851 gfc_check_isatty, NULL, gfc_resolve_isatty,
1852 ut, BT_INTEGER, di, REQUIRED);
1853
1854 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1855
1856 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1857 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1858 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1859 i, BT_INTEGER, 0, REQUIRED);
1860
1861 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1862
1863 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1864 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1865 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1866 i, BT_INTEGER, 0, REQUIRED);
1867
1868 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1869
1870 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1871 BT_LOGICAL, dl, GFC_STD_GNU,
1872 gfc_check_isnan, gfc_simplify_isnan, NULL,
1873 x, BT_REAL, 0, REQUIRED);
1874
1875 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1876
1877 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1878 gfc_check_ishft, NULL, gfc_resolve_rshift,
1879 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1880
1881 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1882
1883 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1884 gfc_check_ishft, NULL, gfc_resolve_lshift,
1885 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1886
1887 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1888
1889 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1890 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1891 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1892
1893 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1894
1895 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1896 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1897 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1898 sz, BT_INTEGER, di, OPTIONAL);
1899
1900 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1901
1902 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1903 gfc_check_kill, NULL, gfc_resolve_kill,
1904 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1905
1906 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1907
1908 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1909 gfc_check_kind, gfc_simplify_kind, NULL,
1910 x, BT_REAL, dr, REQUIRED);
1911
1912 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1913
1914 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1915 BT_INTEGER, di, GFC_STD_F95,
1916 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1917 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1918 kind, BT_INTEGER, di, OPTIONAL);
1919
1920 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1921
1922 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
1923 BT_INTEGER, di, GFC_STD_F2008,
1924 gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
1925 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1926 kind, BT_INTEGER, di, OPTIONAL);
1927
1928 make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
1929
1930 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1931 BT_INTEGER, di, GFC_STD_F2008,
1932 gfc_check_i, gfc_simplify_leadz, NULL,
1933 i, BT_INTEGER, di, REQUIRED);
1934
1935 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1936
1937 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1938 BT_INTEGER, di, GFC_STD_F77,
1939 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1940 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1941
1942 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1943
1944 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1945 BT_INTEGER, di, GFC_STD_F95,
1946 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1947 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1948
1949 make_alias ("lnblnk", GFC_STD_GNU);
1950
1951 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1952
1953 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1954 dr, GFC_STD_GNU,
1955 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1956 x, BT_REAL, dr, REQUIRED);
1957
1958 make_alias ("log_gamma", GFC_STD_F2008);
1959
1960 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1961 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1962 x, BT_REAL, dr, REQUIRED);
1963
1964 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1965 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1966 x, BT_REAL, dr, REQUIRED);
1967
1968 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1969
1970
1971 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1972 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1973 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1974
1975 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1976
1977 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1978 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1979 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1980
1981 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1982
1983 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1984 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1985 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1986
1987 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1988
1989 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1990 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1991 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1992
1993 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1994
1995 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1996 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1997 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
1998
1999 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2000
2001 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2002 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2003 x, BT_REAL, dr, REQUIRED);
2004
2005 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2006 NULL, gfc_simplify_log, gfc_resolve_log,
2007 x, BT_REAL, dr, REQUIRED);
2008
2009 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2010 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2011 x, BT_REAL, dd, REQUIRED);
2012
2013 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2014 NULL, gfc_simplify_log, gfc_resolve_log,
2015 x, BT_COMPLEX, dz, REQUIRED);
2016
2017 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2018 NULL, gfc_simplify_log, gfc_resolve_log,
2019 x, BT_COMPLEX, dd, REQUIRED);
2020
2021 make_alias ("cdlog", GFC_STD_GNU);
2022
2023 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2024
2025 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2026 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2027 x, BT_REAL, dr, REQUIRED);
2028
2029 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2030 NULL, gfc_simplify_log10, gfc_resolve_log10,
2031 x, BT_REAL, dr, REQUIRED);
2032
2033 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2034 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2035 x, BT_REAL, dd, REQUIRED);
2036
2037 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2038
2039 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2040 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2041 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2042
2043 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2044
2045 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2046 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2047 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2048
2049 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2050
2051 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2052 GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2053 sz, BT_INTEGER, di, REQUIRED);
2054
2055 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2056
2057 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2058 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2059 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2060
2061 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2062
2063 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2064 int(max). The max function must take at least two arguments. */
2065
2066 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2067 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2068 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2069
2070 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2071 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2072 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2073
2074 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2075 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2076 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2077
2078 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2079 gfc_check_min_max_real, gfc_simplify_max, NULL,
2080 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2081
2082 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2083 gfc_check_min_max_real, gfc_simplify_max, NULL,
2084 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2085
2086 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2087 gfc_check_min_max_double, gfc_simplify_max, NULL,
2088 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2089
2090 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2091
2092 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2093 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2094 x, BT_UNKNOWN, dr, REQUIRED);
2095
2096 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2097
2098 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2099 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2100 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2101 msk, BT_LOGICAL, dl, OPTIONAL);
2102
2103 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2104
2105 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2106 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2107 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2108 msk, BT_LOGICAL, dl, OPTIONAL);
2109
2110 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2111
2112 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2113 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2114
2115 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2116
2117 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2118 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2119
2120 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2121
2122 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2123 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2124 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2125 msk, BT_LOGICAL, dl, REQUIRED);
2126
2127 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2128
2129 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2130 int(min). */
2131
2132 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2133 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2134 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2135
2136 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2137 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2138 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2139
2140 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2141 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2142 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2143
2144 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2145 gfc_check_min_max_real, gfc_simplify_min, NULL,
2146 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2147
2148 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2149 gfc_check_min_max_real, gfc_simplify_min, NULL,
2150 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2151
2152 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2153 gfc_check_min_max_double, gfc_simplify_min, NULL,
2154 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2155
2156 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2157
2158 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2159 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2160 x, BT_UNKNOWN, dr, REQUIRED);
2161
2162 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2163
2164 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2165 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2166 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2167 msk, BT_LOGICAL, dl, OPTIONAL);
2168
2169 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2170
2171 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2172 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2173 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2174 msk, BT_LOGICAL, dl, OPTIONAL);
2175
2176 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2177
2178 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2179 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2180 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2181
2182 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2183 NULL, gfc_simplify_mod, gfc_resolve_mod,
2184 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2185
2186 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2187 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2188 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2189
2190 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2191
2192 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2193 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2194 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2195
2196 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2197
2198 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2199 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2200 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2201
2202 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2203
2204 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2205 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2206 a, BT_CHARACTER, dc, REQUIRED);
2207
2208 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2209
2210 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2211 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2212 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2213
2214 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2215 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2216 a, BT_REAL, dd, REQUIRED);
2217
2218 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2219
2220 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2221 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2222 i, BT_INTEGER, di, REQUIRED);
2223
2224 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2225
2226 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2227 gfc_check_null, gfc_simplify_null, NULL,
2228 mo, BT_INTEGER, di, OPTIONAL);
2229
2230 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2231
2232 add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2233 NULL, gfc_simplify_num_images, NULL);
2234
2235 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2236 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2237 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2238 v, BT_REAL, dr, OPTIONAL);
2239
2240 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2241
2242 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2243 gfc_check_precision, gfc_simplify_precision, NULL,
2244 x, BT_UNKNOWN, 0, REQUIRED);
2245
2246 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2247
2248 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2249 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2250 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2251
2252 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2253
2254 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2255 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2256 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2257 msk, BT_LOGICAL, dl, OPTIONAL);
2258
2259 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2260
2261 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2262 gfc_check_radix, gfc_simplify_radix, NULL,
2263 x, BT_UNKNOWN, 0, REQUIRED);
2264
2265 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2266
2267 /* The following function is for G77 compatibility. */
2268 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2269 gfc_check_rand, NULL, NULL,
2270 i, BT_INTEGER, 4, OPTIONAL);
2271
2272 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2273 use slightly different shoddy multiplicative congruential PRNG. */
2274 make_alias ("ran", GFC_STD_GNU);
2275
2276 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2277
2278 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2279 gfc_check_range, gfc_simplify_range, NULL,
2280 x, BT_REAL, dr, REQUIRED);
2281
2282 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2283
2284 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2285 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2286 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2287
2288 /* This provides compatibility with g77. */
2289 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2290 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2291 a, BT_UNKNOWN, dr, REQUIRED);
2292
2293 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2294 gfc_check_float, gfc_simplify_float, NULL,
2295 a, BT_INTEGER, di, REQUIRED);
2296
2297 add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2298 gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2299 a, BT_REAL, dr, REQUIRED);
2300
2301 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2302 gfc_check_sngl, gfc_simplify_sngl, NULL,
2303 a, BT_REAL, dd, REQUIRED);
2304
2305 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2306
2307 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2308 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2309 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2310
2311 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2312
2313 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2314 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2315 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2316
2317 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2318
2319 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2320 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2321 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2322 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2323
2324 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2325
2326 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2327 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2328 x, BT_REAL, dr, REQUIRED);
2329
2330 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2331
2332 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2333 BT_LOGICAL, dl, GFC_STD_F2003,
2334 gfc_check_same_type_as, NULL, NULL,
2335 a, BT_UNKNOWN, 0, REQUIRED,
2336 b, BT_UNKNOWN, 0, REQUIRED);
2337
2338 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2339 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2340 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2341
2342 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2343
2344 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2345 BT_INTEGER, di, GFC_STD_F95,
2346 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2347 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2348 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2349
2350 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2351
2352 /* Added for G77 compatibility garbage. */
2353 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2354 NULL, NULL, NULL);
2355
2356 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2357
2358 /* Added for G77 compatibility. */
2359 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2360 gfc_check_secnds, NULL, gfc_resolve_secnds,
2361 x, BT_REAL, dr, REQUIRED);
2362
2363 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2364
2365 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2366 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2367 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2368 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2369
2370 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2371
2372 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2373 GFC_STD_F95, gfc_check_selected_int_kind,
2374 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2375
2376 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2377
2378 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2379 GFC_STD_F95, gfc_check_selected_real_kind,
2380 gfc_simplify_selected_real_kind, NULL,
2381 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2382 "radix", 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, gfc_resolve_this_image,
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_F2008,
2604 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
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_F2008);
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_flag
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_flag && 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 {
4020 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4021 gfc_typename (&from_ts), gfc_typename (ts),
4022 &expr->where);
4023 }
4024 else if (wflag)
4025 {
4026 if (gfc_option.flag_range_check
4027 && expr->expr_type == EXPR_CONSTANT
4028 && from_ts.type == ts->type)
4029 {
4030 /* Do nothing. Constants of the same type are range-checked
4031 elsewhere. If a value too large for the target type is
4032 assigned, an error is generated. Not checking here avoids
4033 duplications of warnings/errors.
4034 If range checking was disabled, but -Wconversion enabled,
4035 a non range checked warning is generated below. */
4036 }
4037 else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4038 {
4039 /* Do nothing. This block exists only to simplify the other
4040 else-if expressions.
4041 LOGICAL <> LOGICAL no warning, independent of kind values
4042 LOGICAL <> INTEGER extension, warned elsewhere
4043 LOGICAL <> REAL invalid, error generated elsewhere
4044 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4045 }
4046 else if (from_ts.type == ts->type
4047 || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4048 || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4049 || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4050 {
4051 /* Larger kinds can hold values of smaller kinds without problems.
4052 Hence, only warn if target kind is smaller than the source
4053 kind - or if -Wconversion-extra is specified. */
4054 if (gfc_option.warn_conversion_extra)
4055 gfc_warning_now ("Conversion from %s to %s at %L",
4056 gfc_typename (&from_ts), gfc_typename (ts),
4057 &expr->where);
4058 else if (gfc_option.warn_conversion
4059 && from_ts.kind > ts->kind)
4060 gfc_warning_now ("Possible change of value in conversion "
4061 "from %s to %s at %L", gfc_typename (&from_ts),
4062 gfc_typename (ts), &expr->where);
4063 }
4064 else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4065 || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4066 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4067 {
4068 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4069 usually comes with a loss of information, regardless of kinds. */
4070 if (gfc_option.warn_conversion_extra
4071 || gfc_option.warn_conversion)
4072 gfc_warning_now ("Possible change of value in conversion "
4073 "from %s to %s at %L", gfc_typename (&from_ts),
4074 gfc_typename (ts), &expr->where);
4075 }
4076 else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4077 {
4078 /* If HOLLERITH is involved, all bets are off. */
4079 if (gfc_option.warn_conversion_extra
4080 || gfc_option.warn_conversion)
4081 gfc_warning_now ("Conversion from %s to %s at %L",
4082 gfc_typename (&from_ts), gfc_typename (ts),
4083 &expr->where);
4084 }
4085 else
4086 gcc_unreachable ();
4087 }
4088
4089 /* Insert a pre-resolved function call to the right function. */
4090 old_where = expr->where;
4091 rank = expr->rank;
4092 shape = expr->shape;
4093
4094 new_expr = gfc_get_expr ();
4095 *new_expr = *expr;
4096
4097 new_expr = gfc_build_conversion (new_expr);
4098 new_expr->value.function.name = sym->lib_name;
4099 new_expr->value.function.isym = sym;
4100 new_expr->where = old_where;
4101 new_expr->rank = rank;
4102 new_expr->shape = gfc_copy_shape (shape, rank);
4103
4104 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4105 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4106 new_expr->symtree->n.sym->ts = *ts;
4107 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4108 new_expr->symtree->n.sym->attr.function = 1;
4109 new_expr->symtree->n.sym->attr.elemental = 1;
4110 new_expr->symtree->n.sym->attr.pure = 1;
4111 new_expr->symtree->n.sym->attr.referenced = 1;
4112 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4113 gfc_commit_symbol (new_expr->symtree->n.sym);
4114
4115 *expr = *new_expr;
4116
4117 gfc_free (new_expr);
4118 expr->ts = *ts;
4119
4120 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4121 && do_simplify (sym, expr) == FAILURE)
4122 {
4123
4124 if (eflag == 2)
4125 goto bad;
4126 return FAILURE; /* Error already generated in do_simplify() */
4127 }
4128
4129 return SUCCESS;
4130
4131 bad:
4132 if (eflag == 1)
4133 {
4134 gfc_error ("Can't convert %s to %s at %L",
4135 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4136 return FAILURE;
4137 }
4138
4139 gfc_internal_error ("Can't convert %s to %s at %L",
4140 gfc_typename (&from_ts), gfc_typename (ts),
4141 &expr->where);
4142 /* Not reached */
4143 }
4144
4145
4146 gfc_try
4147 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4148 {
4149 gfc_intrinsic_sym *sym;
4150 locus old_where;
4151 gfc_expr *new_expr;
4152 int rank;
4153 mpz_t *shape;
4154
4155 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4156
4157 sym = find_char_conv (&expr->ts, ts);
4158 gcc_assert (sym);
4159
4160 /* Insert a pre-resolved function call to the right function. */
4161 old_where = expr->where;
4162 rank = expr->rank;
4163 shape = expr->shape;
4164
4165 new_expr = gfc_get_expr ();
4166 *new_expr = *expr;
4167
4168 new_expr = gfc_build_conversion (new_expr);
4169 new_expr->value.function.name = sym->lib_name;
4170 new_expr->value.function.isym = sym;
4171 new_expr->where = old_where;
4172 new_expr->rank = rank;
4173 new_expr->shape = gfc_copy_shape (shape, rank);
4174
4175 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4176 new_expr->symtree->n.sym->ts = *ts;
4177 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4178 new_expr->symtree->n.sym->attr.function = 1;
4179 new_expr->symtree->n.sym->attr.elemental = 1;
4180 new_expr->symtree->n.sym->attr.referenced = 1;
4181 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4182 gfc_commit_symbol (new_expr->symtree->n.sym);
4183
4184 *expr = *new_expr;
4185
4186 gfc_free (new_expr);
4187 expr->ts = *ts;
4188
4189 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4190 && do_simplify (sym, expr) == FAILURE)
4191 {
4192 /* Error already generated in do_simplify() */
4193 return FAILURE;
4194 }
4195
4196 return SUCCESS;
4197 }
4198
4199
4200 /* Check if the passed name is name of an intrinsic (taking into account the
4201 current -std=* and -fall-intrinsic settings). If it is, see if we should
4202 warn about this as a user-procedure having the same name as an intrinsic
4203 (-Wintrinsic-shadow enabled) and do so if we should. */
4204
4205 void
4206 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4207 {
4208 gfc_intrinsic_sym* isym;
4209
4210 /* If the warning is disabled, do nothing at all. */
4211 if (!gfc_option.warn_intrinsic_shadow)
4212 return;
4213
4214 /* Try to find an intrinsic of the same name. */
4215 if (func)
4216 isym = gfc_find_function (sym->name);
4217 else
4218 isym = gfc_find_subroutine (sym->name);
4219
4220 /* If no intrinsic was found with this name or it's not included in the
4221 selected standard, everything's fine. */
4222 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4223 sym->declared_at) == FAILURE)
4224 return;
4225
4226 /* Emit the warning. */
4227 if (in_module)
4228 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4229 " name. In order to call the intrinsic, explicit INTRINSIC"
4230 " declarations may be required.",
4231 sym->name, &sym->declared_at);
4232 else
4233 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4234 " only be called via an explicit interface or if declared"
4235 " EXTERNAL.", sym->name, &sym->declared_at);
4236 }
Mirror of the offical gcc git repository hosted at gcc.gnu.org