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