|
111
|
1 /* gfortran backend interface
|
|
145
|
2 Copyright (C) 2000-2020 Free Software Foundation, Inc.
|
|
111
|
3 Contributed by Paul Brook.
|
|
|
4
|
|
|
5 This file is part of GCC.
|
|
|
6
|
|
|
7 GCC is free software; you can redistribute it and/or modify it under
|
|
|
8 the terms of the GNU General Public License as published by the Free
|
|
|
9 Software Foundation; either version 3, or (at your option) any later
|
|
|
10 version.
|
|
|
11
|
|
|
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
|
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
15 for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
|
18 along with GCC; see the file COPYING3. If not see
|
|
|
19 <http://www.gnu.org/licenses/>. */
|
|
|
20
|
|
|
21 /* f95-lang.c-- GCC backend interface stuff */
|
|
|
22
|
|
|
23 /* declare required prototypes: */
|
|
|
24
|
|
|
25 #include "config.h"
|
|
|
26 #include "system.h"
|
|
|
27 #include "coretypes.h"
|
|
|
28 #include "target.h"
|
|
|
29 #include "function.h"
|
|
|
30 #include "tree.h"
|
|
|
31 #include "gfortran.h"
|
|
|
32 #include "trans.h"
|
|
|
33 #include "stringpool.h"
|
|
|
34 #include "diagnostic.h" /* For errorcount/warningcount */
|
|
|
35 #include "langhooks.h"
|
|
|
36 #include "langhooks-def.h"
|
|
|
37 #include "toplev.h"
|
|
|
38 #include "debug.h"
|
|
|
39 #include "cpp.h"
|
|
|
40 #include "trans-types.h"
|
|
|
41 #include "trans-const.h"
|
|
|
42
|
|
|
43 /* Language-dependent contents of an identifier. */
|
|
|
44
|
|
|
45 struct GTY(())
|
|
|
46 lang_identifier {
|
|
|
47 struct tree_identifier common;
|
|
|
48 };
|
|
|
49
|
|
|
50 /* The resulting tree type. */
|
|
|
51
|
|
|
52 union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
|
|
|
53 chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
|
|
|
54 lang_tree_node {
|
|
|
55 union tree_node GTY((tag ("0"),
|
|
|
56 desc ("tree_node_structure (&%h)"))) generic;
|
|
|
57 struct lang_identifier GTY((tag ("1"))) identifier;
|
|
|
58 };
|
|
|
59
|
|
|
60 /* Save and restore the variables in this file and elsewhere
|
|
|
61 that keep track of the progress of compilation of the current function.
|
|
|
62 Used for nested functions. */
|
|
|
63
|
|
|
64 struct GTY(())
|
|
|
65 language_function {
|
|
|
66 /* struct gfc_language_function base; */
|
|
|
67 struct binding_level *binding_level;
|
|
|
68 };
|
|
|
69
|
|
|
70 static void gfc_init_decl_processing (void);
|
|
|
71 static void gfc_init_builtin_functions (void);
|
|
|
72 static bool global_bindings_p (void);
|
|
|
73
|
|
|
74 /* Each front end provides its own. */
|
|
|
75 static bool gfc_init (void);
|
|
|
76 static void gfc_finish (void);
|
|
|
77 static void gfc_be_parse_file (void);
|
|
|
78 static void gfc_init_ts (void);
|
|
|
79 static tree gfc_builtin_function (tree);
|
|
|
80
|
|
|
81 /* Handle an "omp declare target" attribute; arguments as in
|
|
|
82 struct attribute_spec.handler. */
|
|
|
83 static tree
|
|
|
84 gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *)
|
|
|
85 {
|
|
|
86 return NULL_TREE;
|
|
|
87 }
|
|
|
88
|
|
|
89 /* Table of valid Fortran attributes. */
|
|
|
90 static const struct attribute_spec gfc_attribute_table[] =
|
|
|
91 {
|
|
131
|
92 /* { name, min_len, max_len, decl_req, type_req, fn_type_req,
|
|
|
93 affects_type_identity, handler, exclude } */
|
|
145
|
94 { "omp declare target", 0, -1, true, false, false, false,
|
|
131
|
95 gfc_handle_omp_declare_target_attribute, NULL },
|
|
|
96 { "omp declare target link", 0, 0, true, false, false, false,
|
|
|
97 gfc_handle_omp_declare_target_attribute, NULL },
|
|
|
98 { "oacc function", 0, -1, true, false, false, false,
|
|
|
99 gfc_handle_omp_declare_target_attribute, NULL },
|
|
|
100 { NULL, 0, 0, false, false, false, false, NULL, NULL }
|
|
111
|
101 };
|
|
|
102
|
|
|
103 #undef LANG_HOOKS_NAME
|
|
|
104 #undef LANG_HOOKS_INIT
|
|
|
105 #undef LANG_HOOKS_FINISH
|
|
|
106 #undef LANG_HOOKS_OPTION_LANG_MASK
|
|
|
107 #undef LANG_HOOKS_INIT_OPTIONS_STRUCT
|
|
|
108 #undef LANG_HOOKS_INIT_OPTIONS
|
|
|
109 #undef LANG_HOOKS_HANDLE_OPTION
|
|
|
110 #undef LANG_HOOKS_POST_OPTIONS
|
|
|
111 #undef LANG_HOOKS_PARSE_FILE
|
|
|
112 #undef LANG_HOOKS_MARK_ADDRESSABLE
|
|
|
113 #undef LANG_HOOKS_TYPE_FOR_MODE
|
|
|
114 #undef LANG_HOOKS_TYPE_FOR_SIZE
|
|
|
115 #undef LANG_HOOKS_INIT_TS
|
|
145
|
116 #undef LANG_HOOKS_OMP_ARRAY_DATA
|
|
|
117 #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
|
|
|
118 #undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
|
|
111
|
119 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
|
|
|
120 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
|
|
|
121 #undef LANG_HOOKS_OMP_REPORT_DECL
|
|
|
122 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
|
|
|
123 #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
|
|
|
124 #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
|
|
|
125 #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
|
|
|
126 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
|
|
|
127 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
|
|
|
128 #undef LANG_HOOKS_OMP_SCALAR_P
|
|
|
129 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
|
|
|
130 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
|
|
|
131 #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
|
|
|
132 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
|
|
|
133 #undef LANG_HOOKS_BUILTIN_FUNCTION
|
|
|
134 #undef LANG_HOOKS_BUILTIN_FUNCTION
|
|
|
135 #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
|
|
|
136 #undef LANG_HOOKS_ATTRIBUTE_TABLE
|
|
|
137
|
|
|
138 /* Define lang hooks. */
|
|
|
139 #define LANG_HOOKS_NAME "GNU Fortran"
|
|
|
140 #define LANG_HOOKS_INIT gfc_init
|
|
|
141 #define LANG_HOOKS_FINISH gfc_finish
|
|
|
142 #define LANG_HOOKS_OPTION_LANG_MASK gfc_option_lang_mask
|
|
|
143 #define LANG_HOOKS_INIT_OPTIONS_STRUCT gfc_init_options_struct
|
|
|
144 #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
|
|
|
145 #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
|
|
|
146 #define LANG_HOOKS_POST_OPTIONS gfc_post_options
|
|
|
147 #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
|
|
|
148 #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
|
|
|
149 #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
|
|
|
150 #define LANG_HOOKS_INIT_TS gfc_init_ts
|
|
145
|
151 #define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data
|
|
|
152 #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr
|
|
|
153 #define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument
|
|
111
|
154 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
|
|
|
155 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
|
|
|
156 #define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl
|
|
|
157 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
|
|
|
158 #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor
|
|
|
159 #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op
|
|
|
160 #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
|
|
|
161 #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
|
|
|
162 #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
|
|
|
163 #define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p
|
|
|
164 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
|
|
|
165 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
|
|
|
166 #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref
|
|
|
167 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
|
|
|
168 gfc_omp_firstprivatize_type_sizes
|
|
|
169 #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
|
|
|
170 #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
|
|
|
171 #define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table
|
|
|
172
|
|
|
173 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
|
|
|
174
|
|
|
175 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
|
|
|
176
|
|
|
177 /* A chain of binding_level structures awaiting reuse. */
|
|
|
178
|
|
|
179 static GTY(()) struct binding_level *free_binding_level;
|
|
|
180
|
|
|
181 /* True means we've initialized exception handling. */
|
|
|
182 static bool gfc_eh_initialized_p;
|
|
|
183
|
|
|
184 /* The current translation unit. */
|
|
|
185 static GTY(()) tree current_translation_unit;
|
|
|
186
|
|
|
187
|
|
|
188 static void
|
|
|
189 gfc_create_decls (void)
|
|
|
190 {
|
|
|
191 /* GCC builtins. */
|
|
|
192 gfc_init_builtin_functions ();
|
|
|
193
|
|
|
194 /* Runtime/IO library functions. */
|
|
|
195 gfc_build_builtin_function_decls ();
|
|
|
196
|
|
|
197 gfc_init_constants ();
|
|
|
198
|
|
|
199 /* Build our translation-unit decl. */
|
|
|
200 current_translation_unit
|
|
|
201 = build_translation_unit_decl (get_identifier (main_input_filename));
|
|
|
202 debug_hooks->register_main_translation_unit (current_translation_unit);
|
|
|
203 }
|
|
|
204
|
|
|
205
|
|
|
206 static void
|
|
|
207 gfc_be_parse_file (void)
|
|
|
208 {
|
|
|
209 gfc_create_decls ();
|
|
|
210 gfc_parse_file ();
|
|
|
211 gfc_generate_constructors ();
|
|
|
212
|
|
|
213 /* Clear the binding level stack. */
|
|
|
214 while (!global_bindings_p ())
|
|
|
215 poplevel (0, 0);
|
|
|
216
|
|
|
217 /* Finalize all of the globals.
|
|
|
218
|
|
|
219 Emulated tls lowering needs to see all TLS variables before we
|
|
|
220 call finalize_compilation_unit. The C/C++ front ends manage this
|
|
|
221 by calling decl_rest_of_compilation on each global and static
|
|
|
222 variable as they are seen. The Fortran front end waits until
|
|
|
223 here. */
|
|
|
224 for (tree decl = getdecls (); decl ; decl = DECL_CHAIN (decl))
|
|
|
225 rest_of_decl_compilation (decl, true, true);
|
|
|
226
|
|
|
227 /* Switch to the default tree diagnostics here, because there may be
|
|
|
228 diagnostics before gfc_finish(). */
|
|
|
229 gfc_diagnostics_finish ();
|
|
|
230
|
|
|
231 global_decl_processing ();
|
|
|
232 }
|
|
|
233
|
|
|
234
|
|
|
235 /* Initialize everything. */
|
|
|
236
|
|
|
237 static bool
|
|
|
238 gfc_init (void)
|
|
|
239 {
|
|
|
240 if (!gfc_cpp_enabled ())
|
|
|
241 {
|
|
|
242 linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
|
|
|
243 linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
|
|
|
244 }
|
|
|
245 else
|
|
|
246 gfc_cpp_init_0 ();
|
|
|
247
|
|
|
248 gfc_init_decl_processing ();
|
|
|
249 gfc_static_ctors = NULL_TREE;
|
|
|
250
|
|
|
251 if (gfc_cpp_enabled ())
|
|
|
252 gfc_cpp_init ();
|
|
|
253
|
|
|
254 gfc_init_1 ();
|
|
|
255
|
|
|
256 if (!gfc_new_file ())
|
|
145
|
257 fatal_error (input_location, "cannot open input file: %s", gfc_source_file);
|
|
111
|
258
|
|
|
259 if (flag_preprocess_only)
|
|
|
260 return false;
|
|
|
261
|
|
|
262 return true;
|
|
|
263 }
|
|
|
264
|
|
|
265
|
|
|
266 static void
|
|
|
267 gfc_finish (void)
|
|
|
268 {
|
|
|
269 gfc_cpp_done ();
|
|
|
270 gfc_done_1 ();
|
|
|
271 gfc_release_include_path ();
|
|
|
272 return;
|
|
|
273 }
|
|
|
274
|
|
|
275 /* These functions and variables deal with binding contours. We only
|
|
|
276 need these functions for the list of PARM_DECLs, but we leave the
|
|
|
277 functions more general; these are a simplified version of the
|
|
|
278 functions from GNAT. */
|
|
|
279
|
|
|
280 /* For each binding contour we allocate a binding_level structure which
|
|
|
281 records the entities defined or declared in that contour. Contours
|
|
|
282 include:
|
|
|
283
|
|
|
284 the global one
|
|
|
285 one for each subprogram definition
|
|
|
286 one for each compound statement (declare block)
|
|
|
287
|
|
|
288 Binding contours are used to create GCC tree BLOCK nodes. */
|
|
|
289
|
|
|
290 struct GTY(())
|
|
|
291 binding_level {
|
|
|
292 /* A chain of ..._DECL nodes for all variables, constants, functions,
|
|
|
293 parameters and type declarations. These ..._DECL nodes are chained
|
|
|
294 through the DECL_CHAIN field. */
|
|
|
295 tree names;
|
|
|
296 /* For each level (except the global one), a chain of BLOCK nodes for all
|
|
|
297 the levels that were entered and exited one level down from this one. */
|
|
|
298 tree blocks;
|
|
|
299 /* The binding level containing this one (the enclosing binding level). */
|
|
|
300 struct binding_level *level_chain;
|
|
|
301 /* True if nreverse has been already called on names; if false, names
|
|
|
302 are ordered from newest declaration to oldest one. */
|
|
|
303 bool reversed;
|
|
|
304 };
|
|
|
305
|
|
|
306 /* The binding level currently in effect. */
|
|
|
307 static GTY(()) struct binding_level *current_binding_level = NULL;
|
|
|
308
|
|
|
309 /* The outermost binding level. This binding level is created when the
|
|
|
310 compiler is started and it will exist through the entire compilation. */
|
|
|
311 static GTY(()) struct binding_level *global_binding_level;
|
|
|
312
|
|
|
313 /* Binding level structures are initialized by copying this one. */
|
|
|
314 static struct binding_level clear_binding_level = { NULL, NULL, NULL, false };
|
|
|
315
|
|
|
316
|
|
|
317 /* Return true if we are in the global binding level. */
|
|
|
318
|
|
|
319 bool
|
|
|
320 global_bindings_p (void)
|
|
|
321 {
|
|
|
322 return current_binding_level == global_binding_level;
|
|
|
323 }
|
|
|
324
|
|
|
325 tree
|
|
|
326 getdecls (void)
|
|
|
327 {
|
|
|
328 if (!current_binding_level->reversed)
|
|
|
329 {
|
|
|
330 current_binding_level->reversed = true;
|
|
|
331 current_binding_level->names = nreverse (current_binding_level->names);
|
|
|
332 }
|
|
|
333 return current_binding_level->names;
|
|
|
334 }
|
|
|
335
|
|
|
336 /* Enter a new binding level. */
|
|
|
337
|
|
|
338 void
|
|
|
339 pushlevel (void)
|
|
|
340 {
|
|
|
341 struct binding_level *newlevel = ggc_alloc<binding_level> ();
|
|
|
342
|
|
|
343 *newlevel = clear_binding_level;
|
|
|
344
|
|
|
345 /* Add this level to the front of the chain (stack) of levels that are
|
|
|
346 active. */
|
|
|
347 newlevel->level_chain = current_binding_level;
|
|
|
348 current_binding_level = newlevel;
|
|
|
349 }
|
|
|
350
|
|
|
351 /* Exit a binding level.
|
|
|
352 Pop the level off, and restore the state of the identifier-decl mappings
|
|
|
353 that were in effect when this level was entered.
|
|
|
354
|
|
|
355 If KEEP is nonzero, this level had explicit declarations, so
|
|
|
356 and create a "block" (a BLOCK node) for the level
|
|
|
357 to record its declarations and subblocks for symbol table output.
|
|
|
358
|
|
|
359 If FUNCTIONBODY is nonzero, this level is the body of a function,
|
|
|
360 so create a block as if KEEP were set and also clear out all
|
|
|
361 label names. */
|
|
|
362
|
|
|
363 tree
|
|
|
364 poplevel (int keep, int functionbody)
|
|
|
365 {
|
|
|
366 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
|
|
|
367 binding level that we are about to exit and which is returned by this
|
|
|
368 routine. */
|
|
|
369 tree block_node = NULL_TREE;
|
|
|
370 tree decl_chain = getdecls ();
|
|
|
371 tree subblock_chain = current_binding_level->blocks;
|
|
|
372 tree subblock_node;
|
|
|
373
|
|
|
374 /* If there were any declarations in the current binding level, or if this
|
|
|
375 binding level is a function body, or if there are any nested blocks then
|
|
|
376 create a BLOCK node to record them for the life of this function. */
|
|
|
377 if (keep || functionbody)
|
|
|
378 block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
|
|
|
379
|
|
|
380 /* Record the BLOCK node just built as the subblock its enclosing scope. */
|
|
|
381 for (subblock_node = subblock_chain; subblock_node;
|
|
|
382 subblock_node = BLOCK_CHAIN (subblock_node))
|
|
|
383 BLOCK_SUPERCONTEXT (subblock_node) = block_node;
|
|
|
384
|
|
|
385 /* Clear out the meanings of the local variables of this level. */
|
|
|
386
|
|
|
387 for (subblock_node = decl_chain; subblock_node;
|
|
|
388 subblock_node = DECL_CHAIN (subblock_node))
|
|
|
389 if (DECL_NAME (subblock_node) != 0)
|
|
|
390 /* If the identifier was used or addressed via a local extern decl,
|
|
|
391 don't forget that fact. */
|
|
|
392 if (DECL_EXTERNAL (subblock_node))
|
|
|
393 {
|
|
|
394 if (TREE_USED (subblock_node))
|
|
|
395 TREE_USED (DECL_NAME (subblock_node)) = 1;
|
|
|
396 if (TREE_ADDRESSABLE (subblock_node))
|
|
|
397 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
|
|
|
398 }
|
|
|
399
|
|
|
400 /* Pop the current level. */
|
|
|
401 current_binding_level = current_binding_level->level_chain;
|
|
|
402
|
|
|
403 if (functionbody)
|
|
|
404 /* This is the top level block of a function. */
|
|
|
405 DECL_INITIAL (current_function_decl) = block_node;
|
|
|
406 else if (current_binding_level == global_binding_level)
|
|
|
407 /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
|
|
|
408 don't add newly created BLOCKs as subblocks of global_binding_level. */
|
|
|
409 ;
|
|
|
410 else if (block_node)
|
|
|
411 {
|
|
|
412 current_binding_level->blocks
|
|
|
413 = block_chainon (current_binding_level->blocks, block_node);
|
|
|
414 }
|
|
|
415
|
|
|
416 /* If we did not make a block for the level just exited, any blocks made for
|
|
|
417 inner levels (since they cannot be recorded as subblocks in that level)
|
|
|
418 must be carried forward so they will later become subblocks of something
|
|
|
419 else. */
|
|
|
420 else if (subblock_chain)
|
|
|
421 current_binding_level->blocks
|
|
|
422 = block_chainon (current_binding_level->blocks, subblock_chain);
|
|
|
423 if (block_node)
|
|
|
424 TREE_USED (block_node) = 1;
|
|
|
425
|
|
|
426 return block_node;
|
|
|
427 }
|
|
|
428
|
|
|
429
|
|
|
430 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
|
|
|
431 Returns the ..._DECL node. */
|
|
|
432
|
|
|
433 tree
|
|
|
434 pushdecl (tree decl)
|
|
|
435 {
|
|
|
436 if (global_bindings_p ())
|
|
|
437 DECL_CONTEXT (decl) = current_translation_unit;
|
|
|
438 else
|
|
|
439 {
|
|
|
440 /* External objects aren't nested. For debug info insert a copy
|
|
|
441 of the decl into the binding level. */
|
|
|
442 if (DECL_EXTERNAL (decl))
|
|
|
443 {
|
|
|
444 tree orig = decl;
|
|
|
445 decl = copy_node (decl);
|
|
|
446 DECL_CONTEXT (orig) = NULL_TREE;
|
|
|
447 }
|
|
|
448 DECL_CONTEXT (decl) = current_function_decl;
|
|
|
449 }
|
|
|
450
|
|
|
451 /* Put the declaration on the list. */
|
|
|
452 DECL_CHAIN (decl) = current_binding_level->names;
|
|
|
453 current_binding_level->names = decl;
|
|
|
454
|
|
|
455 /* For the declaration of a type, set its name if it is not already set. */
|
|
|
456
|
|
|
457 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
|
|
|
458 {
|
|
|
459 if (DECL_SOURCE_LINE (decl) == 0)
|
|
|
460 TYPE_NAME (TREE_TYPE (decl)) = decl;
|
|
|
461 else
|
|
|
462 TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
|
|
|
463 }
|
|
|
464
|
|
|
465 return decl;
|
|
|
466 }
|
|
|
467
|
|
|
468
|
|
|
469 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
|
|
|
470
|
|
|
471 tree
|
|
|
472 pushdecl_top_level (tree x)
|
|
|
473 {
|
|
|
474 tree t;
|
|
|
475 struct binding_level *b = current_binding_level;
|
|
|
476
|
|
|
477 current_binding_level = global_binding_level;
|
|
|
478 t = pushdecl (x);
|
|
|
479 current_binding_level = b;
|
|
|
480 return t;
|
|
|
481 }
|
|
|
482
|
|
|
483 #ifndef CHAR_TYPE_SIZE
|
|
|
484 #define CHAR_TYPE_SIZE BITS_PER_UNIT
|
|
|
485 #endif
|
|
|
486
|
|
|
487 #ifndef INT_TYPE_SIZE
|
|
|
488 #define INT_TYPE_SIZE BITS_PER_WORD
|
|
|
489 #endif
|
|
|
490
|
|
|
491 #undef SIZE_TYPE
|
|
|
492 #define SIZE_TYPE "long unsigned int"
|
|
|
493
|
|
|
494 /* Create tree nodes for the basic scalar types of Fortran 95,
|
|
|
495 and some nodes representing standard constants (0, 1, (void *) 0).
|
|
|
496 Initialize the global binding level.
|
|
|
497 Make definitions for built-in primitive functions. */
|
|
|
498 static void
|
|
|
499 gfc_init_decl_processing (void)
|
|
|
500 {
|
|
|
501 current_function_decl = NULL;
|
|
|
502 current_binding_level = NULL_BINDING_LEVEL;
|
|
|
503 free_binding_level = NULL_BINDING_LEVEL;
|
|
|
504
|
|
|
505 /* Make the binding_level structure for global names. We move all
|
|
|
506 variables that are in a COMMON block to this binding level. */
|
|
|
507 pushlevel ();
|
|
|
508 global_binding_level = current_binding_level;
|
|
|
509
|
|
|
510 /* Build common tree nodes. char_type_node is unsigned because we
|
|
|
511 only use it for actual characters, not for INTEGER(1). */
|
|
|
512 build_common_tree_nodes (false);
|
|
|
513
|
|
|
514 void_list_node = build_tree_list (NULL_TREE, void_type_node);
|
|
|
515
|
|
|
516 /* Set up F95 type nodes. */
|
|
|
517 gfc_init_kinds ();
|
|
|
518 gfc_init_types ();
|
|
|
519 gfc_init_c_interop_kinds ();
|
|
|
520 }
|
|
|
521
|
|
|
522
|
|
|
523 /* Builtin function initialization. */
|
|
|
524
|
|
|
525 static tree
|
|
|
526 gfc_builtin_function (tree decl)
|
|
|
527 {
|
|
|
528 pushdecl (decl);
|
|
|
529 return decl;
|
|
|
530 }
|
|
|
531
|
|
|
532 /* So far we need just these 7 attribute types. */
|
|
|
533 #define ATTR_NULL 0
|
|
|
534 #define ATTR_LEAF_LIST (ECF_LEAF)
|
|
|
535 #define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
|
|
|
536 #define ATTR_NOTHROW_LEAF_MALLOC_LIST (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
|
|
|
537 #define ATTR_CONST_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
|
|
|
538 #define ATTR_PURE_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_PURE)
|
|
|
539 #define ATTR_NOTHROW_LIST (ECF_NOTHROW)
|
|
|
540 #define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
|
|
|
541
|
|
|
542 static void
|
|
|
543 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
|
|
|
544 const char *library_name, int attr)
|
|
|
545 {
|
|
|
546 tree decl;
|
|
|
547
|
|
|
548 decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
|
|
|
549 library_name, NULL_TREE);
|
|
|
550 set_call_expr_flags (decl, attr);
|
|
|
551
|
|
|
552 set_builtin_decl (code, decl, true);
|
|
|
553 }
|
|
|
554
|
|
|
555
|
|
|
556 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
|
|
|
557 gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
|
|
|
558 BUILT_IN_ ## code ## L, name "l", \
|
|
|
559 ATTR_CONST_NOTHROW_LEAF_LIST); \
|
|
|
560 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
|
|
|
561 BUILT_IN_ ## code, name, \
|
|
|
562 ATTR_CONST_NOTHROW_LEAF_LIST); \
|
|
|
563 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
|
|
|
564 BUILT_IN_ ## code ## F, name "f", \
|
|
|
565 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
566
|
|
|
567 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
|
|
|
568 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
|
|
|
569
|
|
|
570 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
|
|
|
571 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
|
|
|
572 DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
|
|
|
573
|
|
|
574
|
|
|
575 /* Create function types for builtin functions. */
|
|
|
576
|
|
|
577 static void
|
|
|
578 build_builtin_fntypes (tree *fntype, tree type)
|
|
|
579 {
|
|
|
580 /* type (*) (type) */
|
|
|
581 fntype[0] = build_function_type_list (type, type, NULL_TREE);
|
|
|
582 /* type (*) (type, type) */
|
|
|
583 fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
|
|
|
584 /* type (*) (type, int) */
|
|
|
585 fntype[2] = build_function_type_list (type,
|
|
|
586 type, integer_type_node, NULL_TREE);
|
|
|
587 /* type (*) (void) */
|
|
|
588 fntype[3] = build_function_type_list (type, NULL_TREE);
|
|
|
589 /* type (*) (type, &int) */
|
|
|
590 fntype[4] = build_function_type_list (type, type,
|
|
|
591 build_pointer_type (integer_type_node),
|
|
|
592 NULL_TREE);
|
|
|
593 /* type (*) (int, type) */
|
|
|
594 fntype[5] = build_function_type_list (type,
|
|
|
595 integer_type_node, type, NULL_TREE);
|
|
|
596 }
|
|
|
597
|
|
|
598
|
|
|
599 static tree
|
|
|
600 builtin_type_for_size (int size, bool unsignedp)
|
|
|
601 {
|
|
|
602 tree type = gfc_type_for_size (size, unsignedp);
|
|
|
603 return type ? type : error_mark_node;
|
|
|
604 }
|
|
|
605
|
|
|
606 /* Initialization of builtin function nodes. */
|
|
|
607
|
|
|
608 static void
|
|
|
609 gfc_init_builtin_functions (void)
|
|
|
610 {
|
|
|
611 enum builtin_type
|
|
|
612 {
|
|
|
613 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
|
|
|
614 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
|
|
|
615 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
|
|
|
616 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
|
|
|
617 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
|
|
|
618 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
|
|
|
619 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
|
|
|
620 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
621 ARG6) NAME,
|
|
|
622 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
623 ARG6, ARG7) NAME,
|
|
|
624 #define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
625 ARG6, ARG7, ARG8) NAME,
|
|
|
626 #define DEF_FUNCTION_TYPE_9(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
627 ARG6, ARG7, ARG8, ARG9) NAME,
|
|
|
628 #define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
629 ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
|
|
|
630 #define DEF_FUNCTION_TYPE_11(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
631 ARG6, ARG7, ARG8, ARG9, ARG10, ARG11) NAME,
|
|
|
632 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
|
|
|
633 #define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
|
|
|
634 #define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
|
|
|
635 #define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
636 ARG6) NAME,
|
|
|
637 #define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
638 ARG6, ARG7) NAME,
|
|
|
639 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
|
|
|
640 #include "types.def"
|
|
|
641 #undef DEF_PRIMITIVE_TYPE
|
|
|
642 #undef DEF_FUNCTION_TYPE_0
|
|
|
643 #undef DEF_FUNCTION_TYPE_1
|
|
|
644 #undef DEF_FUNCTION_TYPE_2
|
|
|
645 #undef DEF_FUNCTION_TYPE_3
|
|
|
646 #undef DEF_FUNCTION_TYPE_4
|
|
|
647 #undef DEF_FUNCTION_TYPE_5
|
|
|
648 #undef DEF_FUNCTION_TYPE_6
|
|
|
649 #undef DEF_FUNCTION_TYPE_7
|
|
|
650 #undef DEF_FUNCTION_TYPE_8
|
|
|
651 #undef DEF_FUNCTION_TYPE_9
|
|
|
652 #undef DEF_FUNCTION_TYPE_10
|
|
|
653 #undef DEF_FUNCTION_TYPE_11
|
|
|
654 #undef DEF_FUNCTION_TYPE_VAR_0
|
|
|
655 #undef DEF_FUNCTION_TYPE_VAR_1
|
|
|
656 #undef DEF_FUNCTION_TYPE_VAR_2
|
|
|
657 #undef DEF_FUNCTION_TYPE_VAR_6
|
|
|
658 #undef DEF_FUNCTION_TYPE_VAR_7
|
|
|
659 #undef DEF_POINTER_TYPE
|
|
|
660 BT_LAST
|
|
|
661 };
|
|
|
662
|
|
|
663 tree mfunc_float[6];
|
|
|
664 tree mfunc_double[6];
|
|
|
665 tree mfunc_longdouble[6];
|
|
|
666 tree mfunc_cfloat[6];
|
|
|
667 tree mfunc_cdouble[6];
|
|
|
668 tree mfunc_clongdouble[6];
|
|
|
669 tree func_cfloat_float, func_float_cfloat;
|
|
|
670 tree func_cdouble_double, func_double_cdouble;
|
|
|
671 tree func_clongdouble_longdouble, func_longdouble_clongdouble;
|
|
|
672 tree func_float_floatp_floatp;
|
|
|
673 tree func_double_doublep_doublep;
|
|
|
674 tree func_longdouble_longdoublep_longdoublep;
|
|
|
675 tree ftype, ptype;
|
|
|
676 tree builtin_types[(int) BT_LAST + 1];
|
|
|
677
|
|
|
678 int attr;
|
|
|
679
|
|
|
680 build_builtin_fntypes (mfunc_float, float_type_node);
|
|
|
681 build_builtin_fntypes (mfunc_double, double_type_node);
|
|
|
682 build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
|
|
|
683 build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
|
|
|
684 build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
|
|
|
685 build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
|
|
|
686
|
|
|
687 func_cfloat_float = build_function_type_list (float_type_node,
|
|
|
688 complex_float_type_node,
|
|
|
689 NULL_TREE);
|
|
|
690
|
|
|
691 func_float_cfloat = build_function_type_list (complex_float_type_node,
|
|
|
692 float_type_node, NULL_TREE);
|
|
|
693
|
|
|
694 func_cdouble_double = build_function_type_list (double_type_node,
|
|
|
695 complex_double_type_node,
|
|
|
696 NULL_TREE);
|
|
|
697
|
|
|
698 func_double_cdouble = build_function_type_list (complex_double_type_node,
|
|
|
699 double_type_node, NULL_TREE);
|
|
|
700
|
|
|
701 func_clongdouble_longdouble =
|
|
|
702 build_function_type_list (long_double_type_node,
|
|
|
703 complex_long_double_type_node, NULL_TREE);
|
|
|
704
|
|
|
705 func_longdouble_clongdouble =
|
|
|
706 build_function_type_list (complex_long_double_type_node,
|
|
|
707 long_double_type_node, NULL_TREE);
|
|
|
708
|
|
|
709 ptype = build_pointer_type (float_type_node);
|
|
|
710 func_float_floatp_floatp =
|
|
|
711 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
|
|
|
712
|
|
|
713 ptype = build_pointer_type (double_type_node);
|
|
|
714 func_double_doublep_doublep =
|
|
|
715 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
|
|
|
716
|
|
|
717 ptype = build_pointer_type (long_double_type_node);
|
|
|
718 func_longdouble_longdoublep_longdoublep =
|
|
|
719 build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
|
|
|
720
|
|
|
721 /* Non-math builtins are defined manually, so they're not included here. */
|
|
|
722 #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
|
|
|
723
|
|
|
724 #include "mathbuiltins.def"
|
|
|
725
|
|
|
726 gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
|
|
|
727 BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
728 gfc_define_builtin ("__builtin_round", mfunc_double[0],
|
|
|
729 BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
730 gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
|
|
|
731 BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
732
|
|
|
733 gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
|
|
|
734 BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
735 gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
|
|
|
736 BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
737 gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
|
|
|
738 BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
739
|
|
|
740 gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
|
|
|
741 BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
742 gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
|
|
|
743 BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
744 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
|
|
|
745 BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
746
|
|
|
747 gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
|
|
|
748 BUILT_IN_COPYSIGNL, "copysignl",
|
|
|
749 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
750 gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
|
|
|
751 BUILT_IN_COPYSIGN, "copysign",
|
|
|
752 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
753 gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
|
|
|
754 BUILT_IN_COPYSIGNF, "copysignf",
|
|
|
755 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
756
|
|
|
757 gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
|
|
|
758 BUILT_IN_NEXTAFTERL, "nextafterl",
|
|
|
759 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
760 gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
|
|
|
761 BUILT_IN_NEXTAFTER, "nextafter",
|
|
|
762 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
763 gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
|
|
|
764 BUILT_IN_NEXTAFTERF, "nextafterf",
|
|
|
765 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
766
|
|
|
767 /* Some built-ins depend on rounding mode. Depending on compilation options, they
|
|
|
768 will be "pure" or "const". */
|
|
|
769 attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
|
|
|
770
|
|
|
771 gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0],
|
|
|
772 BUILT_IN_RINTL, "rintl", attr);
|
|
|
773 gfc_define_builtin ("__builtin_rint", mfunc_double[0],
|
|
|
774 BUILT_IN_RINT, "rint", attr);
|
|
|
775 gfc_define_builtin ("__builtin_rintf", mfunc_float[0],
|
|
|
776 BUILT_IN_RINTF, "rintf", attr);
|
|
|
777
|
|
|
778 gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1],
|
|
|
779 BUILT_IN_REMAINDERL, "remainderl", attr);
|
|
|
780 gfc_define_builtin ("__builtin_remainder", mfunc_double[1],
|
|
|
781 BUILT_IN_REMAINDER, "remainder", attr);
|
|
|
782 gfc_define_builtin ("__builtin_remainderf", mfunc_float[1],
|
|
|
783 BUILT_IN_REMAINDERF, "remainderf", attr);
|
|
|
784
|
|
|
785 gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0],
|
|
|
786 BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
787 gfc_define_builtin ("__builtin_logb", mfunc_double[0],
|
|
|
788 BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
789 gfc_define_builtin ("__builtin_logbf", mfunc_float[0],
|
|
|
790 BUILT_IN_LOGBF, "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
791
|
|
|
792
|
|
|
793 gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
|
|
|
794 BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
|
|
|
795 gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
|
|
|
796 BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
|
|
|
797 gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
|
|
|
798 BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
|
|
|
799
|
|
|
800 gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
|
|
|
801 BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
802 gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
|
|
|
803 BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
804 gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
|
|
|
805 BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
806
|
|
|
807 gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[2],
|
|
|
808 BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
809 gfc_define_builtin ("__builtin_scalbn", mfunc_double[2],
|
|
|
810 BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
811 gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2],
|
|
|
812 BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
813
|
|
|
814 gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
|
|
|
815 BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
816 gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
|
|
|
817 BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
818 gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
|
|
|
819 BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
820
|
|
|
821 /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
|
|
|
822 ftype = build_function_type_list (integer_type_node,
|
|
|
823 float_type_node, NULL_TREE);
|
|
|
824 gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
|
|
|
825 "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
826 ftype = build_function_type_list (long_integer_type_node,
|
|
|
827 float_type_node, NULL_TREE);
|
|
|
828 gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
|
|
|
829 "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
830 ftype = build_function_type_list (long_long_integer_type_node,
|
|
|
831 float_type_node, NULL_TREE);
|
|
|
832 gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
|
|
|
833 "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
834
|
|
|
835 ftype = build_function_type_list (integer_type_node,
|
|
|
836 double_type_node, NULL_TREE);
|
|
|
837 gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
|
|
|
838 "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
839 ftype = build_function_type_list (long_integer_type_node,
|
|
|
840 double_type_node, NULL_TREE);
|
|
|
841 gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
|
|
|
842 "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
843 ftype = build_function_type_list (long_long_integer_type_node,
|
|
|
844 double_type_node, NULL_TREE);
|
|
|
845 gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
|
|
|
846 "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
847
|
|
|
848 ftype = build_function_type_list (integer_type_node,
|
|
|
849 long_double_type_node, NULL_TREE);
|
|
|
850 gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
|
|
|
851 "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
852 ftype = build_function_type_list (long_integer_type_node,
|
|
|
853 long_double_type_node, NULL_TREE);
|
|
|
854 gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
|
|
|
855 "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
856 ftype = build_function_type_list (long_long_integer_type_node,
|
|
|
857 long_double_type_node, NULL_TREE);
|
|
|
858 gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
|
|
|
859 "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
860
|
|
|
861 /* These are used to implement the ** operator. */
|
|
|
862 gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
|
|
|
863 BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
864 gfc_define_builtin ("__builtin_pow", mfunc_double[1],
|
|
|
865 BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
866 gfc_define_builtin ("__builtin_powf", mfunc_float[1],
|
|
|
867 BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
868 gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
|
|
|
869 BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
870 gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
|
|
|
871 BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
872 gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
|
|
|
873 BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
874 gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
|
|
|
875 BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
876 gfc_define_builtin ("__builtin_powi", mfunc_double[2],
|
|
|
877 BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
878 gfc_define_builtin ("__builtin_powif", mfunc_float[2],
|
|
|
879 BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
880
|
|
|
881
|
|
|
882 if (targetm.libc_has_function (function_c99_math_complex))
|
|
|
883 {
|
|
|
884 gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
|
|
|
885 BUILT_IN_CBRTL, "cbrtl",
|
|
|
886 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
887 gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
|
|
|
888 BUILT_IN_CBRT, "cbrt",
|
|
|
889 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
890 gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
|
|
|
891 BUILT_IN_CBRTF, "cbrtf",
|
|
|
892 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
893 gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
|
|
|
894 BUILT_IN_CEXPIL, "cexpil",
|
|
|
895 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
896 gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
|
|
|
897 BUILT_IN_CEXPI, "cexpi",
|
|
|
898 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
899 gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
|
|
|
900 BUILT_IN_CEXPIF, "cexpif",
|
|
|
901 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
902 }
|
|
|
903
|
|
|
904 if (targetm.libc_has_function (function_sincos))
|
|
|
905 {
|
|
|
906 gfc_define_builtin ("__builtin_sincosl",
|
|
|
907 func_longdouble_longdoublep_longdoublep,
|
|
|
908 BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
|
|
|
909 gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
|
|
|
910 BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
|
|
|
911 gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
|
|
|
912 BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
|
|
|
913 }
|
|
|
914
|
|
|
915 /* For LEADZ, TRAILZ, POPCNT and POPPAR. */
|
|
|
916 ftype = build_function_type_list (integer_type_node,
|
|
|
917 unsigned_type_node, NULL_TREE);
|
|
|
918 gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
|
|
|
919 "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
920 gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
|
|
|
921 "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
922 gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
|
|
|
923 "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
924 gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
|
|
|
925 "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
926
|
|
|
927 ftype = build_function_type_list (integer_type_node,
|
|
|
928 long_unsigned_type_node, NULL_TREE);
|
|
|
929 gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
|
|
|
930 "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
931 gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
|
|
|
932 "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
933 gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
|
|
|
934 "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
935 gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
|
|
|
936 "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
937
|
|
|
938 ftype = build_function_type_list (integer_type_node,
|
|
|
939 long_long_unsigned_type_node, NULL_TREE);
|
|
|
940 gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
|
|
|
941 "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
942 gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
|
|
|
943 "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
944 gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
|
|
|
945 "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
946 gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
|
|
|
947 "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
948
|
|
|
949 /* Other builtin functions we use. */
|
|
|
950
|
|
|
951 ftype = build_function_type_list (long_integer_type_node,
|
|
|
952 long_integer_type_node,
|
|
|
953 long_integer_type_node, NULL_TREE);
|
|
|
954 gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
|
|
|
955 "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
956
|
|
|
957 ftype = build_function_type_list (void_type_node,
|
|
|
958 pvoid_type_node, NULL_TREE);
|
|
|
959 gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
|
|
|
960 "free", ATTR_NOTHROW_LEAF_LIST);
|
|
|
961
|
|
|
962 ftype = build_function_type_list (pvoid_type_node,
|
|
|
963 size_type_node, NULL_TREE);
|
|
|
964 gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
|
|
|
965 "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
|
|
|
966
|
|
|
967 ftype = build_function_type_list (pvoid_type_node, size_type_node,
|
|
|
968 size_type_node, NULL_TREE);
|
|
|
969 gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
|
|
|
970 "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
|
|
|
971 DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
|
|
|
972
|
|
|
973 ftype = build_function_type_list (pvoid_type_node,
|
|
|
974 size_type_node, pvoid_type_node,
|
|
|
975 NULL_TREE);
|
|
|
976 gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
|
|
|
977 "realloc", ATTR_NOTHROW_LEAF_LIST);
|
|
|
978
|
|
|
979 /* Type-generic floating-point classification built-ins. */
|
|
|
980
|
|
|
981 ftype = build_function_type (integer_type_node, NULL_TREE);
|
|
|
982 gfc_define_builtin ("__builtin_isfinite", ftype, BUILT_IN_ISFINITE,
|
|
|
983 "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
984 gfc_define_builtin ("__builtin_isinf", ftype, BUILT_IN_ISINF,
|
|
|
985 "__builtin_isinf", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
986 gfc_define_builtin ("__builtin_isinf_sign", ftype, BUILT_IN_ISINF_SIGN,
|
|
|
987 "__builtin_isinf_sign", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
988 gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
|
|
|
989 "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
990 gfc_define_builtin ("__builtin_isnormal", ftype, BUILT_IN_ISNORMAL,
|
|
|
991 "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
992 gfc_define_builtin ("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
|
|
|
993 "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
994
|
|
|
995 ftype = build_function_type (integer_type_node, NULL_TREE);
|
|
|
996 gfc_define_builtin ("__builtin_isless", ftype, BUILT_IN_ISLESS,
|
|
|
997 "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
998 gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
|
|
|
999 "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1000 gfc_define_builtin ("__builtin_islessgreater", ftype, BUILT_IN_ISLESSGREATER,
|
|
|
1001 "__builtin_islessgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1002 gfc_define_builtin ("__builtin_isgreater", ftype, BUILT_IN_ISGREATER,
|
|
|
1003 "__builtin_isgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1004 gfc_define_builtin ("__builtin_isgreaterequal", ftype,
|
|
|
1005 BUILT_IN_ISGREATEREQUAL, "__builtin_isgreaterequal",
|
|
|
1006 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1007 gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
|
|
|
1008 "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1009
|
|
|
1010
|
|
|
1011 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
|
|
|
1012 builtin_types[(int) ENUM] = VALUE;
|
|
|
1013 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
|
|
|
1014 builtin_types[(int) ENUM] \
|
|
|
1015 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1016 NULL_TREE);
|
|
|
1017 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
|
|
|
1018 builtin_types[(int) ENUM] \
|
|
|
1019 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1020 builtin_types[(int) ARG1], \
|
|
|
1021 NULL_TREE);
|
|
|
1022 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
|
|
|
1023 builtin_types[(int) ENUM] \
|
|
|
1024 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1025 builtin_types[(int) ARG1], \
|
|
|
1026 builtin_types[(int) ARG2], \
|
|
|
1027 NULL_TREE);
|
|
|
1028 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
|
|
|
1029 builtin_types[(int) ENUM] \
|
|
|
1030 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1031 builtin_types[(int) ARG1], \
|
|
|
1032 builtin_types[(int) ARG2], \
|
|
|
1033 builtin_types[(int) ARG3], \
|
|
|
1034 NULL_TREE);
|
|
|
1035 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
|
|
|
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 builtin_types[(int) ARG3], \
|
|
|
1041 builtin_types[(int) ARG4], \
|
|
|
1042 NULL_TREE);
|
|
|
1043 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
|
|
|
1044 builtin_types[(int) ENUM] \
|
|
|
1045 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1046 builtin_types[(int) ARG1], \
|
|
|
1047 builtin_types[(int) ARG2], \
|
|
|
1048 builtin_types[(int) ARG3], \
|
|
|
1049 builtin_types[(int) ARG4], \
|
|
|
1050 builtin_types[(int) ARG5], \
|
|
|
1051 NULL_TREE);
|
|
|
1052 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1053 ARG6) \
|
|
|
1054 builtin_types[(int) ENUM] \
|
|
|
1055 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1056 builtin_types[(int) ARG1], \
|
|
|
1057 builtin_types[(int) ARG2], \
|
|
|
1058 builtin_types[(int) ARG3], \
|
|
|
1059 builtin_types[(int) ARG4], \
|
|
|
1060 builtin_types[(int) ARG5], \
|
|
|
1061 builtin_types[(int) ARG6], \
|
|
|
1062 NULL_TREE);
|
|
|
1063 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1064 ARG6, ARG7) \
|
|
|
1065 builtin_types[(int) ENUM] \
|
|
|
1066 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1067 builtin_types[(int) ARG1], \
|
|
|
1068 builtin_types[(int) ARG2], \
|
|
|
1069 builtin_types[(int) ARG3], \
|
|
|
1070 builtin_types[(int) ARG4], \
|
|
|
1071 builtin_types[(int) ARG5], \
|
|
|
1072 builtin_types[(int) ARG6], \
|
|
|
1073 builtin_types[(int) ARG7], \
|
|
|
1074 NULL_TREE);
|
|
|
1075 #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1076 ARG6, ARG7, ARG8) \
|
|
|
1077 builtin_types[(int) ENUM] \
|
|
|
1078 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1079 builtin_types[(int) ARG1], \
|
|
|
1080 builtin_types[(int) ARG2], \
|
|
|
1081 builtin_types[(int) ARG3], \
|
|
|
1082 builtin_types[(int) ARG4], \
|
|
|
1083 builtin_types[(int) ARG5], \
|
|
|
1084 builtin_types[(int) ARG6], \
|
|
|
1085 builtin_types[(int) ARG7], \
|
|
|
1086 builtin_types[(int) ARG8], \
|
|
|
1087 NULL_TREE);
|
|
|
1088 #define DEF_FUNCTION_TYPE_9(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1089 ARG6, ARG7, ARG8, ARG9) \
|
|
|
1090 builtin_types[(int) ENUM] \
|
|
|
1091 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1092 builtin_types[(int) ARG1], \
|
|
|
1093 builtin_types[(int) ARG2], \
|
|
|
1094 builtin_types[(int) ARG3], \
|
|
|
1095 builtin_types[(int) ARG4], \
|
|
|
1096 builtin_types[(int) ARG5], \
|
|
|
1097 builtin_types[(int) ARG6], \
|
|
|
1098 builtin_types[(int) ARG7], \
|
|
|
1099 builtin_types[(int) ARG8], \
|
|
|
1100 builtin_types[(int) ARG9], \
|
|
|
1101 NULL_TREE);
|
|
|
1102 #define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
|
|
|
1103 ARG5, ARG6, ARG7, ARG8, ARG9, ARG10) \
|
|
|
1104 builtin_types[(int) ENUM] \
|
|
|
1105 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1106 builtin_types[(int) ARG1], \
|
|
|
1107 builtin_types[(int) ARG2], \
|
|
|
1108 builtin_types[(int) ARG3], \
|
|
|
1109 builtin_types[(int) ARG4], \
|
|
|
1110 builtin_types[(int) ARG5], \
|
|
|
1111 builtin_types[(int) ARG6], \
|
|
|
1112 builtin_types[(int) ARG7], \
|
|
|
1113 builtin_types[(int) ARG8], \
|
|
|
1114 builtin_types[(int) ARG9], \
|
|
|
1115 builtin_types[(int) ARG10], \
|
|
|
1116 NULL_TREE);
|
|
|
1117 #define DEF_FUNCTION_TYPE_11(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
|
|
|
1118 ARG5, ARG6, ARG7, ARG8, ARG9, ARG10, ARG11)\
|
|
|
1119 builtin_types[(int) ENUM] \
|
|
|
1120 = build_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1121 builtin_types[(int) ARG1], \
|
|
|
1122 builtin_types[(int) ARG2], \
|
|
|
1123 builtin_types[(int) ARG3], \
|
|
|
1124 builtin_types[(int) ARG4], \
|
|
|
1125 builtin_types[(int) ARG5], \
|
|
|
1126 builtin_types[(int) ARG6], \
|
|
|
1127 builtin_types[(int) ARG7], \
|
|
|
1128 builtin_types[(int) ARG8], \
|
|
|
1129 builtin_types[(int) ARG9], \
|
|
|
1130 builtin_types[(int) ARG10], \
|
|
|
1131 builtin_types[(int) ARG11], \
|
|
|
1132 NULL_TREE);
|
|
|
1133 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
|
|
|
1134 builtin_types[(int) ENUM] \
|
|
|
1135 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1136 NULL_TREE);
|
|
|
1137 #define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1) \
|
|
|
1138 builtin_types[(int) ENUM] \
|
|
|
1139 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1140 builtin_types[(int) ARG1], \
|
|
|
1141 NULL_TREE);
|
|
|
1142 #define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2) \
|
|
|
1143 builtin_types[(int) ENUM] \
|
|
|
1144 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1145 builtin_types[(int) ARG1], \
|
|
|
1146 builtin_types[(int) ARG2], \
|
|
|
1147 NULL_TREE);
|
|
|
1148 #define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1149 ARG6) \
|
|
|
1150 builtin_types[(int) ENUM] \
|
|
|
1151 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1152 builtin_types[(int) ARG1], \
|
|
|
1153 builtin_types[(int) ARG2], \
|
|
|
1154 builtin_types[(int) ARG3], \
|
|
|
1155 builtin_types[(int) ARG4], \
|
|
|
1156 builtin_types[(int) ARG5], \
|
|
|
1157 builtin_types[(int) ARG6], \
|
|
|
1158 NULL_TREE);
|
|
|
1159 #define DEF_FUNCTION_TYPE_VAR_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
|
|
|
1160 ARG6, ARG7) \
|
|
|
1161 builtin_types[(int) ENUM] \
|
|
|
1162 = build_varargs_function_type_list (builtin_types[(int) RETURN], \
|
|
|
1163 builtin_types[(int) ARG1], \
|
|
|
1164 builtin_types[(int) ARG2], \
|
|
|
1165 builtin_types[(int) ARG3], \
|
|
|
1166 builtin_types[(int) ARG4], \
|
|
|
1167 builtin_types[(int) ARG5], \
|
|
|
1168 builtin_types[(int) ARG6], \
|
|
|
1169 builtin_types[(int) ARG7], \
|
|
|
1170 NULL_TREE);
|
|
|
1171 #define DEF_POINTER_TYPE(ENUM, TYPE) \
|
|
|
1172 builtin_types[(int) ENUM] \
|
|
|
1173 = build_pointer_type (builtin_types[(int) TYPE]);
|
|
|
1174 #include "types.def"
|
|
|
1175 #undef DEF_PRIMITIVE_TYPE
|
|
|
1176 #undef DEF_FUNCTION_TYPE_0
|
|
|
1177 #undef DEF_FUNCTION_TYPE_1
|
|
|
1178 #undef DEF_FUNCTION_TYPE_2
|
|
|
1179 #undef DEF_FUNCTION_TYPE_3
|
|
|
1180 #undef DEF_FUNCTION_TYPE_4
|
|
|
1181 #undef DEF_FUNCTION_TYPE_5
|
|
|
1182 #undef DEF_FUNCTION_TYPE_6
|
|
|
1183 #undef DEF_FUNCTION_TYPE_7
|
|
|
1184 #undef DEF_FUNCTION_TYPE_8
|
|
|
1185 #undef DEF_FUNCTION_TYPE_10
|
|
|
1186 #undef DEF_FUNCTION_TYPE_VAR_0
|
|
|
1187 #undef DEF_FUNCTION_TYPE_VAR_1
|
|
|
1188 #undef DEF_FUNCTION_TYPE_VAR_2
|
|
|
1189 #undef DEF_FUNCTION_TYPE_VAR_6
|
|
|
1190 #undef DEF_FUNCTION_TYPE_VAR_7
|
|
|
1191 #undef DEF_POINTER_TYPE
|
|
|
1192 builtin_types[(int) BT_LAST] = NULL_TREE;
|
|
|
1193
|
|
|
1194 /* Initialize synchronization builtins. */
|
|
|
1195 #undef DEF_SYNC_BUILTIN
|
|
|
1196 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
|
|
|
1197 gfc_define_builtin (name, builtin_types[type], code, name, \
|
|
|
1198 attr);
|
|
|
1199 #include "../sync-builtins.def"
|
|
|
1200 #undef DEF_SYNC_BUILTIN
|
|
|
1201
|
|
|
1202 if (flag_openacc)
|
|
|
1203 {
|
|
|
1204 #undef DEF_GOACC_BUILTIN
|
|
|
1205 #define DEF_GOACC_BUILTIN(code, name, type, attr) \
|
|
|
1206 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
|
|
|
1207 code, name, attr);
|
|
|
1208 #undef DEF_GOACC_BUILTIN_COMPILER
|
|
|
1209 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
|
|
|
1210 gfc_define_builtin (name, builtin_types[type], code, name, attr);
|
|
131
|
1211 #undef DEF_GOACC_BUILTIN_ONLY
|
|
|
1212 #define DEF_GOACC_BUILTIN_ONLY(code, name, type, attr) \
|
|
|
1213 gfc_define_builtin ("__builtin_" name, builtin_types[type], code, NULL, \
|
|
|
1214 attr);
|
|
111
|
1215 #undef DEF_GOMP_BUILTIN
|
|
|
1216 #define DEF_GOMP_BUILTIN(code, name, type, attr) /* ignore */
|
|
|
1217 #include "../omp-builtins.def"
|
|
|
1218 #undef DEF_GOACC_BUILTIN
|
|
|
1219 #undef DEF_GOACC_BUILTIN_COMPILER
|
|
|
1220 #undef DEF_GOMP_BUILTIN
|
|
|
1221 }
|
|
|
1222
|
|
|
1223 if (flag_openmp || flag_openmp_simd || flag_tree_parallelize_loops)
|
|
|
1224 {
|
|
|
1225 #undef DEF_GOACC_BUILTIN
|
|
|
1226 #define DEF_GOACC_BUILTIN(code, name, type, attr) /* ignore */
|
|
|
1227 #undef DEF_GOACC_BUILTIN_COMPILER
|
|
|
1228 #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) /* ignore */
|
|
|
1229 #undef DEF_GOMP_BUILTIN
|
|
|
1230 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
|
|
|
1231 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
|
|
|
1232 code, name, attr);
|
|
|
1233 #include "../omp-builtins.def"
|
|
|
1234 #undef DEF_GOACC_BUILTIN
|
|
|
1235 #undef DEF_GOACC_BUILTIN_COMPILER
|
|
|
1236 #undef DEF_GOMP_BUILTIN
|
|
|
1237 }
|
|
|
1238
|
|
|
1239 #ifdef ENABLE_HSA
|
|
|
1240 if (!flag_disable_hsa)
|
|
|
1241 {
|
|
|
1242 #undef DEF_HSA_BUILTIN
|
|
|
1243 #define DEF_HSA_BUILTIN(code, name, type, attr) \
|
|
|
1244 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
|
|
|
1245 code, name, attr);
|
|
|
1246 #include "../hsa-builtins.def"
|
|
|
1247 }
|
|
|
1248 #endif
|
|
|
1249
|
|
|
1250 gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
|
|
|
1251 BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
|
|
|
1252 TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
|
|
|
1253
|
|
|
1254 ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
|
|
|
1255 size_type_node, NULL_TREE);
|
|
|
1256 gfc_define_builtin ("__builtin_assume_aligned", ftype,
|
|
|
1257 BUILT_IN_ASSUME_ALIGNED,
|
|
|
1258 "__builtin_assume_aligned",
|
|
|
1259 ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1260
|
|
|
1261 gfc_define_builtin ("__emutls_get_address",
|
|
|
1262 builtin_types[BT_FN_PTR_PTR],
|
|
|
1263 BUILT_IN_EMUTLS_GET_ADDRESS,
|
|
|
1264 "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
|
|
|
1265 gfc_define_builtin ("__emutls_register_common",
|
|
|
1266 builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
|
|
|
1267 BUILT_IN_EMUTLS_REGISTER_COMMON,
|
|
|
1268 "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
|
|
|
1269
|
|
|
1270 build_common_builtin_nodes ();
|
|
|
1271 targetm.init_builtins ();
|
|
|
1272 }
|
|
|
1273
|
|
|
1274 #undef DEFINE_MATH_BUILTIN_C
|
|
|
1275 #undef DEFINE_MATH_BUILTIN
|
|
|
1276
|
|
|
1277 static void
|
|
|
1278 gfc_init_ts (void)
|
|
|
1279 {
|
|
|
1280 tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
|
|
|
1281 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
|
|
|
1282 tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
|
|
|
1283 tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
|
|
|
1284 tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
|
|
|
1285 }
|
|
|
1286
|
|
|
1287 void
|
|
|
1288 gfc_maybe_initialize_eh (void)
|
|
|
1289 {
|
|
|
1290 if (!flag_exceptions || gfc_eh_initialized_p)
|
|
|
1291 return;
|
|
|
1292
|
|
|
1293 gfc_eh_initialized_p = true;
|
|
|
1294 using_eh_for_cleanups ();
|
|
|
1295 }
|
|
|
1296
|
|
|
1297
|
|
|
1298 #include "gt-fortran-f95-lang.h"
|
|
|
1299 #include "gtype-fortran.h"
|
