]>
Commit | Line | Data |
---|---|---|
f36327db | 1 | /* gfortran backend interface |
2b65cd83 | 2 | Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010 |
6c7a4dfd | 3 | Free Software Foundation, Inc. |
6de9cd9a DN |
4 | Contributed by Paul Brook. |
5 | ||
9fc4d79b | 6 | This file is part of GCC. |
6de9cd9a | 7 | |
9fc4d79b TS |
8 | GCC is free software; you can redistribute it and/or modify it under |
9 | the terms of the GNU General Public License as published by the Free | |
d234d788 | 10 | Software Foundation; either version 3, or (at your option) any later |
9fc4d79b | 11 | version. |
6de9cd9a | 12 | |
9fc4d79b TS |
13 | GCC is distributed in the hope that it will be useful, but WITHOUT ANY |
14 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 | for more details. | |
6de9cd9a DN |
17 | |
18 | You should have received a copy of the GNU General Public License | |
d234d788 NC |
19 | along with GCC; see the file COPYING3. If not see |
20 | <http://www.gnu.org/licenses/>. */ | |
6de9cd9a DN |
21 | |
22 | /* f95-lang.c-- GCC backend interface stuff */ | |
23 | ||
24 | /* declare required prototypes: */ | |
25 | ||
26 | #include "config.h" | |
d22e4895 | 27 | #include "system.h" |
6de9cd9a DN |
28 | #include "ansidecl.h" |
29 | #include "system.h" | |
30 | #include "coretypes.h" | |
31 | #include "tree.h" | |
726a989a | 32 | #include "gimple.h" |
6de9cd9a DN |
33 | #include "flags.h" |
34 | #include "langhooks.h" | |
35 | #include "langhooks-def.h" | |
36 | #include "timevar.h" | |
37 | #include "tm.h" | |
38 | #include "function.h" | |
39 | #include "ggc.h" | |
40 | #include "toplev.h" | |
41 | #include "target.h" | |
42 | #include "debug.h" | |
43 | #include "diagnostic.h" | |
44 | #include "tree-dump.h" | |
45 | #include "cgraph.h" | |
6de9cd9a | 46 | #include "gfortran.h" |
670637ee | 47 | #include "cpp.h" |
6de9cd9a DN |
48 | #include "trans.h" |
49 | #include "trans-types.h" | |
50 | #include "trans-const.h" | |
51 | ||
6de9cd9a DN |
52 | /* Language-dependent contents of an identifier. */ |
53 | ||
d1b38208 TG |
54 | struct GTY(()) |
55 | lang_identifier { | |
6de9cd9a DN |
56 | struct tree_identifier common; |
57 | }; | |
58 | ||
59 | /* The resulting tree type. */ | |
60 | ||
d1b38208 | 61 | union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), |
726a989a | 62 | chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) |
07beea0d | 63 | |
d1b38208 | 64 | lang_tree_node { |
6de9cd9a DN |
65 | union tree_node GTY((tag ("0"), |
66 | desc ("tree_node_structure (&%h)"))) generic; | |
67 | struct lang_identifier GTY((tag ("1"))) identifier; | |
68 | }; | |
69 | ||
70 | /* Save and restore the variables in this file and elsewhere | |
71 | that keep track of the progress of compilation of the current function. | |
72 | Used for nested functions. */ | |
73 | ||
d1b38208 TG |
74 | struct GTY(()) |
75 | language_function { | |
6de9cd9a | 76 | /* struct gfc_language_function base; */ |
6de9cd9a DN |
77 | struct binding_level *binding_level; |
78 | }; | |
79 | ||
80 | /* We don't have a lex/yacc lexer/parser, but toplev expects these to | |
81 | exist anyway. */ | |
82 | void yyerror (const char *str); | |
83 | int yylex (void); | |
84 | ||
85 | static void gfc_init_decl_processing (void); | |
86 | static void gfc_init_builtin_functions (void); | |
87 | ||
88 | /* Each front end provides its own. */ | |
89 | static bool gfc_init (void); | |
90 | static void gfc_finish (void); | |
91 | static void gfc_print_identifier (FILE *, tree, int); | |
6de9cd9a DN |
92 | void do_function_end (void); |
93 | int global_bindings_p (void); | |
30e257e5 | 94 | static void clear_binding_stack (void); |
6de9cd9a | 95 | static void gfc_be_parse_file (int); |
4862826d | 96 | static alias_set_type gfc_get_alias_set (tree); |
a64f5186 | 97 | static void gfc_init_ts (void); |
6de9cd9a DN |
98 | |
99 | #undef LANG_HOOKS_NAME | |
100 | #undef LANG_HOOKS_INIT | |
101 | #undef LANG_HOOKS_FINISH | |
102 | #undef LANG_HOOKS_INIT_OPTIONS | |
103 | #undef LANG_HOOKS_HANDLE_OPTION | |
104 | #undef LANG_HOOKS_POST_OPTIONS | |
105 | #undef LANG_HOOKS_PRINT_IDENTIFIER | |
106 | #undef LANG_HOOKS_PARSE_FILE | |
6de9cd9a DN |
107 | #undef LANG_HOOKS_MARK_ADDRESSABLE |
108 | #undef LANG_HOOKS_TYPE_FOR_MODE | |
109 | #undef LANG_HOOKS_TYPE_FOR_SIZE | |
7b9c708f | 110 | #undef LANG_HOOKS_GET_ALIAS_SET |
a64f5186 | 111 | #undef LANG_HOOKS_INIT_TS |
6c7a4dfd JJ |
112 | #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE |
113 | #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING | |
cd75853e | 114 | #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR |
a68ab351 JJ |
115 | #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR |
116 | #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP | |
117 | #undef LANG_HOOKS_OMP_CLAUSE_DTOR | |
6c7a4dfd JJ |
118 | #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR |
119 | #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE | |
a68ab351 | 120 | #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF |
6c7a4dfd | 121 | #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES |
c79efc4d | 122 | #undef LANG_HOOKS_BUILTIN_FUNCTION |
fad0afd7 | 123 | #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO |
6de9cd9a DN |
124 | |
125 | /* Define lang hooks. */ | |
3135ce84 | 126 | #define LANG_HOOKS_NAME "GNU Fortran" |
6de9cd9a DN |
127 | #define LANG_HOOKS_INIT gfc_init |
128 | #define LANG_HOOKS_FINISH gfc_finish | |
129 | #define LANG_HOOKS_INIT_OPTIONS gfc_init_options | |
130 | #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option | |
131 | #define LANG_HOOKS_POST_OPTIONS gfc_post_options | |
132 | #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier | |
133 | #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file | |
a64f5186 JJ |
134 | #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode |
135 | #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size | |
136 | #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set | |
137 | #define LANG_HOOKS_INIT_TS gfc_init_ts | |
6c7a4dfd JJ |
138 | #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference |
139 | #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing | |
cd75853e | 140 | #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor |
a68ab351 JJ |
141 | #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor |
142 | #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op | |
143 | #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor | |
6c7a4dfd JJ |
144 | #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr |
145 | #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause | |
a68ab351 | 146 | #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref |
6c7a4dfd JJ |
147 | #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ |
148 | gfc_omp_firstprivatize_type_sizes | |
c79efc4d | 149 | #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function |
fad0afd7 | 150 | #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info |
6de9cd9a | 151 | |
4537ec0c | 152 | struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; |
6de9cd9a | 153 | |
6de9cd9a DN |
154 | #define NULL_BINDING_LEVEL (struct binding_level *) NULL |
155 | ||
156 | /* A chain of binding_level structures awaiting reuse. */ | |
157 | ||
158 | static GTY(()) struct binding_level *free_binding_level; | |
159 | ||
160 | /* The elements of `ridpointers' are identifier nodes | |
161 | for the reserved type names and storage classes. | |
162 | It is indexed by a RID_... value. */ | |
163 | tree *ridpointers = NULL; | |
164 | ||
602b8523 TB |
165 | /* True means we've initialized exception handling. */ |
166 | bool gfc_eh_initialized_p; | |
167 | ||
168 | ||
6de9cd9a DN |
169 | /* Prepare expr to be an argument of a TRUTH_NOT_EXPR, |
170 | or validate its data type for an `if' or `while' statement or ?..: exp. | |
171 | ||
172 | This preparation consists of taking the ordinary | |
173 | representation of an expression expr and producing a valid tree | |
174 | boolean expression describing whether expr is nonzero. We could | |
175 | simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1), | |
176 | but we optimize comparisons, &&, ||, and !. | |
177 | ||
178 | The resulting type should always be `boolean_type_node'. | |
179 | This is much simpler than the corresponding C version because we have a | |
180 | distinct boolean type. */ | |
181 | ||
182 | tree | |
183 | gfc_truthvalue_conversion (tree expr) | |
184 | { | |
185 | switch (TREE_CODE (TREE_TYPE (expr))) | |
186 | { | |
187 | case BOOLEAN_TYPE: | |
188 | if (TREE_TYPE (expr) == boolean_type_node) | |
189 | return expr; | |
6615c446 | 190 | else if (COMPARISON_CLASS_P (expr)) |
6de9cd9a DN |
191 | { |
192 | TREE_TYPE (expr) = boolean_type_node; | |
193 | return expr; | |
194 | } | |
195 | else if (TREE_CODE (expr) == NOP_EXPR) | |
44855d8c TS |
196 | return fold_build1 (NOP_EXPR, |
197 | boolean_type_node, TREE_OPERAND (expr, 0)); | |
6de9cd9a | 198 | else |
44855d8c | 199 | return fold_build1 (NOP_EXPR, boolean_type_node, expr); |
6de9cd9a DN |
200 | |
201 | case INTEGER_TYPE: | |
202 | if (TREE_CODE (expr) == INTEGER_CST) | |
203 | return integer_zerop (expr) ? boolean_false_node : boolean_true_node; | |
204 | else | |
44855d8c TS |
205 | return fold_build2 (NE_EXPR, boolean_type_node, expr, |
206 | build_int_cst (TREE_TYPE (expr), 0)); | |
6de9cd9a DN |
207 | |
208 | default: | |
209 | internal_error ("Unexpected type in truthvalue_conversion"); | |
210 | } | |
211 | } | |
212 | ||
b251af97 | 213 | |
6de9cd9a DN |
214 | static void |
215 | gfc_create_decls (void) | |
216 | { | |
217 | /* GCC builtins. */ | |
218 | gfc_init_builtin_functions (); | |
219 | ||
220 | /* Runtime/IO library functions. */ | |
221 | gfc_build_builtin_function_decls (); | |
222 | ||
223 | gfc_init_constants (); | |
224 | } | |
225 | ||
b251af97 | 226 | |
6de9cd9a DN |
227 | static void |
228 | gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED) | |
229 | { | |
230 | int errors; | |
231 | int warnings; | |
232 | ||
233 | gfc_create_decls (); | |
234 | gfc_parse_file (); | |
235 | gfc_generate_constructors (); | |
236 | ||
df2fba9e | 237 | /* Tell the frontend about any errors. */ |
6de9cd9a DN |
238 | gfc_get_errors (&warnings, &errors); |
239 | errorcount += errors; | |
240 | warningcount += warnings; | |
30e257e5 PB |
241 | |
242 | clear_binding_stack (); | |
6de9cd9a | 243 | } |
b251af97 SK |
244 | |
245 | ||
6de9cd9a DN |
246 | /* Initialize everything. */ |
247 | ||
248 | static bool | |
249 | gfc_init (void) | |
250 | { | |
670637ee DF |
251 | if (!gfc_cpp_enabled ()) |
252 | { | |
253 | linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1); | |
254 | linemap_add (line_table, LC_RENAME, false, "<built-in>", 0); | |
255 | } | |
256 | else | |
257 | gfc_cpp_init_0 (); | |
c8cc8542 | 258 | |
6de9cd9a DN |
259 | gfc_init_decl_processing (); |
260 | gfc_static_ctors = NULL_TREE; | |
261 | ||
670637ee DF |
262 | if (gfc_cpp_enabled ()) |
263 | gfc_cpp_init (); | |
264 | ||
6de9cd9a DN |
265 | gfc_init_1 (); |
266 | ||
e0bcf78c TS |
267 | if (gfc_new_file () != SUCCESS) |
268 | fatal_error ("can't open input file: %s", gfc_source_file); | |
670637ee | 269 | |
6de9cd9a DN |
270 | return true; |
271 | } | |
272 | ||
273 | ||
274 | static void | |
275 | gfc_finish (void) | |
276 | { | |
670637ee | 277 | gfc_cpp_done (); |
6de9cd9a DN |
278 | gfc_done_1 (); |
279 | gfc_release_include_path (); | |
280 | return; | |
281 | } | |
282 | ||
283 | static void | |
284 | gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED, | |
285 | tree node ATTRIBUTE_UNUSED, | |
286 | int indent ATTRIBUTE_UNUSED) | |
287 | { | |
288 | return; | |
289 | } | |
b251af97 | 290 | |
6de9cd9a DN |
291 | |
292 | /* These functions and variables deal with binding contours. We only | |
293 | need these functions for the list of PARM_DECLs, but we leave the | |
294 | functions more general; these are a simplified version of the | |
295 | functions from GNAT. */ | |
296 | ||
b251af97 SK |
297 | /* For each binding contour we allocate a binding_level structure which |
298 | records the entities defined or declared in that contour. Contours | |
299 | include: | |
6de9cd9a DN |
300 | |
301 | the global one | |
302 | one for each subprogram definition | |
303 | one for each compound statement (declare block) | |
304 | ||
305 | Binding contours are used to create GCC tree BLOCK nodes. */ | |
306 | ||
d1b38208 TG |
307 | struct GTY(()) |
308 | binding_level { | |
6de9cd9a DN |
309 | /* A chain of ..._DECL nodes for all variables, constants, functions, |
310 | parameters and type declarations. These ..._DECL nodes are chained | |
311 | through the TREE_CHAIN field. Note that these ..._DECL nodes are stored | |
312 | in the reverse of the order supplied to be compatible with the | |
313 | back-end. */ | |
314 | tree names; | |
315 | /* For each level (except the global one), a chain of BLOCK nodes for all | |
316 | the levels that were entered and exited one level down from this one. */ | |
317 | tree blocks; | |
f7b529fa | 318 | /* The binding level containing this one (the enclosing binding level). */ |
6de9cd9a DN |
319 | struct binding_level *level_chain; |
320 | }; | |
321 | ||
322 | /* The binding level currently in effect. */ | |
323 | static GTY(()) struct binding_level *current_binding_level = NULL; | |
324 | ||
325 | /* The outermost binding level. This binding level is created when the | |
326 | compiler is started and it will exist through the entire compilation. */ | |
327 | static GTY(()) struct binding_level *global_binding_level; | |
328 | ||
329 | /* Binding level structures are initialized by copying this one. */ | |
9dcf6e73 | 330 | static struct binding_level clear_binding_level = { NULL, NULL, NULL }; |
b251af97 SK |
331 | |
332 | ||
13795658 | 333 | /* Return nonzero if we are currently in the global binding level. */ |
6de9cd9a DN |
334 | |
335 | int | |
336 | global_bindings_p (void) | |
337 | { | |
338 | return current_binding_level == global_binding_level ? -1 : 0; | |
339 | } | |
340 | ||
341 | tree | |
342 | getdecls (void) | |
343 | { | |
344 | return current_binding_level->names; | |
345 | } | |
346 | ||
347 | /* Enter a new binding level. The input parameter is ignored, but has to be | |
348 | specified for back-end compatibility. */ | |
349 | ||
350 | void | |
351 | pushlevel (int ignore ATTRIBUTE_UNUSED) | |
352 | { | |
a9429e29 | 353 | struct binding_level *newlevel = ggc_alloc_binding_level (); |
6de9cd9a DN |
354 | |
355 | *newlevel = clear_binding_level; | |
356 | ||
357 | /* Add this level to the front of the chain (stack) of levels that are | |
358 | active. */ | |
359 | newlevel->level_chain = current_binding_level; | |
360 | current_binding_level = newlevel; | |
361 | } | |
362 | ||
363 | /* Exit a binding level. | |
364 | Pop the level off, and restore the state of the identifier-decl mappings | |
365 | that were in effect when this level was entered. | |
366 | ||
367 | If KEEP is nonzero, this level had explicit declarations, so | |
368 | and create a "block" (a BLOCK node) for the level | |
369 | to record its declarations and subblocks for symbol table output. | |
370 | ||
371 | If FUNCTIONBODY is nonzero, this level is the body of a function, | |
372 | so create a block as if KEEP were set and also clear out all | |
373 | label names. | |
374 | ||
375 | If REVERSE is nonzero, reverse the order of decls before putting | |
376 | them into the BLOCK. */ | |
377 | ||
378 | tree | |
379 | poplevel (int keep, int reverse, int functionbody) | |
380 | { | |
1f2959f0 | 381 | /* Points to a BLOCK tree node. This is the BLOCK node constructed for the |
6de9cd9a DN |
382 | binding level that we are about to exit and which is returned by this |
383 | routine. */ | |
384 | tree block_node = NULL_TREE; | |
385 | tree decl_chain; | |
386 | tree subblock_chain = current_binding_level->blocks; | |
387 | tree subblock_node; | |
6de9cd9a DN |
388 | |
389 | /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL | |
390 | nodes chained through the `names' field of current_binding_level are in | |
1f2959f0 | 391 | reverse order except for PARM_DECL node, which are explicitly stored in |
6de9cd9a DN |
392 | the right order. */ |
393 | decl_chain = (reverse) ? nreverse (current_binding_level->names) | |
b251af97 | 394 | : current_binding_level->names; |
6de9cd9a | 395 | |
6de9cd9a DN |
396 | /* If there were any declarations in the current binding level, or if this |
397 | binding level is a function body, or if there are any nested blocks then | |
398 | create a BLOCK node to record them for the life of this function. */ | |
9dcf6e73 | 399 | if (keep || functionbody) |
22e8617b | 400 | block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0); |
6de9cd9a DN |
401 | |
402 | /* Record the BLOCK node just built as the subblock its enclosing scope. */ | |
403 | for (subblock_node = subblock_chain; subblock_node; | |
404 | subblock_node = TREE_CHAIN (subblock_node)) | |
405 | BLOCK_SUPERCONTEXT (subblock_node) = block_node; | |
406 | ||
407 | /* Clear out the meanings of the local variables of this level. */ | |
408 | ||
409 | for (subblock_node = decl_chain; subblock_node; | |
410 | subblock_node = TREE_CHAIN (subblock_node)) | |
411 | if (DECL_NAME (subblock_node) != 0) | |
412 | /* If the identifier was used or addressed via a local extern decl, | |
f7b529fa | 413 | don't forget that fact. */ |
6de9cd9a DN |
414 | if (DECL_EXTERNAL (subblock_node)) |
415 | { | |
416 | if (TREE_USED (subblock_node)) | |
417 | TREE_USED (DECL_NAME (subblock_node)) = 1; | |
418 | if (TREE_ADDRESSABLE (subblock_node)) | |
419 | TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1; | |
420 | } | |
421 | ||
422 | /* Pop the current level. */ | |
423 | current_binding_level = current_binding_level->level_chain; | |
424 | ||
425 | if (functionbody) | |
c7c79a09 JJ |
426 | /* This is the top level block of a function. */ |
427 | DECL_INITIAL (current_function_decl) = block_node; | |
77092cda JJ |
428 | else if (current_binding_level == global_binding_level) |
429 | /* When using gfc_start_block/gfc_finish_block from middle-end hooks, | |
df2fba9e | 430 | don't add newly created BLOCKs as subblocks of global_binding_level. */ |
77092cda | 431 | ; |
6de9cd9a DN |
432 | else if (block_node) |
433 | { | |
9dcf6e73 JM |
434 | current_binding_level->blocks |
435 | = chainon (current_binding_level->blocks, block_node); | |
6de9cd9a DN |
436 | } |
437 | ||
438 | /* If we did not make a block for the level just exited, any blocks made for | |
439 | inner levels (since they cannot be recorded as subblocks in that level) | |
440 | must be carried forward so they will later become subblocks of something | |
441 | else. */ | |
442 | else if (subblock_chain) | |
443 | current_binding_level->blocks | |
444 | = chainon (current_binding_level->blocks, subblock_chain); | |
445 | if (block_node) | |
446 | TREE_USED (block_node) = 1; | |
447 | ||
448 | return block_node; | |
449 | } | |
b251af97 SK |
450 | |
451 | ||
6de9cd9a | 452 | /* Records a ..._DECL node DECL as belonging to the current lexical scope. |
f7b529fa | 453 | Returns the ..._DECL node. */ |
6de9cd9a DN |
454 | |
455 | tree | |
456 | pushdecl (tree decl) | |
457 | { | |
458 | /* External objects aren't nested, other objects may be. */ | |
459 | if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl)) | |
460 | DECL_CONTEXT (decl) = 0; | |
461 | else | |
462 | DECL_CONTEXT (decl) = current_function_decl; | |
463 | ||
464 | /* Put the declaration on the list. The list of declarations is in reverse | |
465 | order. The list will be reversed later if necessary. This needs to be | |
466 | this way for compatibility with the back-end. */ | |
467 | ||
468 | TREE_CHAIN (decl) = current_binding_level->names; | |
469 | current_binding_level->names = decl; | |
470 | ||
69de3b83 | 471 | /* For the declaration of a type, set its name if it is not already set. */ |
6de9cd9a DN |
472 | |
473 | if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0) | |
474 | { | |
475 | if (DECL_SOURCE_LINE (decl) == 0) | |
476 | TYPE_NAME (TREE_TYPE (decl)) = decl; | |
477 | else | |
478 | TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl); | |
479 | } | |
480 | ||
481 | return decl; | |
482 | } | |
483 | ||
484 | ||
485 | /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */ | |
486 | ||
487 | tree | |
488 | pushdecl_top_level (tree x) | |
489 | { | |
490 | tree t; | |
491 | struct binding_level *b = current_binding_level; | |
492 | ||
493 | current_binding_level = global_binding_level; | |
494 | t = pushdecl (x); | |
495 | current_binding_level = b; | |
496 | return t; | |
497 | } | |
498 | ||
499 | ||
9dcf6e73 JM |
500 | /* Clear the binding stack. */ |
501 | static void | |
30e257e5 | 502 | clear_binding_stack (void) |
9dcf6e73 JM |
503 | { |
504 | while (!global_bindings_p ()) | |
505 | poplevel (0, 0, 0); | |
506 | } | |
507 | ||
508 | ||
6de9cd9a DN |
509 | #ifndef CHAR_TYPE_SIZE |
510 | #define CHAR_TYPE_SIZE BITS_PER_UNIT | |
511 | #endif | |
512 | ||
513 | #ifndef INT_TYPE_SIZE | |
514 | #define INT_TYPE_SIZE BITS_PER_WORD | |
515 | #endif | |
516 | ||
517 | #undef SIZE_TYPE | |
518 | #define SIZE_TYPE "long unsigned int" | |
519 | ||
520 | /* Create tree nodes for the basic scalar types of Fortran 95, | |
521 | and some nodes representing standard constants (0, 1, (void *) 0). | |
522 | Initialize the global binding level. | |
523 | Make definitions for built-in primitive functions. */ | |
524 | static void | |
525 | gfc_init_decl_processing (void) | |
526 | { | |
527 | current_function_decl = NULL; | |
6de9cd9a DN |
528 | current_binding_level = NULL_BINDING_LEVEL; |
529 | free_binding_level = NULL_BINDING_LEVEL; | |
530 | ||
531 | /* Make the binding_level structure for global names. We move all | |
532 | variables that are in a COMMON block to this binding level. */ | |
533 | pushlevel (0); | |
534 | global_binding_level = current_binding_level; | |
535 | ||
536 | /* Build common tree nodes. char_type_node is unsigned because we | |
537 | only use it for actual characters, not for INTEGER(1). Also, we | |
f7b529fa | 538 | want double_type_node to actually have double precision. */ |
3b9e5d95 | 539 | build_common_tree_nodes (false); |
df2fba9e | 540 | /* x86_64 mingw32 has a sizetype of "unsigned long long", most other hosts |
fcdb5d68 KT |
541 | have a sizetype of "unsigned long". Therefore choose the correct size |
542 | in mostly target independent way. */ | |
6384205f | 543 | if (TYPE_MODE (long_unsigned_type_node) == ptr_mode) |
fcdb5d68 | 544 | set_sizetype (long_unsigned_type_node); |
6384205f | 545 | else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode) |
fcdb5d68 KT |
546 | set_sizetype (long_long_unsigned_type_node); |
547 | else | |
548 | set_sizetype (long_unsigned_type_node); | |
6de9cd9a | 549 | build_common_tree_nodes_2 (0); |
24cc1193 | 550 | void_list_node = build_tree_list (NULL_TREE, void_type_node); |
6de9cd9a DN |
551 | |
552 | /* Set up F95 type nodes. */ | |
5e8e542f | 553 | gfc_init_kinds (); |
6de9cd9a DN |
554 | gfc_init_types (); |
555 | } | |
556 | ||
b251af97 | 557 | |
7b9c708f JJ |
558 | /* Return the typed-based alias set for T, which may be an expression |
559 | or a type. Return -1 if we don't do anything special. */ | |
560 | ||
4862826d | 561 | static alias_set_type |
7b9c708f JJ |
562 | gfc_get_alias_set (tree t) |
563 | { | |
564 | tree u; | |
565 | ||
566 | /* Permit type-punning when accessing an EQUIVALENCEd variable or | |
567 | mixed type entry master's return value. */ | |
568 | for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0)) | |
569 | if (TREE_CODE (u) == COMPONENT_REF | |
570 | && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE) | |
571 | return 0; | |
572 | ||
573 | return -1; | |
574 | } | |
575 | ||
b251af97 | 576 | |
6de9cd9a DN |
577 | /* press the big red button - garbage (ggc) collection is on */ |
578 | ||
579 | int ggc_p = 1; | |
580 | ||
1f2959f0 | 581 | /* Builtin function initialization. */ |
6de9cd9a | 582 | |
6de9cd9a | 583 | tree |
c79efc4d | 584 | gfc_builtin_function (tree decl) |
6de9cd9a | 585 | { |
0e6df31e | 586 | make_decl_rtl (decl); |
6de9cd9a | 587 | pushdecl (decl); |
6de9cd9a DN |
588 | return decl; |
589 | } | |
590 | ||
591 | ||
592 | static void | |
b251af97 | 593 | gfc_define_builtin (const char *name, |
6de9cd9a DN |
594 | tree type, |
595 | int code, | |
b251af97 | 596 | const char *library_name, |
6de9cd9a DN |
597 | bool const_p) |
598 | { | |
599 | tree decl; | |
600 | ||
c79efc4d RÁE |
601 | decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL, |
602 | library_name, NULL_TREE); | |
6de9cd9a DN |
603 | if (const_p) |
604 | TREE_READONLY (decl) = 1; | |
2b65cd83 | 605 | TREE_NOTHROW (decl) = 1; |
6de9cd9a DN |
606 | |
607 | built_in_decls[code] = decl; | |
608 | implicit_built_in_decls[code] = decl; | |
609 | } | |
610 | ||
611 | ||
e8525382 | 612 | #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \ |
644cb69f FXC |
613 | gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \ |
614 | BUILT_IN_ ## code ## L, name "l", true); \ | |
e8525382 | 615 | gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \ |
6de9cd9a | 616 | BUILT_IN_ ## code, name, true); \ |
e8525382 | 617 | gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \ |
6de9cd9a DN |
618 | BUILT_IN_ ## code ## F, name "f", true); |
619 | ||
e8525382 SK |
620 | #define DEFINE_MATH_BUILTIN(code, name, argtype) \ |
621 | DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) | |
622 | ||
e8525382 | 623 | #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \ |
644cb69f FXC |
624 | DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \ |
625 | DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c) | |
e8525382 SK |
626 | |
627 | ||
628 | /* Create function types for builtin functions. */ | |
629 | ||
630 | static void | |
b251af97 | 631 | build_builtin_fntypes (tree *fntype, tree type) |
e8525382 | 632 | { |
e8525382 | 633 | /* type (*) (type) */ |
b64fca63 | 634 | fntype[0] = build_function_type_list (type, type, NULL_TREE); |
e8525382 | 635 | /* type (*) (type, type) */ |
b64fca63 | 636 | fntype[1] = build_function_type_list (type, type, type, NULL_TREE); |
b5a4419c | 637 | /* type (*) (type, int) */ |
b64fca63 NF |
638 | fntype[2] = build_function_type_list (type, |
639 | type, integer_type_node, NULL_TREE); | |
640 | /* type (*) (void) */ | |
641 | fntype[3] = build_function_type_list (type, NULL_TREE); | |
642 | /* type (*) (&int, type) */ | |
643 | fntype[4] = build_function_type_list (type, | |
644 | build_pointer_type (integer_type_node), | |
645 | type, | |
646 | NULL_TREE); | |
647 | /* type (*) (int, type) */ | |
648 | fntype[5] = build_function_type_list (type, | |
649 | integer_type_node, type, NULL_TREE); | |
e8525382 SK |
650 | } |
651 | ||
b251af97 | 652 | |
6c7a4dfd JJ |
653 | static tree |
654 | builtin_type_for_size (int size, bool unsignedp) | |
655 | { | |
656 | tree type = lang_hooks.types.type_for_size (size, unsignedp); | |
657 | return type ? type : error_mark_node; | |
658 | } | |
e8525382 | 659 | |
1f2959f0 | 660 | /* Initialization of builtin function nodes. */ |
e8525382 | 661 | |
6de9cd9a DN |
662 | static void |
663 | gfc_init_builtin_functions (void) | |
664 | { | |
6c7a4dfd JJ |
665 | enum builtin_type |
666 | { | |
667 | #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME, | |
668 | #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME, | |
669 | #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME, | |
670 | #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME, | |
671 | #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME, | |
672 | #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME, | |
673 | #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME, | |
674 | #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME, | |
675 | #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME, | |
676 | #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME, | |
677 | #define DEF_POINTER_TYPE(NAME, TYPE) NAME, | |
678 | #include "types.def" | |
679 | #undef DEF_PRIMITIVE_TYPE | |
680 | #undef DEF_FUNCTION_TYPE_0 | |
681 | #undef DEF_FUNCTION_TYPE_1 | |
682 | #undef DEF_FUNCTION_TYPE_2 | |
683 | #undef DEF_FUNCTION_TYPE_3 | |
684 | #undef DEF_FUNCTION_TYPE_4 | |
685 | #undef DEF_FUNCTION_TYPE_5 | |
686 | #undef DEF_FUNCTION_TYPE_6 | |
687 | #undef DEF_FUNCTION_TYPE_7 | |
688 | #undef DEF_FUNCTION_TYPE_VAR_0 | |
689 | #undef DEF_POINTER_TYPE | |
690 | BT_LAST | |
691 | }; | |
692 | typedef enum builtin_type builtin_type; | |
693 | enum | |
694 | { | |
695 | /* So far we need just these 2 attribute types. */ | |
696 | ATTR_NOTHROW_LIST, | |
697 | ATTR_CONST_NOTHROW_LIST | |
698 | }; | |
699 | ||
b5a4419c FXC |
700 | tree mfunc_float[6]; |
701 | tree mfunc_double[6]; | |
702 | tree mfunc_longdouble[6]; | |
703 | tree mfunc_cfloat[6]; | |
704 | tree mfunc_cdouble[6]; | |
705 | tree mfunc_clongdouble[6]; | |
3a53e165 RG |
706 | tree func_cfloat_float, func_float_cfloat; |
707 | tree func_cdouble_double, func_double_cdouble; | |
708 | tree func_clongdouble_longdouble, func_longdouble_clongdouble; | |
709 | tree func_float_floatp_floatp; | |
710 | tree func_double_doublep_doublep; | |
711 | tree func_longdouble_longdoublep_longdoublep; | |
712 | tree ftype, ptype; | |
6c7a4dfd | 713 | tree builtin_types[(int) BT_LAST + 1]; |
6de9cd9a | 714 | |
e8525382 SK |
715 | build_builtin_fntypes (mfunc_float, float_type_node); |
716 | build_builtin_fntypes (mfunc_double, double_type_node); | |
644cb69f | 717 | build_builtin_fntypes (mfunc_longdouble, long_double_type_node); |
e8525382 SK |
718 | build_builtin_fntypes (mfunc_cfloat, complex_float_type_node); |
719 | build_builtin_fntypes (mfunc_cdouble, complex_double_type_node); | |
644cb69f | 720 | build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node); |
e8525382 | 721 | |
b64fca63 NF |
722 | func_cfloat_float = build_function_type_list (float_type_node, |
723 | complex_float_type_node, | |
724 | NULL_TREE); | |
6de9cd9a | 725 | |
b64fca63 NF |
726 | func_float_cfloat = build_function_type_list (complex_float_type_node, |
727 | float_type_node, NULL_TREE); | |
3a53e165 | 728 | |
b64fca63 NF |
729 | func_cdouble_double = build_function_type_list (double_type_node, |
730 | complex_double_type_node, | |
731 | NULL_TREE); | |
6de9cd9a | 732 | |
b64fca63 NF |
733 | func_double_cdouble = build_function_type_list (complex_double_type_node, |
734 | double_type_node, NULL_TREE); | |
3a53e165 | 735 | |
644cb69f | 736 | func_clongdouble_longdouble = |
b64fca63 NF |
737 | build_function_type_list (long_double_type_node, |
738 | complex_long_double_type_node, NULL_TREE); | |
644cb69f | 739 | |
3a53e165 | 740 | func_longdouble_clongdouble = |
b64fca63 NF |
741 | build_function_type_list (complex_long_double_type_node, |
742 | long_double_type_node, NULL_TREE); | |
3a53e165 RG |
743 | |
744 | ptype = build_pointer_type (float_type_node); | |
3a53e165 | 745 | func_float_floatp_floatp = |
b64fca63 | 746 | build_function_type_list (void_type_node, ptype, ptype, NULL_TREE); |
3a53e165 RG |
747 | |
748 | ptype = build_pointer_type (double_type_node); | |
3a53e165 | 749 | func_double_doublep_doublep = |
b64fca63 | 750 | build_function_type_list (void_type_node, ptype, ptype, NULL_TREE); |
3a53e165 RG |
751 | |
752 | ptype = build_pointer_type (long_double_type_node); | |
3a53e165 | 753 | func_longdouble_longdoublep_longdoublep = |
b64fca63 | 754 | build_function_type_list (void_type_node, ptype, ptype, NULL_TREE); |
3a53e165 | 755 | |
2921157d FXC |
756 | /* Non-math builtins are defined manually, so they're not included here. */ |
757 | #define OTHER_BUILTIN(ID,NAME,TYPE) | |
758 | ||
6de9cd9a DN |
759 | #include "mathbuiltins.def" |
760 | ||
644cb69f FXC |
761 | gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], |
762 | BUILT_IN_ROUNDL, "roundl", true); | |
6de9cd9a DN |
763 | gfc_define_builtin ("__builtin_round", mfunc_double[0], |
764 | BUILT_IN_ROUND, "round", true); | |
765 | gfc_define_builtin ("__builtin_roundf", mfunc_float[0], | |
766 | BUILT_IN_ROUNDF, "roundf", true); | |
644cb69f FXC |
767 | |
768 | gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0], | |
769 | BUILT_IN_TRUNCL, "truncl", true); | |
e743d142 TS |
770 | gfc_define_builtin ("__builtin_trunc", mfunc_double[0], |
771 | BUILT_IN_TRUNC, "trunc", true); | |
772 | gfc_define_builtin ("__builtin_truncf", mfunc_float[0], | |
773 | BUILT_IN_TRUNCF, "truncf", true); | |
774 | ||
644cb69f FXC |
775 | gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, |
776 | BUILT_IN_CABSL, "cabsl", true); | |
ead6d15f AP |
777 | gfc_define_builtin ("__builtin_cabs", func_cdouble_double, |
778 | BUILT_IN_CABS, "cabs", true); | |
779 | gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, | |
780 | BUILT_IN_CABSF, "cabsf", true); | |
c6a912da | 781 | |
644cb69f FXC |
782 | gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], |
783 | BUILT_IN_COPYSIGNL, "copysignl", true); | |
ead6d15f AP |
784 | gfc_define_builtin ("__builtin_copysign", mfunc_double[1], |
785 | BUILT_IN_COPYSIGN, "copysign", true); | |
786 | gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], | |
787 | BUILT_IN_COPYSIGNF, "copysignf", true); | |
58b6e047 | 788 | |
b5a4419c FXC |
789 | gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1], |
790 | BUILT_IN_NEXTAFTERL, "nextafterl", true); | |
791 | gfc_define_builtin ("__builtin_nextafter", mfunc_double[1], | |
792 | BUILT_IN_NEXTAFTER, "nextafter", true); | |
793 | gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1], | |
794 | BUILT_IN_NEXTAFTERF, "nextafterf", true); | |
795 | ||
796 | gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], | |
797 | BUILT_IN_FREXPL, "frexpl", false); | |
798 | gfc_define_builtin ("__builtin_frexp", mfunc_double[4], | |
799 | BUILT_IN_FREXP, "frexp", false); | |
800 | gfc_define_builtin ("__builtin_frexpf", mfunc_float[4], | |
801 | BUILT_IN_FREXPF, "frexpf", false); | |
802 | ||
803 | gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0], | |
804 | BUILT_IN_FABSL, "fabsl", true); | |
805 | gfc_define_builtin ("__builtin_fabs", mfunc_double[0], | |
806 | BUILT_IN_FABS, "fabs", true); | |
807 | gfc_define_builtin ("__builtin_fabsf", mfunc_float[0], | |
808 | BUILT_IN_FABSF, "fabsf", true); | |
809 | ||
810 | gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5], | |
811 | BUILT_IN_SCALBNL, "scalbnl", true); | |
812 | gfc_define_builtin ("__builtin_scalbn", mfunc_double[5], | |
813 | BUILT_IN_SCALBN, "scalbn", true); | |
814 | gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5], | |
815 | BUILT_IN_SCALBNF, "scalbnf", true); | |
816 | ||
58b6e047 PT |
817 | gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], |
818 | BUILT_IN_FMODL, "fmodl", true); | |
819 | gfc_define_builtin ("__builtin_fmod", mfunc_double[1], | |
820 | BUILT_IN_FMOD, "fmod", true); | |
821 | gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], | |
822 | BUILT_IN_FMODF, "fmodf", true); | |
6de9cd9a | 823 | |
f6d53468 UW |
824 | gfc_define_builtin ("__builtin_huge_vall", mfunc_longdouble[3], |
825 | BUILT_IN_HUGE_VALL, "__builtin_huge_vall", true); | |
826 | gfc_define_builtin ("__builtin_huge_val", mfunc_double[3], | |
827 | BUILT_IN_HUGE_VAL, "__builtin_huge_val", true); | |
828 | gfc_define_builtin ("__builtin_huge_valf", mfunc_float[3], | |
829 | BUILT_IN_HUGE_VALF, "__builtin_huge_valf", true); | |
b5a4419c | 830 | |
94f548c2 | 831 | /* lround{f,,l} and llround{f,,l} */ |
b64fca63 NF |
832 | ftype = build_function_type_list (long_integer_type_node, |
833 | float_type_node, NULL_TREE); | |
834 | gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF, | |
94f548c2 | 835 | "lroundf", true); |
b64fca63 NF |
836 | ftype = build_function_type_list (long_long_integer_type_node, |
837 | float_type_node, NULL_TREE); | |
838 | gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF, | |
94f548c2 FXC |
839 | "llroundf", true); |
840 | ||
b64fca63 NF |
841 | ftype = build_function_type_list (long_integer_type_node, |
842 | double_type_node, NULL_TREE); | |
843 | gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND, | |
94f548c2 | 844 | "lround", true); |
b64fca63 NF |
845 | ftype = build_function_type_list (long_long_integer_type_node, |
846 | double_type_node, NULL_TREE); | |
847 | gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND, | |
94f548c2 FXC |
848 | "llround", true); |
849 | ||
b64fca63 NF |
850 | ftype = build_function_type_list (long_integer_type_node, |
851 | long_double_type_node, NULL_TREE); | |
852 | gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL, | |
94f548c2 | 853 | "lroundl", true); |
b64fca63 NF |
854 | ftype = build_function_type_list (long_long_integer_type_node, |
855 | long_double_type_node, NULL_TREE); | |
856 | gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL, | |
94f548c2 FXC |
857 | "llroundl", true); |
858 | ||
5b200ac2 | 859 | /* These are used to implement the ** operator. */ |
644cb69f FXC |
860 | gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], |
861 | BUILT_IN_POWL, "powl", true); | |
c7d78bbe | 862 | gfc_define_builtin ("__builtin_pow", mfunc_double[1], |
5b200ac2 | 863 | BUILT_IN_POW, "pow", true); |
c7d78bbe | 864 | gfc_define_builtin ("__builtin_powf", mfunc_float[1], |
5b200ac2 | 865 | BUILT_IN_POWF, "powf", true); |
fb220235 FXC |
866 | gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1], |
867 | BUILT_IN_CPOWL, "cpowl", true); | |
868 | gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1], | |
869 | BUILT_IN_CPOW, "cpow", true); | |
870 | gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1], | |
871 | BUILT_IN_CPOWF, "cpowf", true); | |
31c97dfe JB |
872 | gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2], |
873 | BUILT_IN_POWIL, "powil", true); | |
874 | gfc_define_builtin ("__builtin_powi", mfunc_double[2], | |
875 | BUILT_IN_POWI, "powi", true); | |
876 | gfc_define_builtin ("__builtin_powif", mfunc_float[2], | |
877 | BUILT_IN_POWIF, "powif", true); | |
878 | ||
5b200ac2 | 879 | |
3a53e165 RG |
880 | if (TARGET_C99_FUNCTIONS) |
881 | { | |
882 | gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0], | |
883 | BUILT_IN_CBRTL, "cbrtl", true); | |
884 | gfc_define_builtin ("__builtin_cbrt", mfunc_double[0], | |
885 | BUILT_IN_CBRT, "cbrt", true); | |
886 | gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0], | |
887 | BUILT_IN_CBRTF, "cbrtf", true); | |
888 | gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble, | |
889 | BUILT_IN_CEXPIL, "cexpil", true); | |
890 | gfc_define_builtin ("__builtin_cexpi", func_double_cdouble, | |
891 | BUILT_IN_CEXPI, "cexpi", true); | |
892 | gfc_define_builtin ("__builtin_cexpif", func_float_cfloat, | |
893 | BUILT_IN_CEXPIF, "cexpif", true); | |
894 | } | |
895 | ||
896 | if (TARGET_HAS_SINCOS) | |
897 | { | |
898 | gfc_define_builtin ("__builtin_sincosl", | |
899 | func_longdouble_longdoublep_longdoublep, | |
900 | BUILT_IN_SINCOSL, "sincosl", false); | |
901 | gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep, | |
902 | BUILT_IN_SINCOS, "sincos", false); | |
903 | gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp, | |
904 | BUILT_IN_SINCOSF, "sincosf", false); | |
905 | } | |
906 | ||
414f00e9 | 907 | /* For LEADZ / TRAILZ. */ |
b64fca63 NF |
908 | ftype = build_function_type_list (integer_type_node, |
909 | unsigned_type_node, NULL_TREE); | |
414f00e9 SB |
910 | gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, |
911 | "__builtin_clz", true); | |
414f00e9 SB |
912 | gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ, |
913 | "__builtin_ctz", true); | |
914 | ||
b64fca63 NF |
915 | ftype = build_function_type_list (integer_type_node, |
916 | long_unsigned_type_node, NULL_TREE); | |
917 | gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, | |
918 | "__builtin_clzl", true); | |
414f00e9 SB |
919 | gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL, |
920 | "__builtin_ctzl", true); | |
921 | ||
b64fca63 NF |
922 | ftype = build_function_type_list (integer_type_node, |
923 | long_long_unsigned_type_node, NULL_TREE); | |
924 | gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, | |
925 | "__builtin_clzll", true); | |
414f00e9 SB |
926 | gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL, |
927 | "__builtin_ctzll", true); | |
928 | ||
6de9cd9a DN |
929 | /* Other builtin functions we use. */ |
930 | ||
b64fca63 NF |
931 | ftype = build_function_type_list (long_integer_type_node, |
932 | long_integer_type_node, | |
933 | long_integer_type_node, NULL_TREE); | |
c6a912da RH |
934 | gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT, |
935 | "__builtin_expect", true); | |
ef9312c1 | 936 | |
b64fca63 NF |
937 | ftype = build_function_type_list (void_type_node, |
938 | pvoid_type_node, NULL_TREE); | |
1529b8d9 FXC |
939 | gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE, |
940 | "free", false); | |
941 | ||
b64fca63 NF |
942 | ftype = build_function_type_list (pvoid_type_node, |
943 | size_type_node, NULL_TREE); | |
1529b8d9 FXC |
944 | gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC, |
945 | "malloc", false); | |
946 | DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1; | |
947 | ||
b64fca63 NF |
948 | ftype = build_function_type_list (pvoid_type_node, |
949 | size_type_node, pvoid_type_node, | |
950 | NULL_TREE); | |
4376b7cf FXC |
951 | gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC, |
952 | "realloc", false); | |
953 | ||
b64fca63 NF |
954 | ftype = build_function_type_list (integer_type_node, |
955 | void_type_node, NULL_TREE); | |
5fcb93f1 FXC |
956 | gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN, |
957 | "__builtin_isnan", true); | |
958 | ||
6c7a4dfd JJ |
959 | #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \ |
960 | builtin_types[(int) ENUM] = VALUE; | |
b64fca63 NF |
961 | #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \ |
962 | builtin_types[(int) ENUM] \ | |
963 | = build_function_type_list (builtin_types[(int) RETURN], \ | |
964 | NULL_TREE); | |
6c7a4dfd JJ |
965 | #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \ |
966 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
967 | = build_function_type_list (builtin_types[(int) RETURN], \ |
968 | builtin_types[(int) ARG1], \ | |
969 | NULL_TREE); | |
970 | #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \ | |
971 | builtin_types[(int) ENUM] \ | |
972 | = build_function_type_list (builtin_types[(int) RETURN], \ | |
973 | builtin_types[(int) ARG1], \ | |
974 | builtin_types[(int) ARG2], \ | |
975 | NULL_TREE); | |
976 | #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \ | |
977 | builtin_types[(int) ENUM] \ | |
978 | = build_function_type_list (builtin_types[(int) RETURN], \ | |
979 | builtin_types[(int) ARG1], \ | |
980 | builtin_types[(int) ARG2], \ | |
981 | builtin_types[(int) ARG3], \ | |
982 | NULL_TREE); | |
6c7a4dfd JJ |
983 | #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \ |
984 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
985 | = build_function_type_list (builtin_types[(int) RETURN], \ |
986 | builtin_types[(int) ARG1], \ | |
987 | builtin_types[(int) ARG2], \ | |
988 | builtin_types[(int) ARG3], \ | |
989 | builtin_types[(int) ARG4], \ | |
990 | NULL_TREE); | |
6c7a4dfd JJ |
991 | #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \ |
992 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
993 | = build_function_type_list (builtin_types[(int) RETURN], \ |
994 | builtin_types[(int) ARG1], \ | |
995 | builtin_types[(int) ARG2], \ | |
996 | builtin_types[(int) ARG3], \ | |
997 | builtin_types[(int) ARG4], \ | |
998 | builtin_types[(int) ARG5], \ | |
999 | NULL_TREE); | |
6c7a4dfd JJ |
1000 | #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ |
1001 | ARG6) \ | |
1002 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
1003 | = build_function_type_list (builtin_types[(int) RETURN], \ |
1004 | builtin_types[(int) ARG1], \ | |
1005 | builtin_types[(int) ARG2], \ | |
1006 | builtin_types[(int) ARG3], \ | |
1007 | builtin_types[(int) ARG4], \ | |
1008 | builtin_types[(int) ARG5], \ | |
1009 | builtin_types[(int) ARG6], \ | |
1010 | NULL_TREE); | |
6c7a4dfd JJ |
1011 | #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ |
1012 | ARG6, ARG7) \ | |
1013 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
1014 | = build_function_type_list (builtin_types[(int) RETURN], \ |
1015 | builtin_types[(int) ARG1], \ | |
1016 | builtin_types[(int) ARG2], \ | |
1017 | builtin_types[(int) ARG3], \ | |
1018 | builtin_types[(int) ARG4], \ | |
1019 | builtin_types[(int) ARG5], \ | |
1020 | builtin_types[(int) ARG6], \ | |
1021 | builtin_types[(int) ARG7], \ | |
1022 | NULL_TREE); | |
6c7a4dfd JJ |
1023 | #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \ |
1024 | builtin_types[(int) ENUM] \ | |
b64fca63 NF |
1025 | = build_varargs_function_type_list (builtin_types[(int) RETURN], \ |
1026 | NULL_TREE); | |
6c7a4dfd JJ |
1027 | #define DEF_POINTER_TYPE(ENUM, TYPE) \ |
1028 | builtin_types[(int) ENUM] \ | |
1029 | = build_pointer_type (builtin_types[(int) TYPE]); | |
1030 | #include "types.def" | |
1031 | #undef DEF_PRIMITIVE_TYPE | |
1032 | #undef DEF_FUNCTION_TYPE_1 | |
1033 | #undef DEF_FUNCTION_TYPE_2 | |
1034 | #undef DEF_FUNCTION_TYPE_3 | |
1035 | #undef DEF_FUNCTION_TYPE_4 | |
1036 | #undef DEF_FUNCTION_TYPE_5 | |
1037 | #undef DEF_FUNCTION_TYPE_6 | |
1038 | #undef DEF_FUNCTION_TYPE_VAR_0 | |
1039 | #undef DEF_POINTER_TYPE | |
1040 | builtin_types[(int) BT_LAST] = NULL_TREE; | |
1041 | ||
1042 | /* Initialize synchronization builtins. */ | |
1043 | #undef DEF_SYNC_BUILTIN | |
1044 | #define DEF_SYNC_BUILTIN(code, name, type, attr) \ | |
1045 | gfc_define_builtin (name, builtin_types[type], code, name, \ | |
1046 | attr == ATTR_CONST_NOTHROW_LIST); | |
1047 | #include "../sync-builtins.def" | |
1048 | #undef DEF_SYNC_BUILTIN | |
1049 | ||
e0e8ce7a | 1050 | if (gfc_option.flag_openmp || flag_tree_parallelize_loops) |
6c7a4dfd JJ |
1051 | { |
1052 | #undef DEF_GOMP_BUILTIN | |
1053 | #define DEF_GOMP_BUILTIN(code, name, type, attr) \ | |
1054 | gfc_define_builtin ("__builtin_" name, builtin_types[type], \ | |
1055 | code, name, attr == ATTR_CONST_NOTHROW_LIST); | |
1056 | #include "../omp-builtins.def" | |
1057 | #undef DEF_GOMP_BUILTIN | |
1058 | } | |
1059 | ||
1060 | gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID], | |
1061 | BUILT_IN_TRAP, NULL, false); | |
1062 | TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1; | |
1063 | ||
8893239d RH |
1064 | gfc_define_builtin ("__emutls_get_address", |
1065 | builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS, | |
1066 | "__emutls_get_address", true); | |
1067 | gfc_define_builtin ("__emutls_register_common", | |
1068 | builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR], | |
1069 | BUILT_IN_EMUTLS_REGISTER_COMMON, | |
1070 | "__emutls_register_common", false); | |
1071 | ||
384c400a | 1072 | build_common_builtin_nodes (); |
ef9312c1 | 1073 | targetm.init_builtins (); |
6de9cd9a DN |
1074 | } |
1075 | ||
e8525382 | 1076 | #undef DEFINE_MATH_BUILTIN_C |
6de9cd9a DN |
1077 | #undef DEFINE_MATH_BUILTIN |
1078 | ||
a64f5186 JJ |
1079 | static void |
1080 | gfc_init_ts (void) | |
1081 | { | |
1082 | tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1; | |
1083 | tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1; | |
1084 | tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1; | |
1085 | tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1; | |
1086 | tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1; | |
1087 | } | |
1088 | ||
602b8523 TB |
1089 | void |
1090 | gfc_maybe_initialize_eh (void) | |
1091 | { | |
1092 | if (!flag_exceptions || gfc_eh_initialized_p) | |
1093 | return; | |
1094 | ||
1095 | gfc_eh_initialized_p = true; | |
602b8523 TB |
1096 | using_eh_for_cleanups (); |
1097 | } | |
1098 | ||
1099 | ||
6de9cd9a DN |
1100 | #include "gt-fortran-f95-lang.h" |
1101 | #include "gtype-fortran.h" |