]>
Commit | Line | Data |
---|---|---|
f36327db | 1 | /* gfortran backend interface |
b251af97 | 2 | Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 |
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" | |
eadf906f | 32 | #include "tree-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" | |
46 | ||
47 | #include "gfortran.h" | |
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 | ||
54 | struct lang_identifier | |
55 | GTY(()) | |
56 | { | |
57 | struct tree_identifier common; | |
58 | }; | |
59 | ||
60 | /* The resulting tree type. */ | |
61 | ||
62 | union lang_tree_node | |
f88cf205 | 63 | GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), |
3d95caa4 | 64 | chain_next ("(union lang_tree_node *)GENERIC_NEXT (&%h.generic)"))) |
07beea0d | 65 | |
6de9cd9a DN |
66 | { |
67 | union tree_node GTY((tag ("0"), | |
68 | desc ("tree_node_structure (&%h)"))) generic; | |
69 | struct lang_identifier GTY((tag ("1"))) identifier; | |
70 | }; | |
71 | ||
72 | /* Save and restore the variables in this file and elsewhere | |
73 | that keep track of the progress of compilation of the current function. | |
74 | Used for nested functions. */ | |
75 | ||
76 | struct language_function | |
77 | GTY(()) | |
78 | { | |
79 | /* struct gfc_language_function base; */ | |
6de9cd9a DN |
80 | struct binding_level *binding_level; |
81 | }; | |
82 | ||
83 | /* We don't have a lex/yacc lexer/parser, but toplev expects these to | |
84 | exist anyway. */ | |
85 | void yyerror (const char *str); | |
86 | int yylex (void); | |
87 | ||
88 | static void gfc_init_decl_processing (void); | |
89 | static void gfc_init_builtin_functions (void); | |
90 | ||
91 | /* Each front end provides its own. */ | |
92 | static bool gfc_init (void); | |
93 | static void gfc_finish (void); | |
94 | static void gfc_print_identifier (FILE *, tree, int); | |
95 | static bool gfc_mark_addressable (tree); | |
96 | void do_function_end (void); | |
97 | int global_bindings_p (void); | |
98 | void insert_block (tree); | |
9dcf6e73 | 99 | static void gfc_clear_binding_stack (void); |
6de9cd9a DN |
100 | static void gfc_be_parse_file (int); |
101 | static void gfc_expand_function (tree); | |
4862826d | 102 | static alias_set_type gfc_get_alias_set (tree); |
6de9cd9a DN |
103 | |
104 | #undef LANG_HOOKS_NAME | |
105 | #undef LANG_HOOKS_INIT | |
106 | #undef LANG_HOOKS_FINISH | |
107 | #undef LANG_HOOKS_INIT_OPTIONS | |
108 | #undef LANG_HOOKS_HANDLE_OPTION | |
109 | #undef LANG_HOOKS_POST_OPTIONS | |
110 | #undef LANG_HOOKS_PRINT_IDENTIFIER | |
111 | #undef LANG_HOOKS_PARSE_FILE | |
6de9cd9a DN |
112 | #undef LANG_HOOKS_MARK_ADDRESSABLE |
113 | #undef LANG_HOOKS_TYPE_FOR_MODE | |
114 | #undef LANG_HOOKS_TYPE_FOR_SIZE | |
6de9cd9a | 115 | #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION |
9dcf6e73 | 116 | #undef LANG_HOOKS_CLEAR_BINDING_STACK |
7b9c708f | 117 | #undef LANG_HOOKS_GET_ALIAS_SET |
6c7a4dfd JJ |
118 | #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE |
119 | #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING | |
cd75853e | 120 | #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR |
6c7a4dfd JJ |
121 | #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR |
122 | #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE | |
123 | #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES | |
c79efc4d | 124 | #undef LANG_HOOKS_BUILTIN_FUNCTION |
6de9cd9a DN |
125 | |
126 | /* Define lang hooks. */ | |
127 | #define LANG_HOOKS_NAME "GNU F95" | |
128 | #define LANG_HOOKS_INIT gfc_init | |
129 | #define LANG_HOOKS_FINISH gfc_finish | |
130 | #define LANG_HOOKS_INIT_OPTIONS gfc_init_options | |
131 | #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option | |
132 | #define LANG_HOOKS_POST_OPTIONS gfc_post_options | |
133 | #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier | |
134 | #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file | |
6de9cd9a DN |
135 | #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable |
136 | #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode | |
137 | #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size | |
6de9cd9a | 138 | #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function |
9dcf6e73 | 139 | #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack |
7b9c708f | 140 | #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set |
6c7a4dfd JJ |
141 | #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference |
142 | #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing | |
cd75853e | 143 | #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor |
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 | |
146 | #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ | |
147 | gfc_omp_firstprivatize_type_sizes | |
c79efc4d | 148 | #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function |
6de9cd9a DN |
149 | |
150 | const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; | |
151 | ||
152 | /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function | |
153 | that have names. Here so we can clear out their names' definitions | |
154 | at the end of the function. */ | |
155 | ||
156 | /* Tree code classes. */ | |
157 | ||
158 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, | |
159 | ||
6615c446 | 160 | const enum tree_code_class tree_code_type[] = { |
6de9cd9a DN |
161 | #include "tree.def" |
162 | }; | |
163 | #undef DEFTREECODE | |
164 | ||
165 | /* Table indexed by tree code giving number of expression | |
166 | operands beyond the fixed part of the node structure. | |
167 | Not used for types or decls. */ | |
168 | ||
169 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, | |
170 | ||
171 | const unsigned char tree_code_length[] = { | |
172 | #include "tree.def" | |
173 | }; | |
174 | #undef DEFTREECODE | |
175 | ||
176 | /* Names of tree components. | |
177 | Used for printing out the tree and error messages. */ | |
178 | #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, | |
179 | ||
180 | const char *const tree_code_name[] = { | |
181 | #include "tree.def" | |
182 | }; | |
183 | #undef DEFTREECODE | |
184 | ||
6de9cd9a DN |
185 | |
186 | #define NULL_BINDING_LEVEL (struct binding_level *) NULL | |
187 | ||
188 | /* A chain of binding_level structures awaiting reuse. */ | |
189 | ||
190 | static GTY(()) struct binding_level *free_binding_level; | |
191 | ||
192 | /* The elements of `ridpointers' are identifier nodes | |
193 | for the reserved type names and storage classes. | |
194 | It is indexed by a RID_... value. */ | |
195 | tree *ridpointers = NULL; | |
196 | ||
197 | /* language-specific flags. */ | |
198 | ||
199 | static void | |
200 | gfc_expand_function (tree fndecl) | |
201 | { | |
81871c2a JJ |
202 | tree t; |
203 | ||
204 | if (DECL_INITIAL (fndecl) | |
205 | && BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl))) | |
206 | { | |
207 | /* Local static equivalenced variables are never seen by | |
208 | check_global_declarations, so we need to output debug | |
209 | info by hand. */ | |
210 | ||
211 | t = BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl)); | |
212 | for (t = BLOCK_VARS (t); t; t = TREE_CHAIN (t)) | |
213 | if (TREE_CODE (t) == VAR_DECL && DECL_HAS_VALUE_EXPR_P (t) | |
214 | && TREE_STATIC (t)) | |
215 | { | |
216 | tree expr = DECL_VALUE_EXPR (t); | |
217 | ||
218 | if (TREE_CODE (expr) == COMPONENT_REF | |
219 | && TREE_CODE (TREE_OPERAND (expr, 0)) == VAR_DECL | |
220 | && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) | |
221 | == UNION_TYPE | |
8a4a83ed | 222 | && varpool_node (TREE_OPERAND (expr, 0))->needed |
81871c2a JJ |
223 | && errorcount == 0 && sorrycount == 0) |
224 | { | |
225 | timevar_push (TV_SYMOUT); | |
226 | (*debug_hooks->global_decl) (t); | |
227 | timevar_pop (TV_SYMOUT); | |
228 | } | |
229 | } | |
230 | } | |
231 | ||
0f0377f6 | 232 | tree_rest_of_compilation (fndecl); |
6de9cd9a | 233 | } |
b251af97 | 234 | |
6de9cd9a DN |
235 | |
236 | /* Prepare expr to be an argument of a TRUTH_NOT_EXPR, | |
237 | or validate its data type for an `if' or `while' statement or ?..: exp. | |
238 | ||
239 | This preparation consists of taking the ordinary | |
240 | representation of an expression expr and producing a valid tree | |
241 | boolean expression describing whether expr is nonzero. We could | |
242 | simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1), | |
243 | but we optimize comparisons, &&, ||, and !. | |
244 | ||
245 | The resulting type should always be `boolean_type_node'. | |
246 | This is much simpler than the corresponding C version because we have a | |
247 | distinct boolean type. */ | |
248 | ||
249 | tree | |
250 | gfc_truthvalue_conversion (tree expr) | |
251 | { | |
252 | switch (TREE_CODE (TREE_TYPE (expr))) | |
253 | { | |
254 | case BOOLEAN_TYPE: | |
255 | if (TREE_TYPE (expr) == boolean_type_node) | |
256 | return expr; | |
6615c446 | 257 | else if (COMPARISON_CLASS_P (expr)) |
6de9cd9a DN |
258 | { |
259 | TREE_TYPE (expr) = boolean_type_node; | |
260 | return expr; | |
261 | } | |
262 | else if (TREE_CODE (expr) == NOP_EXPR) | |
b251af97 | 263 | return build1 (NOP_EXPR, boolean_type_node, TREE_OPERAND (expr, 0)); |
6de9cd9a DN |
264 | else |
265 | return build1 (NOP_EXPR, boolean_type_node, expr); | |
266 | ||
267 | case INTEGER_TYPE: | |
268 | if (TREE_CODE (expr) == INTEGER_CST) | |
269 | return integer_zerop (expr) ? boolean_false_node : boolean_true_node; | |
270 | else | |
1f39323f RS |
271 | return build2 (NE_EXPR, boolean_type_node, expr, |
272 | build_int_cst (TREE_TYPE (expr), 0)); | |
6de9cd9a DN |
273 | |
274 | default: | |
275 | internal_error ("Unexpected type in truthvalue_conversion"); | |
276 | } | |
277 | } | |
278 | ||
b251af97 | 279 | |
6de9cd9a DN |
280 | static void |
281 | gfc_create_decls (void) | |
282 | { | |
283 | /* GCC builtins. */ | |
284 | gfc_init_builtin_functions (); | |
285 | ||
286 | /* Runtime/IO library functions. */ | |
287 | gfc_build_builtin_function_decls (); | |
288 | ||
289 | gfc_init_constants (); | |
290 | } | |
291 | ||
b251af97 | 292 | |
6de9cd9a DN |
293 | static void |
294 | gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED) | |
295 | { | |
296 | int errors; | |
297 | int warnings; | |
298 | ||
299 | gfc_create_decls (); | |
300 | gfc_parse_file (); | |
301 | gfc_generate_constructors (); | |
302 | ||
303 | cgraph_finalize_compilation_unit (); | |
304 | cgraph_optimize (); | |
305 | ||
306 | /* Tell the frontent about any errors. */ | |
307 | gfc_get_errors (&warnings, &errors); | |
308 | errorcount += errors; | |
309 | warningcount += warnings; | |
310 | } | |
b251af97 SK |
311 | |
312 | ||
6de9cd9a DN |
313 | /* Initialize everything. */ |
314 | ||
315 | static bool | |
316 | gfc_init (void) | |
317 | { | |
c8cc8542 | 318 | #ifdef USE_MAPPED_LOCATION |
e0bcf78c | 319 | linemap_add (&line_table, LC_ENTER, false, gfc_source_file, 1); |
c8cc8542 PB |
320 | linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0); |
321 | #endif | |
322 | ||
6de9cd9a DN |
323 | /* First initialize the backend. */ |
324 | gfc_init_decl_processing (); | |
325 | gfc_static_ctors = NULL_TREE; | |
326 | ||
327 | /* Then the frontend. */ | |
328 | gfc_init_1 (); | |
329 | ||
e0bcf78c TS |
330 | if (gfc_new_file () != SUCCESS) |
331 | fatal_error ("can't open input file: %s", gfc_source_file); | |
6de9cd9a DN |
332 | return true; |
333 | } | |
334 | ||
335 | ||
336 | static void | |
337 | gfc_finish (void) | |
338 | { | |
339 | gfc_done_1 (); | |
340 | gfc_release_include_path (); | |
341 | return; | |
342 | } | |
343 | ||
344 | static void | |
345 | gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED, | |
346 | tree node ATTRIBUTE_UNUSED, | |
347 | int indent ATTRIBUTE_UNUSED) | |
348 | { | |
349 | return; | |
350 | } | |
b251af97 | 351 | |
6de9cd9a DN |
352 | |
353 | /* These functions and variables deal with binding contours. We only | |
354 | need these functions for the list of PARM_DECLs, but we leave the | |
355 | functions more general; these are a simplified version of the | |
356 | functions from GNAT. */ | |
357 | ||
b251af97 SK |
358 | /* For each binding contour we allocate a binding_level structure which |
359 | records the entities defined or declared in that contour. Contours | |
360 | include: | |
6de9cd9a DN |
361 | |
362 | the global one | |
363 | one for each subprogram definition | |
364 | one for each compound statement (declare block) | |
365 | ||
366 | Binding contours are used to create GCC tree BLOCK nodes. */ | |
367 | ||
368 | struct binding_level | |
369 | GTY(()) | |
370 | { | |
371 | /* A chain of ..._DECL nodes for all variables, constants, functions, | |
372 | parameters and type declarations. These ..._DECL nodes are chained | |
373 | through the TREE_CHAIN field. Note that these ..._DECL nodes are stored | |
374 | in the reverse of the order supplied to be compatible with the | |
375 | back-end. */ | |
376 | tree names; | |
377 | /* For each level (except the global one), a chain of BLOCK nodes for all | |
378 | the levels that were entered and exited one level down from this one. */ | |
379 | tree blocks; | |
f7b529fa | 380 | /* The binding level containing this one (the enclosing binding level). */ |
6de9cd9a DN |
381 | struct binding_level *level_chain; |
382 | }; | |
383 | ||
384 | /* The binding level currently in effect. */ | |
385 | static GTY(()) struct binding_level *current_binding_level = NULL; | |
386 | ||
387 | /* The outermost binding level. This binding level is created when the | |
388 | compiler is started and it will exist through the entire compilation. */ | |
389 | static GTY(()) struct binding_level *global_binding_level; | |
390 | ||
391 | /* Binding level structures are initialized by copying this one. */ | |
9dcf6e73 | 392 | static struct binding_level clear_binding_level = { NULL, NULL, NULL }; |
b251af97 SK |
393 | |
394 | ||
13795658 | 395 | /* Return nonzero if we are currently in the global binding level. */ |
6de9cd9a DN |
396 | |
397 | int | |
398 | global_bindings_p (void) | |
399 | { | |
400 | return current_binding_level == global_binding_level ? -1 : 0; | |
401 | } | |
402 | ||
403 | tree | |
404 | getdecls (void) | |
405 | { | |
406 | return current_binding_level->names; | |
407 | } | |
408 | ||
409 | /* Enter a new binding level. The input parameter is ignored, but has to be | |
410 | specified for back-end compatibility. */ | |
411 | ||
412 | void | |
413 | pushlevel (int ignore ATTRIBUTE_UNUSED) | |
414 | { | |
415 | struct binding_level *newlevel | |
416 | = (struct binding_level *) ggc_alloc (sizeof (struct binding_level)); | |
417 | ||
418 | *newlevel = clear_binding_level; | |
419 | ||
420 | /* Add this level to the front of the chain (stack) of levels that are | |
421 | active. */ | |
422 | newlevel->level_chain = current_binding_level; | |
423 | current_binding_level = newlevel; | |
424 | } | |
425 | ||
426 | /* Exit a binding level. | |
427 | Pop the level off, and restore the state of the identifier-decl mappings | |
428 | that were in effect when this level was entered. | |
429 | ||
430 | If KEEP is nonzero, this level had explicit declarations, so | |
431 | and create a "block" (a BLOCK node) for the level | |
432 | to record its declarations and subblocks for symbol table output. | |
433 | ||
434 | If FUNCTIONBODY is nonzero, this level is the body of a function, | |
435 | so create a block as if KEEP were set and also clear out all | |
436 | label names. | |
437 | ||
438 | If REVERSE is nonzero, reverse the order of decls before putting | |
439 | them into the BLOCK. */ | |
440 | ||
441 | tree | |
442 | poplevel (int keep, int reverse, int functionbody) | |
443 | { | |
1f2959f0 | 444 | /* Points to a BLOCK tree node. This is the BLOCK node constructed for the |
6de9cd9a DN |
445 | binding level that we are about to exit and which is returned by this |
446 | routine. */ | |
447 | tree block_node = NULL_TREE; | |
448 | tree decl_chain; | |
449 | tree subblock_chain = current_binding_level->blocks; | |
450 | tree subblock_node; | |
6de9cd9a DN |
451 | |
452 | /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL | |
453 | nodes chained through the `names' field of current_binding_level are in | |
1f2959f0 | 454 | reverse order except for PARM_DECL node, which are explicitly stored in |
6de9cd9a DN |
455 | the right order. */ |
456 | decl_chain = (reverse) ? nreverse (current_binding_level->names) | |
b251af97 | 457 | : current_binding_level->names; |
6de9cd9a | 458 | |
6de9cd9a DN |
459 | /* If there were any declarations in the current binding level, or if this |
460 | binding level is a function body, or if there are any nested blocks then | |
461 | create a BLOCK node to record them for the life of this function. */ | |
9dcf6e73 | 462 | if (keep || functionbody) |
22e8617b | 463 | block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0); |
6de9cd9a DN |
464 | |
465 | /* Record the BLOCK node just built as the subblock its enclosing scope. */ | |
466 | for (subblock_node = subblock_chain; subblock_node; | |
467 | subblock_node = TREE_CHAIN (subblock_node)) | |
468 | BLOCK_SUPERCONTEXT (subblock_node) = block_node; | |
469 | ||
470 | /* Clear out the meanings of the local variables of this level. */ | |
471 | ||
472 | for (subblock_node = decl_chain; subblock_node; | |
473 | subblock_node = TREE_CHAIN (subblock_node)) | |
474 | if (DECL_NAME (subblock_node) != 0) | |
475 | /* If the identifier was used or addressed via a local extern decl, | |
f7b529fa | 476 | don't forget that fact. */ |
6de9cd9a DN |
477 | if (DECL_EXTERNAL (subblock_node)) |
478 | { | |
479 | if (TREE_USED (subblock_node)) | |
480 | TREE_USED (DECL_NAME (subblock_node)) = 1; | |
481 | if (TREE_ADDRESSABLE (subblock_node)) | |
482 | TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1; | |
483 | } | |
484 | ||
485 | /* Pop the current level. */ | |
486 | current_binding_level = current_binding_level->level_chain; | |
487 | ||
488 | if (functionbody) | |
489 | { | |
490 | /* This is the top level block of a function. The ..._DECL chain stored | |
491 | in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't | |
492 | leave them in the BLOCK because they are found in the FUNCTION_DECL | |
493 | instead. */ | |
494 | DECL_INITIAL (current_function_decl) = block_node; | |
495 | BLOCK_VARS (block_node) = 0; | |
496 | } | |
497 | else if (block_node) | |
498 | { | |
9dcf6e73 JM |
499 | current_binding_level->blocks |
500 | = chainon (current_binding_level->blocks, block_node); | |
6de9cd9a DN |
501 | } |
502 | ||
503 | /* If we did not make a block for the level just exited, any blocks made for | |
504 | inner levels (since they cannot be recorded as subblocks in that level) | |
505 | must be carried forward so they will later become subblocks of something | |
506 | else. */ | |
507 | else if (subblock_chain) | |
508 | current_binding_level->blocks | |
509 | = chainon (current_binding_level->blocks, subblock_chain); | |
510 | if (block_node) | |
511 | TREE_USED (block_node) = 1; | |
512 | ||
513 | return block_node; | |
514 | } | |
b251af97 SK |
515 | |
516 | ||
6de9cd9a DN |
517 | /* Insert BLOCK at the end of the list of subblocks of the |
518 | current binding level. This is used when a BIND_EXPR is expanded, | |
519 | to handle the BLOCK node inside the BIND_EXPR. */ | |
520 | ||
521 | void | |
522 | insert_block (tree block) | |
523 | { | |
524 | TREE_USED (block) = 1; | |
525 | current_binding_level->blocks | |
526 | = chainon (current_binding_level->blocks, block); | |
527 | } | |
528 | ||
b251af97 | 529 | |
6de9cd9a | 530 | /* Records a ..._DECL node DECL as belonging to the current lexical scope. |
f7b529fa | 531 | Returns the ..._DECL node. */ |
6de9cd9a DN |
532 | |
533 | tree | |
534 | pushdecl (tree decl) | |
535 | { | |
536 | /* External objects aren't nested, other objects may be. */ | |
537 | if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl)) | |
538 | DECL_CONTEXT (decl) = 0; | |
539 | else | |
540 | DECL_CONTEXT (decl) = current_function_decl; | |
541 | ||
542 | /* Put the declaration on the list. The list of declarations is in reverse | |
543 | order. The list will be reversed later if necessary. This needs to be | |
544 | this way for compatibility with the back-end. */ | |
545 | ||
546 | TREE_CHAIN (decl) = current_binding_level->names; | |
547 | current_binding_level->names = decl; | |
548 | ||
69de3b83 | 549 | /* For the declaration of a type, set its name if it is not already set. */ |
6de9cd9a DN |
550 | |
551 | if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0) | |
552 | { | |
553 | if (DECL_SOURCE_LINE (decl) == 0) | |
554 | TYPE_NAME (TREE_TYPE (decl)) = decl; | |
555 | else | |
556 | TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl); | |
557 | } | |
558 | ||
559 | return decl; | |
560 | } | |
561 | ||
562 | ||
563 | /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */ | |
564 | ||
565 | tree | |
566 | pushdecl_top_level (tree x) | |
567 | { | |
568 | tree t; | |
569 | struct binding_level *b = current_binding_level; | |
570 | ||
571 | current_binding_level = global_binding_level; | |
572 | t = pushdecl (x); | |
573 | current_binding_level = b; | |
574 | return t; | |
575 | } | |
576 | ||
577 | ||
9dcf6e73 JM |
578 | /* Clear the binding stack. */ |
579 | static void | |
580 | gfc_clear_binding_stack (void) | |
581 | { | |
582 | while (!global_bindings_p ()) | |
583 | poplevel (0, 0, 0); | |
584 | } | |
585 | ||
586 | ||
6de9cd9a DN |
587 | #ifndef CHAR_TYPE_SIZE |
588 | #define CHAR_TYPE_SIZE BITS_PER_UNIT | |
589 | #endif | |
590 | ||
591 | #ifndef INT_TYPE_SIZE | |
592 | #define INT_TYPE_SIZE BITS_PER_WORD | |
593 | #endif | |
594 | ||
595 | #undef SIZE_TYPE | |
596 | #define SIZE_TYPE "long unsigned int" | |
597 | ||
598 | /* Create tree nodes for the basic scalar types of Fortran 95, | |
599 | and some nodes representing standard constants (0, 1, (void *) 0). | |
600 | Initialize the global binding level. | |
601 | Make definitions for built-in primitive functions. */ | |
602 | static void | |
603 | gfc_init_decl_processing (void) | |
604 | { | |
605 | current_function_decl = NULL; | |
6de9cd9a DN |
606 | current_binding_level = NULL_BINDING_LEVEL; |
607 | free_binding_level = NULL_BINDING_LEVEL; | |
608 | ||
609 | /* Make the binding_level structure for global names. We move all | |
610 | variables that are in a COMMON block to this binding level. */ | |
611 | pushlevel (0); | |
612 | global_binding_level = current_binding_level; | |
613 | ||
614 | /* Build common tree nodes. char_type_node is unsigned because we | |
615 | only use it for actual characters, not for INTEGER(1). Also, we | |
f7b529fa | 616 | want double_type_node to actually have double precision. */ |
8c1d6d62 | 617 | build_common_tree_nodes (false, false); |
fcdb5d68 KT |
618 | /* x86_64 minw32 has a sizetype of "unsigned long long", most other hosts |
619 | have a sizetype of "unsigned long". Therefore choose the correct size | |
620 | in mostly target independent way. */ | |
621 | if (TYPE_MODE (long_unsigned_type_node) == Pmode) | |
622 | set_sizetype (long_unsigned_type_node); | |
623 | else if (TYPE_MODE (long_long_unsigned_type_node) == Pmode) | |
624 | set_sizetype (long_long_unsigned_type_node); | |
625 | else | |
626 | set_sizetype (long_unsigned_type_node); | |
6de9cd9a | 627 | build_common_tree_nodes_2 (0); |
24cc1193 | 628 | void_list_node = build_tree_list (NULL_TREE, void_type_node); |
6de9cd9a DN |
629 | |
630 | /* Set up F95 type nodes. */ | |
5e8e542f | 631 | gfc_init_kinds (); |
6de9cd9a DN |
632 | gfc_init_types (); |
633 | } | |
634 | ||
b251af97 | 635 | |
6de9cd9a DN |
636 | /* Mark EXP saying that we need to be able to take the |
637 | address of it; it should not be allocated in a register. | |
638 | In Fortran 95 this is only the case for variables with | |
639 | the TARGET attribute, but we implement it here for a | |
640 | likely future Cray pointer extension. | |
641 | Value is 1 if successful. */ | |
642 | /* TODO: Check/fix mark_addressable. */ | |
b251af97 | 643 | |
6de9cd9a DN |
644 | bool |
645 | gfc_mark_addressable (tree exp) | |
646 | { | |
647 | register tree x = exp; | |
648 | while (1) | |
649 | switch (TREE_CODE (x)) | |
650 | { | |
651 | case COMPONENT_REF: | |
652 | case ADDR_EXPR: | |
653 | case ARRAY_REF: | |
654 | case REALPART_EXPR: | |
655 | case IMAGPART_EXPR: | |
656 | x = TREE_OPERAND (x, 0); | |
657 | break; | |
658 | ||
659 | case CONSTRUCTOR: | |
660 | TREE_ADDRESSABLE (x) = 1; | |
661 | return true; | |
662 | ||
663 | case VAR_DECL: | |
664 | case CONST_DECL: | |
665 | case PARM_DECL: | |
666 | case RESULT_DECL: | |
667 | if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x)) | |
668 | { | |
669 | if (TREE_PUBLIC (x)) | |
670 | { | |
b251af97 SK |
671 | error ("global register variable %qs used in nested function", |
672 | IDENTIFIER_POINTER (DECL_NAME (x))); | |
6de9cd9a DN |
673 | return false; |
674 | } | |
597cdf4f | 675 | pedwarn ("register variable %qs used in nested function", |
6de9cd9a DN |
676 | IDENTIFIER_POINTER (DECL_NAME (x))); |
677 | } | |
678 | else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) | |
679 | { | |
680 | if (TREE_PUBLIC (x)) | |
681 | { | |
597cdf4f | 682 | error ("address of global register variable %qs requested", |
6de9cd9a DN |
683 | IDENTIFIER_POINTER (DECL_NAME (x))); |
684 | return true; | |
685 | } | |
686 | ||
687 | #if 0 | |
688 | /* If we are making this addressable due to its having | |
689 | volatile components, give a different error message. Also | |
690 | handle the case of an unnamed parameter by not trying | |
691 | to give the name. */ | |
692 | ||
693 | else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x))) | |
694 | { | |
695 | error ("cannot put object with volatile field into register"); | |
696 | return false; | |
697 | } | |
698 | #endif | |
699 | ||
597cdf4f | 700 | pedwarn ("address of register variable %qs requested", |
6de9cd9a DN |
701 | IDENTIFIER_POINTER (DECL_NAME (x))); |
702 | } | |
6de9cd9a DN |
703 | |
704 | /* drops in */ | |
705 | case FUNCTION_DECL: | |
706 | TREE_ADDRESSABLE (x) = 1; | |
707 | ||
708 | default: | |
709 | return true; | |
710 | } | |
711 | } | |
712 | ||
b251af97 | 713 | |
7b9c708f JJ |
714 | /* Return the typed-based alias set for T, which may be an expression |
715 | or a type. Return -1 if we don't do anything special. */ | |
716 | ||
4862826d | 717 | static alias_set_type |
7b9c708f JJ |
718 | gfc_get_alias_set (tree t) |
719 | { | |
720 | tree u; | |
721 | ||
722 | /* Permit type-punning when accessing an EQUIVALENCEd variable or | |
723 | mixed type entry master's return value. */ | |
724 | for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0)) | |
725 | if (TREE_CODE (u) == COMPONENT_REF | |
726 | && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE) | |
727 | return 0; | |
728 | ||
729 | return -1; | |
730 | } | |
731 | ||
b251af97 | 732 | |
6de9cd9a DN |
733 | /* press the big red button - garbage (ggc) collection is on */ |
734 | ||
735 | int ggc_p = 1; | |
736 | ||
1f2959f0 | 737 | /* Builtin function initialization. */ |
6de9cd9a | 738 | |
6de9cd9a | 739 | tree |
c79efc4d | 740 | gfc_builtin_function (tree decl) |
6de9cd9a | 741 | { |
0e6df31e | 742 | make_decl_rtl (decl); |
6de9cd9a | 743 | pushdecl (decl); |
6de9cd9a DN |
744 | return decl; |
745 | } | |
746 | ||
747 | ||
748 | static void | |
b251af97 | 749 | gfc_define_builtin (const char *name, |
6de9cd9a DN |
750 | tree type, |
751 | int code, | |
b251af97 | 752 | const char *library_name, |
6de9cd9a DN |
753 | bool const_p) |
754 | { | |
755 | tree decl; | |
756 | ||
c79efc4d RÁE |
757 | decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL, |
758 | library_name, NULL_TREE); | |
6de9cd9a DN |
759 | if (const_p) |
760 | TREE_READONLY (decl) = 1; | |
761 | ||
762 | built_in_decls[code] = decl; | |
763 | implicit_built_in_decls[code] = decl; | |
764 | } | |
765 | ||
766 | ||
e8525382 | 767 | #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \ |
644cb69f FXC |
768 | gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \ |
769 | BUILT_IN_ ## code ## L, name "l", true); \ | |
e8525382 | 770 | gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \ |
6de9cd9a | 771 | BUILT_IN_ ## code, name, true); \ |
e8525382 | 772 | gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \ |
6de9cd9a DN |
773 | BUILT_IN_ ## code ## F, name "f", true); |
774 | ||
e8525382 SK |
775 | #define DEFINE_MATH_BUILTIN(code, name, argtype) \ |
776 | DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) | |
777 | ||
e8525382 | 778 | #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \ |
644cb69f FXC |
779 | DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \ |
780 | DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c) | |
e8525382 SK |
781 | |
782 | ||
783 | /* Create function types for builtin functions. */ | |
784 | ||
785 | static void | |
b251af97 | 786 | build_builtin_fntypes (tree *fntype, tree type) |
e8525382 SK |
787 | { |
788 | tree tmp; | |
789 | ||
790 | /* type (*) (type) */ | |
fb2d50f5 | 791 | tmp = tree_cons (NULL_TREE, type, void_list_node); |
e8525382 SK |
792 | fntype[0] = build_function_type (type, tmp); |
793 | /* type (*) (type, type) */ | |
fb2d50f5 | 794 | tmp = tree_cons (NULL_TREE, type, tmp); |
e8525382 SK |
795 | fntype[1] = build_function_type (type, tmp); |
796 | /* type (*) (int, type) */ | |
797 | tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node); | |
798 | tmp = tree_cons (NULL_TREE, type, tmp); | |
799 | fntype[2] = build_function_type (type, tmp); | |
800 | } | |
801 | ||
b251af97 | 802 | |
6c7a4dfd JJ |
803 | static tree |
804 | builtin_type_for_size (int size, bool unsignedp) | |
805 | { | |
806 | tree type = lang_hooks.types.type_for_size (size, unsignedp); | |
807 | return type ? type : error_mark_node; | |
808 | } | |
e8525382 | 809 | |
1f2959f0 | 810 | /* Initialization of builtin function nodes. */ |
e8525382 | 811 | |
6de9cd9a DN |
812 | static void |
813 | gfc_init_builtin_functions (void) | |
814 | { | |
6c7a4dfd JJ |
815 | enum builtin_type |
816 | { | |
817 | #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME, | |
818 | #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME, | |
819 | #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME, | |
820 | #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME, | |
821 | #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME, | |
822 | #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME, | |
823 | #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME, | |
824 | #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME, | |
825 | #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME, | |
826 | #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME, | |
827 | #define DEF_POINTER_TYPE(NAME, TYPE) NAME, | |
828 | #include "types.def" | |
829 | #undef DEF_PRIMITIVE_TYPE | |
830 | #undef DEF_FUNCTION_TYPE_0 | |
831 | #undef DEF_FUNCTION_TYPE_1 | |
832 | #undef DEF_FUNCTION_TYPE_2 | |
833 | #undef DEF_FUNCTION_TYPE_3 | |
834 | #undef DEF_FUNCTION_TYPE_4 | |
835 | #undef DEF_FUNCTION_TYPE_5 | |
836 | #undef DEF_FUNCTION_TYPE_6 | |
837 | #undef DEF_FUNCTION_TYPE_7 | |
838 | #undef DEF_FUNCTION_TYPE_VAR_0 | |
839 | #undef DEF_POINTER_TYPE | |
840 | BT_LAST | |
841 | }; | |
842 | typedef enum builtin_type builtin_type; | |
843 | enum | |
844 | { | |
845 | /* So far we need just these 2 attribute types. */ | |
846 | ATTR_NOTHROW_LIST, | |
847 | ATTR_CONST_NOTHROW_LIST | |
848 | }; | |
849 | ||
e8525382 SK |
850 | tree mfunc_float[3]; |
851 | tree mfunc_double[3]; | |
644cb69f | 852 | tree mfunc_longdouble[3]; |
e8525382 SK |
853 | tree mfunc_cfloat[3]; |
854 | tree mfunc_cdouble[3]; | |
644cb69f | 855 | tree mfunc_clongdouble[3]; |
3a53e165 RG |
856 | tree func_cfloat_float, func_float_cfloat; |
857 | tree func_cdouble_double, func_double_cdouble; | |
858 | tree func_clongdouble_longdouble, func_longdouble_clongdouble; | |
859 | tree func_float_floatp_floatp; | |
860 | tree func_double_doublep_doublep; | |
861 | tree func_longdouble_longdoublep_longdoublep; | |
862 | tree ftype, ptype; | |
94f548c2 | 863 | tree tmp, type; |
6c7a4dfd | 864 | tree builtin_types[(int) BT_LAST + 1]; |
6de9cd9a | 865 | |
e8525382 SK |
866 | build_builtin_fntypes (mfunc_float, float_type_node); |
867 | build_builtin_fntypes (mfunc_double, double_type_node); | |
644cb69f | 868 | build_builtin_fntypes (mfunc_longdouble, long_double_type_node); |
e8525382 SK |
869 | build_builtin_fntypes (mfunc_cfloat, complex_float_type_node); |
870 | build_builtin_fntypes (mfunc_cdouble, complex_double_type_node); | |
644cb69f | 871 | build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node); |
e8525382 | 872 | |
ead6d15f AP |
873 | tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node); |
874 | func_cfloat_float = build_function_type (float_type_node, tmp); | |
6de9cd9a | 875 | |
3a53e165 RG |
876 | tmp = tree_cons (NULL_TREE, float_type_node, void_list_node); |
877 | func_float_cfloat = build_function_type (complex_float_type_node, tmp); | |
878 | ||
ead6d15f AP |
879 | tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node); |
880 | func_cdouble_double = build_function_type (double_type_node, tmp); | |
6de9cd9a | 881 | |
3a53e165 RG |
882 | tmp = tree_cons (NULL_TREE, double_type_node, void_list_node); |
883 | func_double_cdouble = build_function_type (complex_double_type_node, tmp); | |
884 | ||
644cb69f FXC |
885 | tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node); |
886 | func_clongdouble_longdouble = | |
887 | build_function_type (long_double_type_node, tmp); | |
888 | ||
3a53e165 RG |
889 | tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node); |
890 | func_longdouble_clongdouble = | |
891 | build_function_type (complex_long_double_type_node, tmp); | |
892 | ||
893 | ptype = build_pointer_type (float_type_node); | |
894 | tmp = tree_cons (NULL_TREE, float_type_node, | |
895 | tree_cons (NULL_TREE, ptype, | |
896 | build_tree_list (NULL_TREE, ptype))); | |
897 | func_float_floatp_floatp = | |
898 | build_function_type (void_type_node, tmp); | |
899 | ||
900 | ptype = build_pointer_type (double_type_node); | |
901 | tmp = tree_cons (NULL_TREE, double_type_node, | |
902 | tree_cons (NULL_TREE, ptype, | |
903 | build_tree_list (NULL_TREE, ptype))); | |
904 | func_double_doublep_doublep = | |
905 | build_function_type (void_type_node, tmp); | |
906 | ||
907 | ptype = build_pointer_type (long_double_type_node); | |
908 | tmp = tree_cons (NULL_TREE, long_double_type_node, | |
909 | tree_cons (NULL_TREE, ptype, | |
910 | build_tree_list (NULL_TREE, ptype))); | |
911 | func_longdouble_longdoublep_longdoublep = | |
912 | build_function_type (void_type_node, tmp); | |
913 | ||
6de9cd9a DN |
914 | #include "mathbuiltins.def" |
915 | ||
e7dc5b4f | 916 | /* We define these separately as the fortran versions have different |
6de9cd9a | 917 | semantics (they return an integer type) */ |
644cb69f FXC |
918 | gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], |
919 | BUILT_IN_ROUNDL, "roundl", true); | |
6de9cd9a DN |
920 | gfc_define_builtin ("__builtin_round", mfunc_double[0], |
921 | BUILT_IN_ROUND, "round", true); | |
922 | gfc_define_builtin ("__builtin_roundf", mfunc_float[0], | |
923 | BUILT_IN_ROUNDF, "roundf", true); | |
644cb69f FXC |
924 | |
925 | gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0], | |
926 | BUILT_IN_TRUNCL, "truncl", true); | |
e743d142 TS |
927 | gfc_define_builtin ("__builtin_trunc", mfunc_double[0], |
928 | BUILT_IN_TRUNC, "trunc", true); | |
929 | gfc_define_builtin ("__builtin_truncf", mfunc_float[0], | |
930 | BUILT_IN_TRUNCF, "truncf", true); | |
931 | ||
644cb69f FXC |
932 | gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, |
933 | BUILT_IN_CABSL, "cabsl", true); | |
ead6d15f AP |
934 | gfc_define_builtin ("__builtin_cabs", func_cdouble_double, |
935 | BUILT_IN_CABS, "cabs", true); | |
936 | gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, | |
937 | BUILT_IN_CABSF, "cabsf", true); | |
c6a912da | 938 | |
644cb69f FXC |
939 | gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], |
940 | BUILT_IN_COPYSIGNL, "copysignl", true); | |
ead6d15f AP |
941 | gfc_define_builtin ("__builtin_copysign", mfunc_double[1], |
942 | BUILT_IN_COPYSIGN, "copysign", true); | |
943 | gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], | |
944 | BUILT_IN_COPYSIGNF, "copysignf", true); | |
58b6e047 PT |
945 | |
946 | gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], | |
947 | BUILT_IN_FMODL, "fmodl", true); | |
948 | gfc_define_builtin ("__builtin_fmod", mfunc_double[1], | |
949 | BUILT_IN_FMOD, "fmod", true); | |
950 | gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], | |
951 | BUILT_IN_FMODF, "fmodf", true); | |
6de9cd9a | 952 | |
94f548c2 FXC |
953 | /* lround{f,,l} and llround{f,,l} */ |
954 | type = tree_cons (NULL_TREE, float_type_node, void_list_node); | |
955 | tmp = build_function_type (long_integer_type_node, type); | |
956 | gfc_define_builtin ("__builtin_lroundf", tmp, BUILT_IN_LROUNDF, | |
957 | "lroundf", true); | |
958 | tmp = build_function_type (long_long_integer_type_node, type); | |
959 | gfc_define_builtin ("__builtin_llroundf", tmp, BUILT_IN_LLROUNDF, | |
960 | "llroundf", true); | |
961 | ||
962 | type = tree_cons (NULL_TREE, double_type_node, void_list_node); | |
963 | tmp = build_function_type (long_integer_type_node, type); | |
964 | gfc_define_builtin ("__builtin_lround", tmp, BUILT_IN_LROUND, | |
965 | "lround", true); | |
966 | tmp = build_function_type (long_long_integer_type_node, type); | |
967 | gfc_define_builtin ("__builtin_llround", tmp, BUILT_IN_LLROUND, | |
968 | "llround", true); | |
969 | ||
970 | type = tree_cons (NULL_TREE, long_double_type_node, void_list_node); | |
971 | tmp = build_function_type (long_integer_type_node, type); | |
972 | gfc_define_builtin ("__builtin_lroundl", tmp, BUILT_IN_LROUNDL, | |
973 | "lroundl", true); | |
974 | tmp = build_function_type (long_long_integer_type_node, type); | |
975 | gfc_define_builtin ("__builtin_llroundl", tmp, BUILT_IN_LLROUNDL, | |
976 | "llroundl", true); | |
977 | ||
5b200ac2 | 978 | /* These are used to implement the ** operator. */ |
644cb69f FXC |
979 | gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], |
980 | BUILT_IN_POWL, "powl", true); | |
c7d78bbe | 981 | gfc_define_builtin ("__builtin_pow", mfunc_double[1], |
5b200ac2 | 982 | BUILT_IN_POW, "pow", true); |
c7d78bbe | 983 | gfc_define_builtin ("__builtin_powf", mfunc_float[1], |
5b200ac2 | 984 | BUILT_IN_POWF, "powf", true); |
31c97dfe JB |
985 | gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2], |
986 | BUILT_IN_POWIL, "powil", true); | |
987 | gfc_define_builtin ("__builtin_powi", mfunc_double[2], | |
988 | BUILT_IN_POWI, "powi", true); | |
989 | gfc_define_builtin ("__builtin_powif", mfunc_float[2], | |
990 | BUILT_IN_POWIF, "powif", true); | |
991 | ||
5b200ac2 | 992 | |
3a53e165 RG |
993 | if (TARGET_C99_FUNCTIONS) |
994 | { | |
995 | gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0], | |
996 | BUILT_IN_CBRTL, "cbrtl", true); | |
997 | gfc_define_builtin ("__builtin_cbrt", mfunc_double[0], | |
998 | BUILT_IN_CBRT, "cbrt", true); | |
999 | gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0], | |
1000 | BUILT_IN_CBRTF, "cbrtf", true); | |
1001 | gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble, | |
1002 | BUILT_IN_CEXPIL, "cexpil", true); | |
1003 | gfc_define_builtin ("__builtin_cexpi", func_double_cdouble, | |
1004 | BUILT_IN_CEXPI, "cexpi", true); | |
1005 | gfc_define_builtin ("__builtin_cexpif", func_float_cfloat, | |
1006 | BUILT_IN_CEXPIF, "cexpif", true); | |
1007 | } | |
1008 | ||
1009 | if (TARGET_HAS_SINCOS) | |
1010 | { | |
1011 | gfc_define_builtin ("__builtin_sincosl", | |
1012 | func_longdouble_longdoublep_longdoublep, | |
1013 | BUILT_IN_SINCOSL, "sincosl", false); | |
1014 | gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep, | |
1015 | BUILT_IN_SINCOS, "sincos", false); | |
1016 | gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp, | |
1017 | BUILT_IN_SINCOSF, "sincosf", false); | |
1018 | } | |
1019 | ||
6de9cd9a DN |
1020 | /* Other builtin functions we use. */ |
1021 | ||
c6a912da RH |
1022 | tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node); |
1023 | tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp); | |
1024 | ftype = build_function_type (long_integer_type_node, tmp); | |
1025 | gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT, | |
1026 | "__builtin_expect", true); | |
ef9312c1 | 1027 | |
1529b8d9 FXC |
1028 | tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node); |
1029 | ftype = build_function_type (void_type_node, tmp); | |
1030 | gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE, | |
1031 | "free", false); | |
1032 | ||
1033 | tmp = tree_cons (NULL_TREE, size_type_node, void_list_node); | |
1034 | ftype = build_function_type (pvoid_type_node, tmp); | |
1035 | gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC, | |
1036 | "malloc", false); | |
1037 | DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1; | |
1038 | ||
5fcb93f1 FXC |
1039 | tmp = tree_cons (NULL_TREE, void_type_node, void_list_node); |
1040 | ftype = build_function_type (integer_type_node, tmp); | |
1041 | gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN, | |
1042 | "__builtin_isnan", true); | |
1043 | ||
6c7a4dfd JJ |
1044 | #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \ |
1045 | builtin_types[(int) ENUM] = VALUE; | |
1046 | #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \ | |
1047 | builtin_types[(int) ENUM] \ | |
1048 | = build_function_type (builtin_types[(int) RETURN], \ | |
1049 | void_list_node); | |
1050 | #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \ | |
1051 | builtin_types[(int) ENUM] \ | |
1052 | = build_function_type (builtin_types[(int) RETURN], \ | |
1053 | tree_cons (NULL_TREE, \ | |
1054 | builtin_types[(int) ARG1], \ | |
1055 | void_list_node)); | |
1056 | #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \ | |
1057 | builtin_types[(int) ENUM] \ | |
1058 | = build_function_type \ | |
1059 | (builtin_types[(int) RETURN], \ | |
1060 | tree_cons (NULL_TREE, \ | |
1061 | builtin_types[(int) ARG1], \ | |
1062 | tree_cons (NULL_TREE, \ | |
1063 | builtin_types[(int) ARG2], \ | |
1064 | void_list_node))); | |
1065 | #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \ | |
1066 | builtin_types[(int) ENUM] \ | |
1067 | = build_function_type \ | |
1068 | (builtin_types[(int) RETURN], \ | |
1069 | tree_cons (NULL_TREE, \ | |
1070 | builtin_types[(int) ARG1], \ | |
1071 | tree_cons (NULL_TREE, \ | |
1072 | builtin_types[(int) ARG2], \ | |
1073 | tree_cons (NULL_TREE, \ | |
1074 | builtin_types[(int) ARG3], \ | |
1075 | void_list_node)))); | |
1076 | #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \ | |
1077 | builtin_types[(int) ENUM] \ | |
1078 | = build_function_type \ | |
1079 | (builtin_types[(int) RETURN], \ | |
1080 | tree_cons (NULL_TREE, \ | |
1081 | builtin_types[(int) ARG1], \ | |
1082 | tree_cons (NULL_TREE, \ | |
1083 | builtin_types[(int) ARG2], \ | |
1084 | tree_cons \ | |
1085 | (NULL_TREE, \ | |
1086 | builtin_types[(int) ARG3], \ | |
1087 | tree_cons (NULL_TREE, \ | |
1088 | builtin_types[(int) ARG4], \ | |
1089 | void_list_node))))); | |
1090 | #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \ | |
1091 | builtin_types[(int) ENUM] \ | |
1092 | = build_function_type \ | |
1093 | (builtin_types[(int) RETURN], \ | |
1094 | tree_cons (NULL_TREE, \ | |
1095 | builtin_types[(int) ARG1], \ | |
1096 | tree_cons (NULL_TREE, \ | |
1097 | builtin_types[(int) ARG2], \ | |
1098 | tree_cons \ | |
1099 | (NULL_TREE, \ | |
1100 | builtin_types[(int) ARG3], \ | |
1101 | tree_cons (NULL_TREE, \ | |
1102 | builtin_types[(int) ARG4], \ | |
1103 | tree_cons (NULL_TREE, \ | |
1104 | builtin_types[(int) ARG5],\ | |
1105 | void_list_node)))))); | |
1106 | #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ | |
1107 | ARG6) \ | |
1108 | builtin_types[(int) ENUM] \ | |
1109 | = build_function_type \ | |
1110 | (builtin_types[(int) RETURN], \ | |
1111 | tree_cons (NULL_TREE, \ | |
1112 | builtin_types[(int) ARG1], \ | |
1113 | tree_cons (NULL_TREE, \ | |
1114 | builtin_types[(int) ARG2], \ | |
1115 | tree_cons \ | |
1116 | (NULL_TREE, \ | |
1117 | builtin_types[(int) ARG3], \ | |
1118 | tree_cons \ | |
1119 | (NULL_TREE, \ | |
1120 | builtin_types[(int) ARG4], \ | |
1121 | tree_cons (NULL_TREE, \ | |
1122 | builtin_types[(int) ARG5], \ | |
1123 | tree_cons (NULL_TREE, \ | |
1124 | builtin_types[(int) ARG6],\ | |
1125 | void_list_node))))))); | |
1126 | #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \ | |
1127 | ARG6, ARG7) \ | |
1128 | builtin_types[(int) ENUM] \ | |
1129 | = build_function_type \ | |
1130 | (builtin_types[(int) RETURN], \ | |
1131 | tree_cons (NULL_TREE, \ | |
1132 | builtin_types[(int) ARG1], \ | |
1133 | tree_cons (NULL_TREE, \ | |
1134 | builtin_types[(int) ARG2], \ | |
1135 | tree_cons \ | |
1136 | (NULL_TREE, \ | |
1137 | builtin_types[(int) ARG3], \ | |
1138 | tree_cons \ | |
1139 | (NULL_TREE, \ | |
1140 | builtin_types[(int) ARG4], \ | |
1141 | tree_cons (NULL_TREE, \ | |
1142 | builtin_types[(int) ARG5], \ | |
1143 | tree_cons (NULL_TREE, \ | |
1144 | builtin_types[(int) ARG6],\ | |
1145 | tree_cons (NULL_TREE, \ | |
1146 | builtin_types[(int) ARG6], \ | |
1147 | void_list_node)))))))); | |
1148 | #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \ | |
1149 | builtin_types[(int) ENUM] \ | |
1150 | = build_function_type (builtin_types[(int) RETURN], NULL_TREE); | |
1151 | #define DEF_POINTER_TYPE(ENUM, TYPE) \ | |
1152 | builtin_types[(int) ENUM] \ | |
1153 | = build_pointer_type (builtin_types[(int) TYPE]); | |
1154 | #include "types.def" | |
1155 | #undef DEF_PRIMITIVE_TYPE | |
1156 | #undef DEF_FUNCTION_TYPE_1 | |
1157 | #undef DEF_FUNCTION_TYPE_2 | |
1158 | #undef DEF_FUNCTION_TYPE_3 | |
1159 | #undef DEF_FUNCTION_TYPE_4 | |
1160 | #undef DEF_FUNCTION_TYPE_5 | |
1161 | #undef DEF_FUNCTION_TYPE_6 | |
1162 | #undef DEF_FUNCTION_TYPE_VAR_0 | |
1163 | #undef DEF_POINTER_TYPE | |
1164 | builtin_types[(int) BT_LAST] = NULL_TREE; | |
1165 | ||
1166 | /* Initialize synchronization builtins. */ | |
1167 | #undef DEF_SYNC_BUILTIN | |
1168 | #define DEF_SYNC_BUILTIN(code, name, type, attr) \ | |
1169 | gfc_define_builtin (name, builtin_types[type], code, name, \ | |
1170 | attr == ATTR_CONST_NOTHROW_LIST); | |
1171 | #include "../sync-builtins.def" | |
1172 | #undef DEF_SYNC_BUILTIN | |
1173 | ||
1174 | if (gfc_option.flag_openmp) | |
1175 | { | |
1176 | #undef DEF_GOMP_BUILTIN | |
1177 | #define DEF_GOMP_BUILTIN(code, name, type, attr) \ | |
1178 | gfc_define_builtin ("__builtin_" name, builtin_types[type], \ | |
1179 | code, name, attr == ATTR_CONST_NOTHROW_LIST); | |
1180 | #include "../omp-builtins.def" | |
1181 | #undef DEF_GOMP_BUILTIN | |
1182 | } | |
1183 | ||
1184 | gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID], | |
1185 | BUILT_IN_TRAP, NULL, false); | |
1186 | TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1; | |
1187 | ||
8893239d RH |
1188 | gfc_define_builtin ("__emutls_get_address", |
1189 | builtin_types[BT_FN_PTR_PTR], BUILT_IN_EMUTLS_GET_ADDRESS, | |
1190 | "__emutls_get_address", true); | |
1191 | gfc_define_builtin ("__emutls_register_common", | |
1192 | builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR], | |
1193 | BUILT_IN_EMUTLS_REGISTER_COMMON, | |
1194 | "__emutls_register_common", false); | |
1195 | ||
c6a912da | 1196 | build_common_builtin_nodes (); |
ef9312c1 | 1197 | targetm.init_builtins (); |
6de9cd9a DN |
1198 | } |
1199 | ||
e8525382 | 1200 | #undef DEFINE_MATH_BUILTIN_C |
6de9cd9a DN |
1201 | #undef DEFINE_MATH_BUILTIN |
1202 | ||
1203 | #include "gt-fortran-f95-lang.h" | |
1204 | #include "gtype-fortran.h" |