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