1627f7eb2Smrg /* gfortran backend interface
24c3eb207Smrg Copyright (C) 2000-2020 Free Software Foundation, Inc.
3627f7eb2Smrg Contributed by Paul Brook.
4627f7eb2Smrg
5627f7eb2Smrg This file is part of GCC.
6627f7eb2Smrg
7627f7eb2Smrg GCC is free software; you can redistribute it and/or modify it under
8627f7eb2Smrg the terms of the GNU General Public License as published by the Free
9627f7eb2Smrg Software Foundation; either version 3, or (at your option) any later
10627f7eb2Smrg version.
11627f7eb2Smrg
12627f7eb2Smrg GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13627f7eb2Smrg WARRANTY; without even the implied warranty of MERCHANTABILITY or
14627f7eb2Smrg FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15627f7eb2Smrg for more details.
16627f7eb2Smrg
17627f7eb2Smrg You should have received a copy of the GNU General Public License
18627f7eb2Smrg along with GCC; see the file COPYING3. If not see
19627f7eb2Smrg <http://www.gnu.org/licenses/>. */
20627f7eb2Smrg
21627f7eb2Smrg /* f95-lang.c-- GCC backend interface stuff */
22627f7eb2Smrg
23627f7eb2Smrg /* declare required prototypes: */
24627f7eb2Smrg
25627f7eb2Smrg #include "config.h"
26627f7eb2Smrg #include "system.h"
27627f7eb2Smrg #include "coretypes.h"
28627f7eb2Smrg #include "target.h"
29627f7eb2Smrg #include "function.h"
30627f7eb2Smrg #include "tree.h"
31627f7eb2Smrg #include "gfortran.h"
32627f7eb2Smrg #include "trans.h"
33627f7eb2Smrg #include "stringpool.h"
34627f7eb2Smrg #include "diagnostic.h" /* For errorcount/warningcount */
35627f7eb2Smrg #include "langhooks.h"
36627f7eb2Smrg #include "langhooks-def.h"
37627f7eb2Smrg #include "toplev.h"
38627f7eb2Smrg #include "debug.h"
39627f7eb2Smrg #include "cpp.h"
40627f7eb2Smrg #include "trans-types.h"
41627f7eb2Smrg #include "trans-const.h"
42627f7eb2Smrg
43627f7eb2Smrg /* Language-dependent contents of an identifier. */
44627f7eb2Smrg
45627f7eb2Smrg struct GTY(())
46627f7eb2Smrg lang_identifier {
47627f7eb2Smrg struct tree_identifier common;
48627f7eb2Smrg };
49627f7eb2Smrg
50627f7eb2Smrg /* The resulting tree type. */
51627f7eb2Smrg
52627f7eb2Smrg union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
53627f7eb2Smrg chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
54627f7eb2Smrg lang_tree_node {
55627f7eb2Smrg union tree_node GTY((tag ("0"),
56627f7eb2Smrg desc ("tree_node_structure (&%h)"))) generic;
57627f7eb2Smrg struct lang_identifier GTY((tag ("1"))) identifier;
58627f7eb2Smrg };
59627f7eb2Smrg
60627f7eb2Smrg /* Save and restore the variables in this file and elsewhere
61627f7eb2Smrg that keep track of the progress of compilation of the current function.
62627f7eb2Smrg Used for nested functions. */
63627f7eb2Smrg
64627f7eb2Smrg struct GTY(())
65627f7eb2Smrg language_function {
66627f7eb2Smrg /* struct gfc_language_function base; */
67627f7eb2Smrg struct binding_level *binding_level;
68627f7eb2Smrg };
69627f7eb2Smrg
70627f7eb2Smrg static void gfc_init_decl_processing (void);
71627f7eb2Smrg static void gfc_init_builtin_functions (void);
72627f7eb2Smrg static bool global_bindings_p (void);
73627f7eb2Smrg
74627f7eb2Smrg /* Each front end provides its own. */
75627f7eb2Smrg static bool gfc_init (void);
76627f7eb2Smrg static void gfc_finish (void);
77627f7eb2Smrg static void gfc_be_parse_file (void);
78627f7eb2Smrg static void gfc_init_ts (void);
79627f7eb2Smrg static tree gfc_builtin_function (tree);
80627f7eb2Smrg
81627f7eb2Smrg /* Handle an "omp declare target" attribute; arguments as in
82627f7eb2Smrg struct attribute_spec.handler. */
83627f7eb2Smrg static tree
gfc_handle_omp_declare_target_attribute(tree *,tree,tree,int,bool *)84627f7eb2Smrg gfc_handle_omp_declare_target_attribute (tree *, tree, tree, int, bool *)
85627f7eb2Smrg {
86627f7eb2Smrg return NULL_TREE;
87627f7eb2Smrg }
88627f7eb2Smrg
89627f7eb2Smrg /* Table of valid Fortran attributes. */
90627f7eb2Smrg static const struct attribute_spec gfc_attribute_table[] =
91627f7eb2Smrg {
92627f7eb2Smrg /* { name, min_len, max_len, decl_req, type_req, fn_type_req,
93627f7eb2Smrg affects_type_identity, handler, exclude } */
944c3eb207Smrg { "omp declare target", 0, -1, true, false, false, false,
95627f7eb2Smrg gfc_handle_omp_declare_target_attribute, NULL },
96627f7eb2Smrg { "omp declare target link", 0, 0, true, false, false, false,
97627f7eb2Smrg gfc_handle_omp_declare_target_attribute, NULL },
98627f7eb2Smrg { "oacc function", 0, -1, true, false, false, false,
99627f7eb2Smrg gfc_handle_omp_declare_target_attribute, NULL },
100627f7eb2Smrg { NULL, 0, 0, false, false, false, false, NULL, NULL }
101627f7eb2Smrg };
102627f7eb2Smrg
103627f7eb2Smrg #undef LANG_HOOKS_NAME
104627f7eb2Smrg #undef LANG_HOOKS_INIT
105627f7eb2Smrg #undef LANG_HOOKS_FINISH
106627f7eb2Smrg #undef LANG_HOOKS_OPTION_LANG_MASK
107627f7eb2Smrg #undef LANG_HOOKS_INIT_OPTIONS_STRUCT
108627f7eb2Smrg #undef LANG_HOOKS_INIT_OPTIONS
109627f7eb2Smrg #undef LANG_HOOKS_HANDLE_OPTION
110627f7eb2Smrg #undef LANG_HOOKS_POST_OPTIONS
111627f7eb2Smrg #undef LANG_HOOKS_PARSE_FILE
112627f7eb2Smrg #undef LANG_HOOKS_MARK_ADDRESSABLE
113627f7eb2Smrg #undef LANG_HOOKS_TYPE_FOR_MODE
114627f7eb2Smrg #undef LANG_HOOKS_TYPE_FOR_SIZE
115627f7eb2Smrg #undef LANG_HOOKS_INIT_TS
1164c3eb207Smrg #undef LANG_HOOKS_OMP_ARRAY_DATA
1174c3eb207Smrg #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
1184c3eb207Smrg #undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
119627f7eb2Smrg #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
120627f7eb2Smrg #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
121627f7eb2Smrg #undef LANG_HOOKS_OMP_REPORT_DECL
122627f7eb2Smrg #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
123627f7eb2Smrg #undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
124627f7eb2Smrg #undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
125627f7eb2Smrg #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
126627f7eb2Smrg #undef LANG_HOOKS_OMP_CLAUSE_DTOR
127627f7eb2Smrg #undef LANG_HOOKS_OMP_FINISH_CLAUSE
128627f7eb2Smrg #undef LANG_HOOKS_OMP_SCALAR_P
129627f7eb2Smrg #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
130627f7eb2Smrg #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
131627f7eb2Smrg #undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
132627f7eb2Smrg #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
133627f7eb2Smrg #undef LANG_HOOKS_BUILTIN_FUNCTION
134627f7eb2Smrg #undef LANG_HOOKS_BUILTIN_FUNCTION
135627f7eb2Smrg #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
136627f7eb2Smrg #undef LANG_HOOKS_ATTRIBUTE_TABLE
137627f7eb2Smrg
138627f7eb2Smrg /* Define lang hooks. */
139627f7eb2Smrg #define LANG_HOOKS_NAME "GNU Fortran"
140627f7eb2Smrg #define LANG_HOOKS_INIT gfc_init
141627f7eb2Smrg #define LANG_HOOKS_FINISH gfc_finish
142627f7eb2Smrg #define LANG_HOOKS_OPTION_LANG_MASK gfc_option_lang_mask
143627f7eb2Smrg #define LANG_HOOKS_INIT_OPTIONS_STRUCT gfc_init_options_struct
144627f7eb2Smrg #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
145627f7eb2Smrg #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
146627f7eb2Smrg #define LANG_HOOKS_POST_OPTIONS gfc_post_options
147627f7eb2Smrg #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
148627f7eb2Smrg #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
149627f7eb2Smrg #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
150627f7eb2Smrg #define LANG_HOOKS_INIT_TS gfc_init_ts
1514c3eb207Smrg #define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data
1524c3eb207Smrg #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr
1534c3eb207Smrg #define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument
154627f7eb2Smrg #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
155627f7eb2Smrg #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
156627f7eb2Smrg #define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl
157627f7eb2Smrg #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
158627f7eb2Smrg #define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR gfc_omp_clause_copy_ctor
159627f7eb2Smrg #define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP gfc_omp_clause_assign_op
160627f7eb2Smrg #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
161627f7eb2Smrg #define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
162627f7eb2Smrg #define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
163627f7eb2Smrg #define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p
164627f7eb2Smrg #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
165627f7eb2Smrg #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
166627f7eb2Smrg #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref
167627f7eb2Smrg #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
168627f7eb2Smrg gfc_omp_firstprivatize_type_sizes
169627f7eb2Smrg #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
170627f7eb2Smrg #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
171627f7eb2Smrg #define LANG_HOOKS_ATTRIBUTE_TABLE gfc_attribute_table
172627f7eb2Smrg
173627f7eb2Smrg struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
174627f7eb2Smrg
175627f7eb2Smrg #define NULL_BINDING_LEVEL (struct binding_level *) NULL
176627f7eb2Smrg
177627f7eb2Smrg /* A chain of binding_level structures awaiting reuse. */
178627f7eb2Smrg
179627f7eb2Smrg static GTY(()) struct binding_level *free_binding_level;
180627f7eb2Smrg
181627f7eb2Smrg /* True means we've initialized exception handling. */
182627f7eb2Smrg static bool gfc_eh_initialized_p;
183627f7eb2Smrg
184627f7eb2Smrg /* The current translation unit. */
185627f7eb2Smrg static GTY(()) tree current_translation_unit;
186627f7eb2Smrg
187627f7eb2Smrg
188627f7eb2Smrg static void
gfc_create_decls(void)189627f7eb2Smrg gfc_create_decls (void)
190627f7eb2Smrg {
191627f7eb2Smrg /* GCC builtins. */
192627f7eb2Smrg gfc_init_builtin_functions ();
193627f7eb2Smrg
194627f7eb2Smrg /* Runtime/IO library functions. */
195627f7eb2Smrg gfc_build_builtin_function_decls ();
196627f7eb2Smrg
197627f7eb2Smrg gfc_init_constants ();
198627f7eb2Smrg
199627f7eb2Smrg /* Build our translation-unit decl. */
200627f7eb2Smrg current_translation_unit
201627f7eb2Smrg = build_translation_unit_decl (get_identifier (main_input_filename));
202627f7eb2Smrg debug_hooks->register_main_translation_unit (current_translation_unit);
203627f7eb2Smrg }
204627f7eb2Smrg
205627f7eb2Smrg
206627f7eb2Smrg static void
gfc_be_parse_file(void)207627f7eb2Smrg gfc_be_parse_file (void)
208627f7eb2Smrg {
209627f7eb2Smrg gfc_create_decls ();
210627f7eb2Smrg gfc_parse_file ();
211627f7eb2Smrg gfc_generate_constructors ();
212627f7eb2Smrg
213627f7eb2Smrg /* Clear the binding level stack. */
214627f7eb2Smrg while (!global_bindings_p ())
215627f7eb2Smrg poplevel (0, 0);
216627f7eb2Smrg
217627f7eb2Smrg /* Finalize all of the globals.
218627f7eb2Smrg
219627f7eb2Smrg Emulated tls lowering needs to see all TLS variables before we
220627f7eb2Smrg call finalize_compilation_unit. The C/C++ front ends manage this
221627f7eb2Smrg by calling decl_rest_of_compilation on each global and static
222627f7eb2Smrg variable as they are seen. The Fortran front end waits until
223627f7eb2Smrg here. */
224627f7eb2Smrg for (tree decl = getdecls (); decl ; decl = DECL_CHAIN (decl))
225627f7eb2Smrg rest_of_decl_compilation (decl, true, true);
226627f7eb2Smrg
227627f7eb2Smrg /* Switch to the default tree diagnostics here, because there may be
228627f7eb2Smrg diagnostics before gfc_finish(). */
229627f7eb2Smrg gfc_diagnostics_finish ();
230627f7eb2Smrg
231627f7eb2Smrg global_decl_processing ();
232627f7eb2Smrg }
233627f7eb2Smrg
234627f7eb2Smrg
235627f7eb2Smrg /* Initialize everything. */
236627f7eb2Smrg
237627f7eb2Smrg static bool
gfc_init(void)238627f7eb2Smrg gfc_init (void)
239627f7eb2Smrg {
240627f7eb2Smrg if (!gfc_cpp_enabled ())
241627f7eb2Smrg {
242627f7eb2Smrg linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
243627f7eb2Smrg linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
244627f7eb2Smrg }
245627f7eb2Smrg else
246627f7eb2Smrg gfc_cpp_init_0 ();
247627f7eb2Smrg
248627f7eb2Smrg gfc_init_decl_processing ();
249627f7eb2Smrg gfc_static_ctors = NULL_TREE;
250627f7eb2Smrg
251627f7eb2Smrg if (gfc_cpp_enabled ())
252627f7eb2Smrg gfc_cpp_init ();
253627f7eb2Smrg
254627f7eb2Smrg gfc_init_1 ();
255627f7eb2Smrg
256627f7eb2Smrg if (!gfc_new_file ())
257627f7eb2Smrg fatal_error (input_location, "cannot open input file: %s", gfc_source_file);
258627f7eb2Smrg
259627f7eb2Smrg if (flag_preprocess_only)
260627f7eb2Smrg return false;
261627f7eb2Smrg
262627f7eb2Smrg return true;
263627f7eb2Smrg }
264627f7eb2Smrg
265627f7eb2Smrg
266627f7eb2Smrg static void
gfc_finish(void)267627f7eb2Smrg gfc_finish (void)
268627f7eb2Smrg {
269627f7eb2Smrg gfc_cpp_done ();
270627f7eb2Smrg gfc_done_1 ();
271627f7eb2Smrg gfc_release_include_path ();
272627f7eb2Smrg return;
273627f7eb2Smrg }
274627f7eb2Smrg
275627f7eb2Smrg /* These functions and variables deal with binding contours. We only
276627f7eb2Smrg need these functions for the list of PARM_DECLs, but we leave the
277627f7eb2Smrg functions more general; these are a simplified version of the
278627f7eb2Smrg functions from GNAT. */
279627f7eb2Smrg
280627f7eb2Smrg /* For each binding contour we allocate a binding_level structure which
281627f7eb2Smrg records the entities defined or declared in that contour. Contours
282627f7eb2Smrg include:
283627f7eb2Smrg
284627f7eb2Smrg the global one
285627f7eb2Smrg one for each subprogram definition
286627f7eb2Smrg one for each compound statement (declare block)
287627f7eb2Smrg
288627f7eb2Smrg Binding contours are used to create GCC tree BLOCK nodes. */
289627f7eb2Smrg
290627f7eb2Smrg struct GTY(())
291627f7eb2Smrg binding_level {
292627f7eb2Smrg /* A chain of ..._DECL nodes for all variables, constants, functions,
293627f7eb2Smrg parameters and type declarations. These ..._DECL nodes are chained
294627f7eb2Smrg through the DECL_CHAIN field. */
295627f7eb2Smrg tree names;
296627f7eb2Smrg /* For each level (except the global one), a chain of BLOCK nodes for all
297627f7eb2Smrg the levels that were entered and exited one level down from this one. */
298627f7eb2Smrg tree blocks;
299627f7eb2Smrg /* The binding level containing this one (the enclosing binding level). */
300627f7eb2Smrg struct binding_level *level_chain;
301627f7eb2Smrg /* True if nreverse has been already called on names; if false, names
302627f7eb2Smrg are ordered from newest declaration to oldest one. */
303627f7eb2Smrg bool reversed;
304627f7eb2Smrg };
305627f7eb2Smrg
306627f7eb2Smrg /* The binding level currently in effect. */
307627f7eb2Smrg static GTY(()) struct binding_level *current_binding_level = NULL;
308627f7eb2Smrg
309627f7eb2Smrg /* The outermost binding level. This binding level is created when the
310627f7eb2Smrg compiler is started and it will exist through the entire compilation. */
311627f7eb2Smrg static GTY(()) struct binding_level *global_binding_level;
312627f7eb2Smrg
313627f7eb2Smrg /* Binding level structures are initialized by copying this one. */
314627f7eb2Smrg static struct binding_level clear_binding_level = { NULL, NULL, NULL, false };
315627f7eb2Smrg
316627f7eb2Smrg
317627f7eb2Smrg /* Return true if we are in the global binding level. */
318627f7eb2Smrg
319627f7eb2Smrg bool
global_bindings_p(void)320627f7eb2Smrg global_bindings_p (void)
321627f7eb2Smrg {
322627f7eb2Smrg return current_binding_level == global_binding_level;
323627f7eb2Smrg }
324627f7eb2Smrg
325627f7eb2Smrg tree
getdecls(void)326627f7eb2Smrg getdecls (void)
327627f7eb2Smrg {
328627f7eb2Smrg if (!current_binding_level->reversed)
329627f7eb2Smrg {
330627f7eb2Smrg current_binding_level->reversed = true;
331627f7eb2Smrg current_binding_level->names = nreverse (current_binding_level->names);
332627f7eb2Smrg }
333627f7eb2Smrg return current_binding_level->names;
334627f7eb2Smrg }
335627f7eb2Smrg
336627f7eb2Smrg /* Enter a new binding level. */
337627f7eb2Smrg
338627f7eb2Smrg void
pushlevel(void)339627f7eb2Smrg pushlevel (void)
340627f7eb2Smrg {
341627f7eb2Smrg struct binding_level *newlevel = ggc_alloc<binding_level> ();
342627f7eb2Smrg
343627f7eb2Smrg *newlevel = clear_binding_level;
344627f7eb2Smrg
345627f7eb2Smrg /* Add this level to the front of the chain (stack) of levels that are
346627f7eb2Smrg active. */
347627f7eb2Smrg newlevel->level_chain = current_binding_level;
348627f7eb2Smrg current_binding_level = newlevel;
349627f7eb2Smrg }
350627f7eb2Smrg
351627f7eb2Smrg /* Exit a binding level.
352627f7eb2Smrg Pop the level off, and restore the state of the identifier-decl mappings
353627f7eb2Smrg that were in effect when this level was entered.
354627f7eb2Smrg
355627f7eb2Smrg If KEEP is nonzero, this level had explicit declarations, so
356627f7eb2Smrg and create a "block" (a BLOCK node) for the level
357627f7eb2Smrg to record its declarations and subblocks for symbol table output.
358627f7eb2Smrg
359627f7eb2Smrg If FUNCTIONBODY is nonzero, this level is the body of a function,
360627f7eb2Smrg so create a block as if KEEP were set and also clear out all
361627f7eb2Smrg label names. */
362627f7eb2Smrg
363627f7eb2Smrg tree
poplevel(int keep,int functionbody)364627f7eb2Smrg poplevel (int keep, int functionbody)
365627f7eb2Smrg {
366627f7eb2Smrg /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
367627f7eb2Smrg binding level that we are about to exit and which is returned by this
368627f7eb2Smrg routine. */
369627f7eb2Smrg tree block_node = NULL_TREE;
370627f7eb2Smrg tree decl_chain = getdecls ();
371627f7eb2Smrg tree subblock_chain = current_binding_level->blocks;
372627f7eb2Smrg tree subblock_node;
373627f7eb2Smrg
374627f7eb2Smrg /* If there were any declarations in the current binding level, or if this
375627f7eb2Smrg binding level is a function body, or if there are any nested blocks then
376627f7eb2Smrg create a BLOCK node to record them for the life of this function. */
377627f7eb2Smrg if (keep || functionbody)
378627f7eb2Smrg block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
379627f7eb2Smrg
380627f7eb2Smrg /* Record the BLOCK node just built as the subblock its enclosing scope. */
381627f7eb2Smrg for (subblock_node = subblock_chain; subblock_node;
382627f7eb2Smrg subblock_node = BLOCK_CHAIN (subblock_node))
383627f7eb2Smrg BLOCK_SUPERCONTEXT (subblock_node) = block_node;
384627f7eb2Smrg
385627f7eb2Smrg /* Clear out the meanings of the local variables of this level. */
386627f7eb2Smrg
387627f7eb2Smrg for (subblock_node = decl_chain; subblock_node;
388627f7eb2Smrg subblock_node = DECL_CHAIN (subblock_node))
389627f7eb2Smrg if (DECL_NAME (subblock_node) != 0)
390627f7eb2Smrg /* If the identifier was used or addressed via a local extern decl,
391627f7eb2Smrg don't forget that fact. */
392627f7eb2Smrg if (DECL_EXTERNAL (subblock_node))
393627f7eb2Smrg {
394627f7eb2Smrg if (TREE_USED (subblock_node))
395627f7eb2Smrg TREE_USED (DECL_NAME (subblock_node)) = 1;
396627f7eb2Smrg if (TREE_ADDRESSABLE (subblock_node))
397627f7eb2Smrg TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
398627f7eb2Smrg }
399627f7eb2Smrg
400627f7eb2Smrg /* Pop the current level. */
401627f7eb2Smrg current_binding_level = current_binding_level->level_chain;
402627f7eb2Smrg
403627f7eb2Smrg if (functionbody)
404627f7eb2Smrg /* This is the top level block of a function. */
405627f7eb2Smrg DECL_INITIAL (current_function_decl) = block_node;
406627f7eb2Smrg else if (current_binding_level == global_binding_level)
407627f7eb2Smrg /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
408627f7eb2Smrg don't add newly created BLOCKs as subblocks of global_binding_level. */
409627f7eb2Smrg ;
410627f7eb2Smrg else if (block_node)
411627f7eb2Smrg {
412627f7eb2Smrg current_binding_level->blocks
413627f7eb2Smrg = block_chainon (current_binding_level->blocks, block_node);
414627f7eb2Smrg }
415627f7eb2Smrg
416627f7eb2Smrg /* If we did not make a block for the level just exited, any blocks made for
417627f7eb2Smrg inner levels (since they cannot be recorded as subblocks in that level)
418627f7eb2Smrg must be carried forward so they will later become subblocks of something
419627f7eb2Smrg else. */
420627f7eb2Smrg else if (subblock_chain)
421627f7eb2Smrg current_binding_level->blocks
422627f7eb2Smrg = block_chainon (current_binding_level->blocks, subblock_chain);
423627f7eb2Smrg if (block_node)
424627f7eb2Smrg TREE_USED (block_node) = 1;
425627f7eb2Smrg
426627f7eb2Smrg return block_node;
427627f7eb2Smrg }
428627f7eb2Smrg
429627f7eb2Smrg
430627f7eb2Smrg /* Records a ..._DECL node DECL as belonging to the current lexical scope.
431627f7eb2Smrg Returns the ..._DECL node. */
432627f7eb2Smrg
433627f7eb2Smrg tree
pushdecl(tree decl)434627f7eb2Smrg pushdecl (tree decl)
435627f7eb2Smrg {
436627f7eb2Smrg if (global_bindings_p ())
437627f7eb2Smrg DECL_CONTEXT (decl) = current_translation_unit;
438627f7eb2Smrg else
439627f7eb2Smrg {
440627f7eb2Smrg /* External objects aren't nested. For debug info insert a copy
441627f7eb2Smrg of the decl into the binding level. */
442627f7eb2Smrg if (DECL_EXTERNAL (decl))
443627f7eb2Smrg {
444627f7eb2Smrg tree orig = decl;
445627f7eb2Smrg decl = copy_node (decl);
446627f7eb2Smrg DECL_CONTEXT (orig) = NULL_TREE;
447627f7eb2Smrg }
448627f7eb2Smrg DECL_CONTEXT (decl) = current_function_decl;
449627f7eb2Smrg }
450627f7eb2Smrg
451627f7eb2Smrg /* Put the declaration on the list. */
452627f7eb2Smrg DECL_CHAIN (decl) = current_binding_level->names;
453627f7eb2Smrg current_binding_level->names = decl;
454627f7eb2Smrg
455627f7eb2Smrg /* For the declaration of a type, set its name if it is not already set. */
456627f7eb2Smrg
457627f7eb2Smrg if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
458627f7eb2Smrg {
459627f7eb2Smrg if (DECL_SOURCE_LINE (decl) == 0)
460627f7eb2Smrg TYPE_NAME (TREE_TYPE (decl)) = decl;
461627f7eb2Smrg else
462627f7eb2Smrg TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
463627f7eb2Smrg }
464627f7eb2Smrg
465627f7eb2Smrg return decl;
466627f7eb2Smrg }
467627f7eb2Smrg
468627f7eb2Smrg
469627f7eb2Smrg /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
470627f7eb2Smrg
471627f7eb2Smrg tree
pushdecl_top_level(tree x)472627f7eb2Smrg pushdecl_top_level (tree x)
473627f7eb2Smrg {
474627f7eb2Smrg tree t;
475627f7eb2Smrg struct binding_level *b = current_binding_level;
476627f7eb2Smrg
477627f7eb2Smrg current_binding_level = global_binding_level;
478627f7eb2Smrg t = pushdecl (x);
479627f7eb2Smrg current_binding_level = b;
480627f7eb2Smrg return t;
481627f7eb2Smrg }
482627f7eb2Smrg
483627f7eb2Smrg #ifndef CHAR_TYPE_SIZE
484627f7eb2Smrg #define CHAR_TYPE_SIZE BITS_PER_UNIT
485627f7eb2Smrg #endif
486627f7eb2Smrg
487627f7eb2Smrg #ifndef INT_TYPE_SIZE
488627f7eb2Smrg #define INT_TYPE_SIZE BITS_PER_WORD
489627f7eb2Smrg #endif
490627f7eb2Smrg
491627f7eb2Smrg #undef SIZE_TYPE
492627f7eb2Smrg #define SIZE_TYPE "long unsigned int"
493627f7eb2Smrg
494627f7eb2Smrg /* Create tree nodes for the basic scalar types of Fortran 95,
495627f7eb2Smrg and some nodes representing standard constants (0, 1, (void *) 0).
496627f7eb2Smrg Initialize the global binding level.
497627f7eb2Smrg Make definitions for built-in primitive functions. */
498627f7eb2Smrg static void
gfc_init_decl_processing(void)499627f7eb2Smrg gfc_init_decl_processing (void)
500627f7eb2Smrg {
501627f7eb2Smrg current_function_decl = NULL;
502627f7eb2Smrg current_binding_level = NULL_BINDING_LEVEL;
503627f7eb2Smrg free_binding_level = NULL_BINDING_LEVEL;
504627f7eb2Smrg
505627f7eb2Smrg /* Make the binding_level structure for global names. We move all
506627f7eb2Smrg variables that are in a COMMON block to this binding level. */
507627f7eb2Smrg pushlevel ();
508627f7eb2Smrg global_binding_level = current_binding_level;
509627f7eb2Smrg
510627f7eb2Smrg /* Build common tree nodes. char_type_node is unsigned because we
511627f7eb2Smrg only use it for actual characters, not for INTEGER(1). */
512627f7eb2Smrg build_common_tree_nodes (false);
513627f7eb2Smrg
514627f7eb2Smrg void_list_node = build_tree_list (NULL_TREE, void_type_node);
515627f7eb2Smrg
516627f7eb2Smrg /* Set up F95 type nodes. */
517627f7eb2Smrg gfc_init_kinds ();
518627f7eb2Smrg gfc_init_types ();
519627f7eb2Smrg gfc_init_c_interop_kinds ();
520627f7eb2Smrg }
521627f7eb2Smrg
522627f7eb2Smrg
523627f7eb2Smrg /* Builtin function initialization. */
524627f7eb2Smrg
525627f7eb2Smrg static tree
gfc_builtin_function(tree decl)526627f7eb2Smrg gfc_builtin_function (tree decl)
527627f7eb2Smrg {
528627f7eb2Smrg pushdecl (decl);
529627f7eb2Smrg return decl;
530627f7eb2Smrg }
531627f7eb2Smrg
532627f7eb2Smrg /* So far we need just these 7 attribute types. */
533627f7eb2Smrg #define ATTR_NULL 0
534627f7eb2Smrg #define ATTR_LEAF_LIST (ECF_LEAF)
535627f7eb2Smrg #define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
536627f7eb2Smrg #define ATTR_NOTHROW_LEAF_MALLOC_LIST (ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
537627f7eb2Smrg #define ATTR_CONST_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_CONST)
538627f7eb2Smrg #define ATTR_PURE_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF | ECF_PURE)
539627f7eb2Smrg #define ATTR_NOTHROW_LIST (ECF_NOTHROW)
540627f7eb2Smrg #define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
541627f7eb2Smrg
542627f7eb2Smrg static void
gfc_define_builtin(const char * name,tree type,enum built_in_function code,const char * library_name,int attr)543627f7eb2Smrg gfc_define_builtin (const char *name, tree type, enum built_in_function code,
544627f7eb2Smrg const char *library_name, int attr)
545627f7eb2Smrg {
546627f7eb2Smrg tree decl;
547627f7eb2Smrg
548627f7eb2Smrg decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
549627f7eb2Smrg library_name, NULL_TREE);
550627f7eb2Smrg set_call_expr_flags (decl, attr);
551627f7eb2Smrg
552627f7eb2Smrg set_builtin_decl (code, decl, true);
553627f7eb2Smrg }
554627f7eb2Smrg
555627f7eb2Smrg
556627f7eb2Smrg #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
557627f7eb2Smrg gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
558627f7eb2Smrg BUILT_IN_ ## code ## L, name "l", \
559627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST); \
560627f7eb2Smrg gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
561627f7eb2Smrg BUILT_IN_ ## code, name, \
562627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST); \
563627f7eb2Smrg gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
564627f7eb2Smrg BUILT_IN_ ## code ## F, name "f", \
565627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
566627f7eb2Smrg
567627f7eb2Smrg #define DEFINE_MATH_BUILTIN(code, name, argtype) \
568627f7eb2Smrg DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
569627f7eb2Smrg
570627f7eb2Smrg #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
571627f7eb2Smrg DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
572627f7eb2Smrg DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
573627f7eb2Smrg
574627f7eb2Smrg
575627f7eb2Smrg /* Create function types for builtin functions. */
576627f7eb2Smrg
577627f7eb2Smrg static void
build_builtin_fntypes(tree * fntype,tree type)578627f7eb2Smrg build_builtin_fntypes (tree *fntype, tree type)
579627f7eb2Smrg {
580627f7eb2Smrg /* type (*) (type) */
581627f7eb2Smrg fntype[0] = build_function_type_list (type, type, NULL_TREE);
582627f7eb2Smrg /* type (*) (type, type) */
583627f7eb2Smrg fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
584627f7eb2Smrg /* type (*) (type, int) */
585627f7eb2Smrg fntype[2] = build_function_type_list (type,
586627f7eb2Smrg type, integer_type_node, NULL_TREE);
587627f7eb2Smrg /* type (*) (void) */
588627f7eb2Smrg fntype[3] = build_function_type_list (type, NULL_TREE);
589627f7eb2Smrg /* type (*) (type, &int) */
590627f7eb2Smrg fntype[4] = build_function_type_list (type, type,
591627f7eb2Smrg build_pointer_type (integer_type_node),
592627f7eb2Smrg NULL_TREE);
593627f7eb2Smrg /* type (*) (int, type) */
594627f7eb2Smrg fntype[5] = build_function_type_list (type,
595627f7eb2Smrg integer_type_node, type, NULL_TREE);
596627f7eb2Smrg }
597627f7eb2Smrg
598627f7eb2Smrg
599627f7eb2Smrg static tree
builtin_type_for_size(int size,bool unsignedp)600627f7eb2Smrg builtin_type_for_size (int size, bool unsignedp)
601627f7eb2Smrg {
602627f7eb2Smrg tree type = gfc_type_for_size (size, unsignedp);
603627f7eb2Smrg return type ? type : error_mark_node;
604627f7eb2Smrg }
605627f7eb2Smrg
606627f7eb2Smrg /* Initialization of builtin function nodes. */
607627f7eb2Smrg
608627f7eb2Smrg static void
gfc_init_builtin_functions(void)609627f7eb2Smrg gfc_init_builtin_functions (void)
610627f7eb2Smrg {
611627f7eb2Smrg enum builtin_type
612627f7eb2Smrg {
613627f7eb2Smrg #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
614627f7eb2Smrg #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
615627f7eb2Smrg #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
616627f7eb2Smrg #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
617627f7eb2Smrg #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
618627f7eb2Smrg #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
619627f7eb2Smrg #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
620627f7eb2Smrg #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
621627f7eb2Smrg ARG6) NAME,
622627f7eb2Smrg #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
623627f7eb2Smrg ARG6, ARG7) NAME,
624627f7eb2Smrg #define DEF_FUNCTION_TYPE_8(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
625627f7eb2Smrg ARG6, ARG7, ARG8) NAME,
626627f7eb2Smrg #define DEF_FUNCTION_TYPE_9(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
627627f7eb2Smrg ARG6, ARG7, ARG8, ARG9) NAME,
628627f7eb2Smrg #define DEF_FUNCTION_TYPE_10(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
629627f7eb2Smrg ARG6, ARG7, ARG8, ARG9, ARG10) NAME,
630627f7eb2Smrg #define DEF_FUNCTION_TYPE_11(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
631627f7eb2Smrg ARG6, ARG7, ARG8, ARG9, ARG10, ARG11) NAME,
632627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
633627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
634627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
635627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
636627f7eb2Smrg ARG6) NAME,
637627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
638627f7eb2Smrg ARG6, ARG7) NAME,
639627f7eb2Smrg #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
640627f7eb2Smrg #include "types.def"
641627f7eb2Smrg #undef DEF_PRIMITIVE_TYPE
642627f7eb2Smrg #undef DEF_FUNCTION_TYPE_0
643627f7eb2Smrg #undef DEF_FUNCTION_TYPE_1
644627f7eb2Smrg #undef DEF_FUNCTION_TYPE_2
645627f7eb2Smrg #undef DEF_FUNCTION_TYPE_3
646627f7eb2Smrg #undef DEF_FUNCTION_TYPE_4
647627f7eb2Smrg #undef DEF_FUNCTION_TYPE_5
648627f7eb2Smrg #undef DEF_FUNCTION_TYPE_6
649627f7eb2Smrg #undef DEF_FUNCTION_TYPE_7
650627f7eb2Smrg #undef DEF_FUNCTION_TYPE_8
651627f7eb2Smrg #undef DEF_FUNCTION_TYPE_9
652627f7eb2Smrg #undef DEF_FUNCTION_TYPE_10
653627f7eb2Smrg #undef DEF_FUNCTION_TYPE_11
654627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_0
655627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_1
656627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_2
657627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_6
658627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_7
659627f7eb2Smrg #undef DEF_POINTER_TYPE
660627f7eb2Smrg BT_LAST
661627f7eb2Smrg };
662627f7eb2Smrg
663627f7eb2Smrg tree mfunc_float[6];
664627f7eb2Smrg tree mfunc_double[6];
665627f7eb2Smrg tree mfunc_longdouble[6];
666627f7eb2Smrg tree mfunc_cfloat[6];
667627f7eb2Smrg tree mfunc_cdouble[6];
668627f7eb2Smrg tree mfunc_clongdouble[6];
669627f7eb2Smrg tree func_cfloat_float, func_float_cfloat;
670627f7eb2Smrg tree func_cdouble_double, func_double_cdouble;
671627f7eb2Smrg tree func_clongdouble_longdouble, func_longdouble_clongdouble;
672627f7eb2Smrg tree func_float_floatp_floatp;
673627f7eb2Smrg tree func_double_doublep_doublep;
674627f7eb2Smrg tree func_longdouble_longdoublep_longdoublep;
675627f7eb2Smrg tree ftype, ptype;
676627f7eb2Smrg tree builtin_types[(int) BT_LAST + 1];
677627f7eb2Smrg
678627f7eb2Smrg int attr;
679627f7eb2Smrg
680627f7eb2Smrg build_builtin_fntypes (mfunc_float, float_type_node);
681627f7eb2Smrg build_builtin_fntypes (mfunc_double, double_type_node);
682627f7eb2Smrg build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
683627f7eb2Smrg build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
684627f7eb2Smrg build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
685627f7eb2Smrg build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
686627f7eb2Smrg
687627f7eb2Smrg func_cfloat_float = build_function_type_list (float_type_node,
688627f7eb2Smrg complex_float_type_node,
689627f7eb2Smrg NULL_TREE);
690627f7eb2Smrg
691627f7eb2Smrg func_float_cfloat = build_function_type_list (complex_float_type_node,
692627f7eb2Smrg float_type_node, NULL_TREE);
693627f7eb2Smrg
694627f7eb2Smrg func_cdouble_double = build_function_type_list (double_type_node,
695627f7eb2Smrg complex_double_type_node,
696627f7eb2Smrg NULL_TREE);
697627f7eb2Smrg
698627f7eb2Smrg func_double_cdouble = build_function_type_list (complex_double_type_node,
699627f7eb2Smrg double_type_node, NULL_TREE);
700627f7eb2Smrg
701*4ac76180Smrg func_clongdouble_longdouble
702*4ac76180Smrg = build_function_type_list (long_double_type_node,
703627f7eb2Smrg complex_long_double_type_node, NULL_TREE);
704627f7eb2Smrg
705*4ac76180Smrg func_longdouble_clongdouble
706*4ac76180Smrg = build_function_type_list (complex_long_double_type_node,
707627f7eb2Smrg long_double_type_node, NULL_TREE);
708627f7eb2Smrg
709627f7eb2Smrg ptype = build_pointer_type (float_type_node);
710*4ac76180Smrg func_float_floatp_floatp
711*4ac76180Smrg = build_function_type_list (void_type_node, float_type_node, ptype, ptype,
712*4ac76180Smrg NULL_TREE);
713627f7eb2Smrg
714627f7eb2Smrg ptype = build_pointer_type (double_type_node);
715*4ac76180Smrg func_double_doublep_doublep
716*4ac76180Smrg = build_function_type_list (void_type_node, double_type_node, ptype,
717*4ac76180Smrg ptype, NULL_TREE);
718627f7eb2Smrg
719627f7eb2Smrg ptype = build_pointer_type (long_double_type_node);
720*4ac76180Smrg func_longdouble_longdoublep_longdoublep
721*4ac76180Smrg = build_function_type_list (void_type_node, long_double_type_node, ptype,
722*4ac76180Smrg ptype, NULL_TREE);
723627f7eb2Smrg
724627f7eb2Smrg /* Non-math builtins are defined manually, so they're not included here. */
725627f7eb2Smrg #define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
726627f7eb2Smrg
727627f7eb2Smrg #include "mathbuiltins.def"
728627f7eb2Smrg
729627f7eb2Smrg gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
730627f7eb2Smrg BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
731627f7eb2Smrg gfc_define_builtin ("__builtin_round", mfunc_double[0],
732627f7eb2Smrg BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
733627f7eb2Smrg gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
734627f7eb2Smrg BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
735627f7eb2Smrg
736627f7eb2Smrg gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
737627f7eb2Smrg BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
738627f7eb2Smrg gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
739627f7eb2Smrg BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
740627f7eb2Smrg gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
741627f7eb2Smrg BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
742627f7eb2Smrg
743627f7eb2Smrg gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
744627f7eb2Smrg BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
745627f7eb2Smrg gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
746627f7eb2Smrg BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
747627f7eb2Smrg gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
748627f7eb2Smrg BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
749627f7eb2Smrg
750627f7eb2Smrg gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
751627f7eb2Smrg BUILT_IN_COPYSIGNL, "copysignl",
752627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
753627f7eb2Smrg gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
754627f7eb2Smrg BUILT_IN_COPYSIGN, "copysign",
755627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
756627f7eb2Smrg gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
757627f7eb2Smrg BUILT_IN_COPYSIGNF, "copysignf",
758627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
759627f7eb2Smrg
760627f7eb2Smrg gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
761627f7eb2Smrg BUILT_IN_NEXTAFTERL, "nextafterl",
762627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
763627f7eb2Smrg gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
764627f7eb2Smrg BUILT_IN_NEXTAFTER, "nextafter",
765627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
766627f7eb2Smrg gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1],
767627f7eb2Smrg BUILT_IN_NEXTAFTERF, "nextafterf",
768627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
769627f7eb2Smrg
770627f7eb2Smrg /* Some built-ins depend on rounding mode. Depending on compilation options, they
771627f7eb2Smrg will be "pure" or "const". */
772627f7eb2Smrg attr = flag_rounding_math ? ATTR_PURE_NOTHROW_LEAF_LIST : ATTR_CONST_NOTHROW_LEAF_LIST;
773627f7eb2Smrg
774627f7eb2Smrg gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0],
775627f7eb2Smrg BUILT_IN_RINTL, "rintl", attr);
776627f7eb2Smrg gfc_define_builtin ("__builtin_rint", mfunc_double[0],
777627f7eb2Smrg BUILT_IN_RINT, "rint", attr);
778627f7eb2Smrg gfc_define_builtin ("__builtin_rintf", mfunc_float[0],
779627f7eb2Smrg BUILT_IN_RINTF, "rintf", attr);
780627f7eb2Smrg
781627f7eb2Smrg gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1],
782627f7eb2Smrg BUILT_IN_REMAINDERL, "remainderl", attr);
783627f7eb2Smrg gfc_define_builtin ("__builtin_remainder", mfunc_double[1],
784627f7eb2Smrg BUILT_IN_REMAINDER, "remainder", attr);
785627f7eb2Smrg gfc_define_builtin ("__builtin_remainderf", mfunc_float[1],
786627f7eb2Smrg BUILT_IN_REMAINDERF, "remainderf", attr);
787627f7eb2Smrg
788627f7eb2Smrg gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0],
789627f7eb2Smrg BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
790627f7eb2Smrg gfc_define_builtin ("__builtin_logb", mfunc_double[0],
791627f7eb2Smrg BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
792627f7eb2Smrg gfc_define_builtin ("__builtin_logbf", mfunc_float[0],
793627f7eb2Smrg BUILT_IN_LOGBF, "logbf", ATTR_CONST_NOTHROW_LEAF_LIST);
794627f7eb2Smrg
795627f7eb2Smrg
796627f7eb2Smrg gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
797627f7eb2Smrg BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
798627f7eb2Smrg gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
799627f7eb2Smrg BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
800627f7eb2Smrg gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
801627f7eb2Smrg BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
802627f7eb2Smrg
803627f7eb2Smrg gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
804627f7eb2Smrg BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
805627f7eb2Smrg gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
806627f7eb2Smrg BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
807627f7eb2Smrg gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
808627f7eb2Smrg BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
809627f7eb2Smrg
810627f7eb2Smrg gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[2],
811627f7eb2Smrg BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
812627f7eb2Smrg gfc_define_builtin ("__builtin_scalbn", mfunc_double[2],
813627f7eb2Smrg BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
814627f7eb2Smrg gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2],
815627f7eb2Smrg BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
816627f7eb2Smrg
817627f7eb2Smrg gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
818627f7eb2Smrg BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
819627f7eb2Smrg gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
820627f7eb2Smrg BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
821627f7eb2Smrg gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
822627f7eb2Smrg BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
823627f7eb2Smrg
824627f7eb2Smrg /* iround{f,,l}, lround{f,,l} and llround{f,,l} */
825627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
826627f7eb2Smrg float_type_node, NULL_TREE);
827627f7eb2Smrg gfc_define_builtin("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
828627f7eb2Smrg "iroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
829627f7eb2Smrg ftype = build_function_type_list (long_integer_type_node,
830627f7eb2Smrg float_type_node, NULL_TREE);
831627f7eb2Smrg gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
832627f7eb2Smrg "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
833627f7eb2Smrg ftype = build_function_type_list (long_long_integer_type_node,
834627f7eb2Smrg float_type_node, NULL_TREE);
835627f7eb2Smrg gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
836627f7eb2Smrg "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
837627f7eb2Smrg
838627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
839627f7eb2Smrg double_type_node, NULL_TREE);
840627f7eb2Smrg gfc_define_builtin("__builtin_iround", ftype, BUILT_IN_IROUND,
841627f7eb2Smrg "iround", ATTR_CONST_NOTHROW_LEAF_LIST);
842627f7eb2Smrg ftype = build_function_type_list (long_integer_type_node,
843627f7eb2Smrg double_type_node, NULL_TREE);
844627f7eb2Smrg gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
845627f7eb2Smrg "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
846627f7eb2Smrg ftype = build_function_type_list (long_long_integer_type_node,
847627f7eb2Smrg double_type_node, NULL_TREE);
848627f7eb2Smrg gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
849627f7eb2Smrg "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
850627f7eb2Smrg
851627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
852627f7eb2Smrg long_double_type_node, NULL_TREE);
853627f7eb2Smrg gfc_define_builtin("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
854627f7eb2Smrg "iroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
855627f7eb2Smrg ftype = build_function_type_list (long_integer_type_node,
856627f7eb2Smrg long_double_type_node, NULL_TREE);
857627f7eb2Smrg gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
858627f7eb2Smrg "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
859627f7eb2Smrg ftype = build_function_type_list (long_long_integer_type_node,
860627f7eb2Smrg long_double_type_node, NULL_TREE);
861627f7eb2Smrg gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
862627f7eb2Smrg "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
863627f7eb2Smrg
864627f7eb2Smrg /* These are used to implement the ** operator. */
865627f7eb2Smrg gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
866627f7eb2Smrg BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
867627f7eb2Smrg gfc_define_builtin ("__builtin_pow", mfunc_double[1],
868627f7eb2Smrg BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
869627f7eb2Smrg gfc_define_builtin ("__builtin_powf", mfunc_float[1],
870627f7eb2Smrg BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
871627f7eb2Smrg gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
872627f7eb2Smrg BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
873627f7eb2Smrg gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
874627f7eb2Smrg BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
875627f7eb2Smrg gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
876627f7eb2Smrg BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
877627f7eb2Smrg gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
878627f7eb2Smrg BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
879627f7eb2Smrg gfc_define_builtin ("__builtin_powi", mfunc_double[2],
880627f7eb2Smrg BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
881627f7eb2Smrg gfc_define_builtin ("__builtin_powif", mfunc_float[2],
882627f7eb2Smrg BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
883627f7eb2Smrg
884627f7eb2Smrg
885627f7eb2Smrg if (targetm.libc_has_function (function_c99_math_complex))
886627f7eb2Smrg {
887627f7eb2Smrg gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
888627f7eb2Smrg BUILT_IN_CBRTL, "cbrtl",
889627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
890627f7eb2Smrg gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
891627f7eb2Smrg BUILT_IN_CBRT, "cbrt",
892627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
893627f7eb2Smrg gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
894627f7eb2Smrg BUILT_IN_CBRTF, "cbrtf",
895627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
896627f7eb2Smrg gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
897627f7eb2Smrg BUILT_IN_CEXPIL, "cexpil",
898627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
899627f7eb2Smrg gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
900627f7eb2Smrg BUILT_IN_CEXPI, "cexpi",
901627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
902627f7eb2Smrg gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
903627f7eb2Smrg BUILT_IN_CEXPIF, "cexpif",
904627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
905627f7eb2Smrg }
906627f7eb2Smrg
907627f7eb2Smrg if (targetm.libc_has_function (function_sincos))
908627f7eb2Smrg {
909627f7eb2Smrg gfc_define_builtin ("__builtin_sincosl",
910627f7eb2Smrg func_longdouble_longdoublep_longdoublep,
911627f7eb2Smrg BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
912627f7eb2Smrg gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
913627f7eb2Smrg BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
914627f7eb2Smrg gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
915627f7eb2Smrg BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
916627f7eb2Smrg }
917627f7eb2Smrg
918627f7eb2Smrg /* For LEADZ, TRAILZ, POPCNT and POPPAR. */
919627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
920627f7eb2Smrg unsigned_type_node, NULL_TREE);
921627f7eb2Smrg gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
922627f7eb2Smrg "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
923627f7eb2Smrg gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
924627f7eb2Smrg "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
925627f7eb2Smrg gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
926627f7eb2Smrg "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
927627f7eb2Smrg gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
928627f7eb2Smrg "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
929627f7eb2Smrg
930627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
931627f7eb2Smrg long_unsigned_type_node, NULL_TREE);
932627f7eb2Smrg gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
933627f7eb2Smrg "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
934627f7eb2Smrg gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
935627f7eb2Smrg "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
936627f7eb2Smrg gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
937627f7eb2Smrg "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
938627f7eb2Smrg gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
939627f7eb2Smrg "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
940627f7eb2Smrg
941627f7eb2Smrg ftype = build_function_type_list (integer_type_node,
942627f7eb2Smrg long_long_unsigned_type_node, NULL_TREE);
943627f7eb2Smrg gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
944627f7eb2Smrg "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
945627f7eb2Smrg gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
946627f7eb2Smrg "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
947627f7eb2Smrg gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
948627f7eb2Smrg "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
949627f7eb2Smrg gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
950627f7eb2Smrg "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
951627f7eb2Smrg
952627f7eb2Smrg /* Other builtin functions we use. */
953627f7eb2Smrg
954627f7eb2Smrg ftype = build_function_type_list (long_integer_type_node,
955627f7eb2Smrg long_integer_type_node,
956627f7eb2Smrg long_integer_type_node, NULL_TREE);
957627f7eb2Smrg gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
958627f7eb2Smrg "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
959627f7eb2Smrg
960627f7eb2Smrg ftype = build_function_type_list (void_type_node,
961627f7eb2Smrg pvoid_type_node, NULL_TREE);
962627f7eb2Smrg gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
963627f7eb2Smrg "free", ATTR_NOTHROW_LEAF_LIST);
964627f7eb2Smrg
965627f7eb2Smrg ftype = build_function_type_list (pvoid_type_node,
966627f7eb2Smrg size_type_node, NULL_TREE);
967627f7eb2Smrg gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
968627f7eb2Smrg "malloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
969627f7eb2Smrg
970627f7eb2Smrg ftype = build_function_type_list (pvoid_type_node, size_type_node,
971627f7eb2Smrg size_type_node, NULL_TREE);
972627f7eb2Smrg gfc_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
973627f7eb2Smrg "calloc", ATTR_NOTHROW_LEAF_MALLOC_LIST);
974627f7eb2Smrg DECL_IS_MALLOC (builtin_decl_explicit (BUILT_IN_CALLOC)) = 1;
975627f7eb2Smrg
976*4ac76180Smrg ftype = build_function_type_list (pvoid_type_node, pvoid_type_node,
977*4ac76180Smrg size_type_node, NULL_TREE);
978627f7eb2Smrg gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
979627f7eb2Smrg "realloc", ATTR_NOTHROW_LEAF_LIST);
980627f7eb2Smrg
981627f7eb2Smrg /* Type-generic floating-point classification built-ins. */
982627f7eb2Smrg
983627f7eb2Smrg ftype = build_function_type (integer_type_node, NULL_TREE);
984627f7eb2Smrg gfc_define_builtin ("__builtin_isfinite", ftype, BUILT_IN_ISFINITE,
985627f7eb2Smrg "__builtin_isfinite", ATTR_CONST_NOTHROW_LEAF_LIST);
986627f7eb2Smrg gfc_define_builtin ("__builtin_isinf", ftype, BUILT_IN_ISINF,
987627f7eb2Smrg "__builtin_isinf", ATTR_CONST_NOTHROW_LEAF_LIST);
988627f7eb2Smrg gfc_define_builtin ("__builtin_isinf_sign", ftype, BUILT_IN_ISINF_SIGN,
989627f7eb2Smrg "__builtin_isinf_sign", ATTR_CONST_NOTHROW_LEAF_LIST);
990627f7eb2Smrg gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
991627f7eb2Smrg "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
992627f7eb2Smrg gfc_define_builtin ("__builtin_isnormal", ftype, BUILT_IN_ISNORMAL,
993627f7eb2Smrg "__builtin_isnormal", ATTR_CONST_NOTHROW_LEAF_LIST);
994627f7eb2Smrg gfc_define_builtin ("__builtin_signbit", ftype, BUILT_IN_SIGNBIT,
995627f7eb2Smrg "__builtin_signbit", ATTR_CONST_NOTHROW_LEAF_LIST);
996627f7eb2Smrg
997627f7eb2Smrg ftype = build_function_type (integer_type_node, NULL_TREE);
998627f7eb2Smrg gfc_define_builtin ("__builtin_isless", ftype, BUILT_IN_ISLESS,
999627f7eb2Smrg "__builtin_isless", ATTR_CONST_NOTHROW_LEAF_LIST);
1000627f7eb2Smrg gfc_define_builtin ("__builtin_islessequal", ftype, BUILT_IN_ISLESSEQUAL,
1001627f7eb2Smrg "__builtin_islessequal", ATTR_CONST_NOTHROW_LEAF_LIST);
1002627f7eb2Smrg gfc_define_builtin ("__builtin_islessgreater", ftype, BUILT_IN_ISLESSGREATER,
1003627f7eb2Smrg "__builtin_islessgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1004627f7eb2Smrg gfc_define_builtin ("__builtin_isgreater", ftype, BUILT_IN_ISGREATER,
1005627f7eb2Smrg "__builtin_isgreater", ATTR_CONST_NOTHROW_LEAF_LIST);
1006627f7eb2Smrg gfc_define_builtin ("__builtin_isgreaterequal", ftype,
1007627f7eb2Smrg BUILT_IN_ISGREATEREQUAL, "__builtin_isgreaterequal",
1008627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
1009627f7eb2Smrg gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
1010627f7eb2Smrg "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
1011627f7eb2Smrg
1012627f7eb2Smrg
1013627f7eb2Smrg #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
1014627f7eb2Smrg builtin_types[(int) ENUM] = VALUE;
1015627f7eb2Smrg #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
1016627f7eb2Smrg builtin_types[(int) ENUM] \
1017627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1018627f7eb2Smrg NULL_TREE);
1019627f7eb2Smrg #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
1020627f7eb2Smrg builtin_types[(int) ENUM] \
1021627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1022627f7eb2Smrg builtin_types[(int) ARG1], \
1023627f7eb2Smrg NULL_TREE);
1024627f7eb2Smrg #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
1025627f7eb2Smrg builtin_types[(int) ENUM] \
1026627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1027627f7eb2Smrg builtin_types[(int) ARG1], \
1028627f7eb2Smrg builtin_types[(int) ARG2], \
1029627f7eb2Smrg NULL_TREE);
1030627f7eb2Smrg #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
1031627f7eb2Smrg builtin_types[(int) ENUM] \
1032627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1033627f7eb2Smrg builtin_types[(int) ARG1], \
1034627f7eb2Smrg builtin_types[(int) ARG2], \
1035627f7eb2Smrg builtin_types[(int) ARG3], \
1036627f7eb2Smrg NULL_TREE);
1037627f7eb2Smrg #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
1038627f7eb2Smrg builtin_types[(int) ENUM] \
1039627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1040627f7eb2Smrg builtin_types[(int) ARG1], \
1041627f7eb2Smrg builtin_types[(int) ARG2], \
1042627f7eb2Smrg builtin_types[(int) ARG3], \
1043627f7eb2Smrg builtin_types[(int) ARG4], \
1044627f7eb2Smrg NULL_TREE);
1045627f7eb2Smrg #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1046627f7eb2Smrg builtin_types[(int) ENUM] \
1047627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1048627f7eb2Smrg builtin_types[(int) ARG1], \
1049627f7eb2Smrg builtin_types[(int) ARG2], \
1050627f7eb2Smrg builtin_types[(int) ARG3], \
1051627f7eb2Smrg builtin_types[(int) ARG4], \
1052627f7eb2Smrg builtin_types[(int) ARG5], \
1053627f7eb2Smrg NULL_TREE);
1054627f7eb2Smrg #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1055627f7eb2Smrg ARG6) \
1056627f7eb2Smrg builtin_types[(int) ENUM] \
1057627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1058627f7eb2Smrg builtin_types[(int) ARG1], \
1059627f7eb2Smrg builtin_types[(int) ARG2], \
1060627f7eb2Smrg builtin_types[(int) ARG3], \
1061627f7eb2Smrg builtin_types[(int) ARG4], \
1062627f7eb2Smrg builtin_types[(int) ARG5], \
1063627f7eb2Smrg builtin_types[(int) ARG6], \
1064627f7eb2Smrg NULL_TREE);
1065627f7eb2Smrg #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1066627f7eb2Smrg ARG6, ARG7) \
1067627f7eb2Smrg builtin_types[(int) ENUM] \
1068627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1069627f7eb2Smrg builtin_types[(int) ARG1], \
1070627f7eb2Smrg builtin_types[(int) ARG2], \
1071627f7eb2Smrg builtin_types[(int) ARG3], \
1072627f7eb2Smrg builtin_types[(int) ARG4], \
1073627f7eb2Smrg builtin_types[(int) ARG5], \
1074627f7eb2Smrg builtin_types[(int) ARG6], \
1075627f7eb2Smrg builtin_types[(int) ARG7], \
1076627f7eb2Smrg NULL_TREE);
1077627f7eb2Smrg #define DEF_FUNCTION_TYPE_8(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1078627f7eb2Smrg ARG6, ARG7, ARG8) \
1079627f7eb2Smrg builtin_types[(int) ENUM] \
1080627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1081627f7eb2Smrg builtin_types[(int) ARG1], \
1082627f7eb2Smrg builtin_types[(int) ARG2], \
1083627f7eb2Smrg builtin_types[(int) ARG3], \
1084627f7eb2Smrg builtin_types[(int) ARG4], \
1085627f7eb2Smrg builtin_types[(int) ARG5], \
1086627f7eb2Smrg builtin_types[(int) ARG6], \
1087627f7eb2Smrg builtin_types[(int) ARG7], \
1088627f7eb2Smrg builtin_types[(int) ARG8], \
1089627f7eb2Smrg NULL_TREE);
1090627f7eb2Smrg #define DEF_FUNCTION_TYPE_9(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1091627f7eb2Smrg ARG6, ARG7, ARG8, ARG9) \
1092627f7eb2Smrg builtin_types[(int) ENUM] \
1093627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1094627f7eb2Smrg builtin_types[(int) ARG1], \
1095627f7eb2Smrg builtin_types[(int) ARG2], \
1096627f7eb2Smrg builtin_types[(int) ARG3], \
1097627f7eb2Smrg builtin_types[(int) ARG4], \
1098627f7eb2Smrg builtin_types[(int) ARG5], \
1099627f7eb2Smrg builtin_types[(int) ARG6], \
1100627f7eb2Smrg builtin_types[(int) ARG7], \
1101627f7eb2Smrg builtin_types[(int) ARG8], \
1102627f7eb2Smrg builtin_types[(int) ARG9], \
1103627f7eb2Smrg NULL_TREE);
1104627f7eb2Smrg #define DEF_FUNCTION_TYPE_10(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
1105627f7eb2Smrg ARG5, ARG6, ARG7, ARG8, ARG9, ARG10) \
1106627f7eb2Smrg builtin_types[(int) ENUM] \
1107627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1108627f7eb2Smrg builtin_types[(int) ARG1], \
1109627f7eb2Smrg builtin_types[(int) ARG2], \
1110627f7eb2Smrg builtin_types[(int) ARG3], \
1111627f7eb2Smrg builtin_types[(int) ARG4], \
1112627f7eb2Smrg builtin_types[(int) ARG5], \
1113627f7eb2Smrg builtin_types[(int) ARG6], \
1114627f7eb2Smrg builtin_types[(int) ARG7], \
1115627f7eb2Smrg builtin_types[(int) ARG8], \
1116627f7eb2Smrg builtin_types[(int) ARG9], \
1117627f7eb2Smrg builtin_types[(int) ARG10], \
1118627f7eb2Smrg NULL_TREE);
1119627f7eb2Smrg #define DEF_FUNCTION_TYPE_11(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, \
1120627f7eb2Smrg ARG5, ARG6, ARG7, ARG8, ARG9, ARG10, ARG11)\
1121627f7eb2Smrg builtin_types[(int) ENUM] \
1122627f7eb2Smrg = build_function_type_list (builtin_types[(int) RETURN], \
1123627f7eb2Smrg builtin_types[(int) ARG1], \
1124627f7eb2Smrg builtin_types[(int) ARG2], \
1125627f7eb2Smrg builtin_types[(int) ARG3], \
1126627f7eb2Smrg builtin_types[(int) ARG4], \
1127627f7eb2Smrg builtin_types[(int) ARG5], \
1128627f7eb2Smrg builtin_types[(int) ARG6], \
1129627f7eb2Smrg builtin_types[(int) ARG7], \
1130627f7eb2Smrg builtin_types[(int) ARG8], \
1131627f7eb2Smrg builtin_types[(int) ARG9], \
1132627f7eb2Smrg builtin_types[(int) ARG10], \
1133627f7eb2Smrg builtin_types[(int) ARG11], \
1134627f7eb2Smrg NULL_TREE);
1135627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1136627f7eb2Smrg builtin_types[(int) ENUM] \
1137627f7eb2Smrg = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1138627f7eb2Smrg NULL_TREE);
1139627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_1(ENUM, RETURN, ARG1) \
1140627f7eb2Smrg builtin_types[(int) ENUM] \
1141627f7eb2Smrg = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1142627f7eb2Smrg builtin_types[(int) ARG1], \
1143627f7eb2Smrg NULL_TREE);
1144627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_2(ENUM, RETURN, ARG1, ARG2) \
1145627f7eb2Smrg builtin_types[(int) ENUM] \
1146627f7eb2Smrg = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1147627f7eb2Smrg builtin_types[(int) ARG1], \
1148627f7eb2Smrg builtin_types[(int) ARG2], \
1149627f7eb2Smrg NULL_TREE);
1150627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1151627f7eb2Smrg ARG6) \
1152627f7eb2Smrg builtin_types[(int) ENUM] \
1153627f7eb2Smrg = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1154627f7eb2Smrg builtin_types[(int) ARG1], \
1155627f7eb2Smrg builtin_types[(int) ARG2], \
1156627f7eb2Smrg builtin_types[(int) ARG3], \
1157627f7eb2Smrg builtin_types[(int) ARG4], \
1158627f7eb2Smrg builtin_types[(int) ARG5], \
1159627f7eb2Smrg builtin_types[(int) ARG6], \
1160627f7eb2Smrg NULL_TREE);
1161627f7eb2Smrg #define DEF_FUNCTION_TYPE_VAR_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1162627f7eb2Smrg ARG6, ARG7) \
1163627f7eb2Smrg builtin_types[(int) ENUM] \
1164627f7eb2Smrg = build_varargs_function_type_list (builtin_types[(int) RETURN], \
1165627f7eb2Smrg builtin_types[(int) ARG1], \
1166627f7eb2Smrg builtin_types[(int) ARG2], \
1167627f7eb2Smrg builtin_types[(int) ARG3], \
1168627f7eb2Smrg builtin_types[(int) ARG4], \
1169627f7eb2Smrg builtin_types[(int) ARG5], \
1170627f7eb2Smrg builtin_types[(int) ARG6], \
1171627f7eb2Smrg builtin_types[(int) ARG7], \
1172627f7eb2Smrg NULL_TREE);
1173627f7eb2Smrg #define DEF_POINTER_TYPE(ENUM, TYPE) \
1174627f7eb2Smrg builtin_types[(int) ENUM] \
1175627f7eb2Smrg = build_pointer_type (builtin_types[(int) TYPE]);
1176627f7eb2Smrg #include "types.def"
1177627f7eb2Smrg #undef DEF_PRIMITIVE_TYPE
1178627f7eb2Smrg #undef DEF_FUNCTION_TYPE_0
1179627f7eb2Smrg #undef DEF_FUNCTION_TYPE_1
1180627f7eb2Smrg #undef DEF_FUNCTION_TYPE_2
1181627f7eb2Smrg #undef DEF_FUNCTION_TYPE_3
1182627f7eb2Smrg #undef DEF_FUNCTION_TYPE_4
1183627f7eb2Smrg #undef DEF_FUNCTION_TYPE_5
1184627f7eb2Smrg #undef DEF_FUNCTION_TYPE_6
1185627f7eb2Smrg #undef DEF_FUNCTION_TYPE_7
1186627f7eb2Smrg #undef DEF_FUNCTION_TYPE_8
1187627f7eb2Smrg #undef DEF_FUNCTION_TYPE_10
1188627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_0
1189627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_1
1190627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_2
1191627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_6
1192627f7eb2Smrg #undef DEF_FUNCTION_TYPE_VAR_7
1193627f7eb2Smrg #undef DEF_POINTER_TYPE
1194627f7eb2Smrg builtin_types[(int) BT_LAST] = NULL_TREE;
1195627f7eb2Smrg
1196627f7eb2Smrg /* Initialize synchronization builtins. */
1197627f7eb2Smrg #undef DEF_SYNC_BUILTIN
1198627f7eb2Smrg #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1199627f7eb2Smrg gfc_define_builtin (name, builtin_types[type], code, name, \
1200627f7eb2Smrg attr);
1201627f7eb2Smrg #include "../sync-builtins.def"
1202627f7eb2Smrg #undef DEF_SYNC_BUILTIN
1203627f7eb2Smrg
1204627f7eb2Smrg if (flag_openacc)
1205627f7eb2Smrg {
1206627f7eb2Smrg #undef DEF_GOACC_BUILTIN
1207627f7eb2Smrg #define DEF_GOACC_BUILTIN(code, name, type, attr) \
1208627f7eb2Smrg gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1209627f7eb2Smrg code, name, attr);
1210627f7eb2Smrg #undef DEF_GOACC_BUILTIN_COMPILER
1211627f7eb2Smrg #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) \
1212627f7eb2Smrg gfc_define_builtin (name, builtin_types[type], code, name, attr);
1213627f7eb2Smrg #undef DEF_GOACC_BUILTIN_ONLY
1214627f7eb2Smrg #define DEF_GOACC_BUILTIN_ONLY(code, name, type, attr) \
1215627f7eb2Smrg gfc_define_builtin ("__builtin_" name, builtin_types[type], code, NULL, \
1216627f7eb2Smrg attr);
1217627f7eb2Smrg #undef DEF_GOMP_BUILTIN
1218627f7eb2Smrg #define DEF_GOMP_BUILTIN(code, name, type, attr) /* ignore */
1219627f7eb2Smrg #include "../omp-builtins.def"
1220627f7eb2Smrg #undef DEF_GOACC_BUILTIN
1221627f7eb2Smrg #undef DEF_GOACC_BUILTIN_COMPILER
1222627f7eb2Smrg #undef DEF_GOMP_BUILTIN
1223627f7eb2Smrg }
1224627f7eb2Smrg
1225627f7eb2Smrg if (flag_openmp || flag_openmp_simd || flag_tree_parallelize_loops)
1226627f7eb2Smrg {
1227627f7eb2Smrg #undef DEF_GOACC_BUILTIN
1228627f7eb2Smrg #define DEF_GOACC_BUILTIN(code, name, type, attr) /* ignore */
1229627f7eb2Smrg #undef DEF_GOACC_BUILTIN_COMPILER
1230627f7eb2Smrg #define DEF_GOACC_BUILTIN_COMPILER(code, name, type, attr) /* ignore */
1231627f7eb2Smrg #undef DEF_GOMP_BUILTIN
1232627f7eb2Smrg #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1233627f7eb2Smrg gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1234627f7eb2Smrg code, name, attr);
1235627f7eb2Smrg #include "../omp-builtins.def"
1236627f7eb2Smrg #undef DEF_GOACC_BUILTIN
1237627f7eb2Smrg #undef DEF_GOACC_BUILTIN_COMPILER
1238627f7eb2Smrg #undef DEF_GOMP_BUILTIN
1239627f7eb2Smrg }
1240627f7eb2Smrg
1241627f7eb2Smrg #ifdef ENABLE_HSA
1242627f7eb2Smrg if (!flag_disable_hsa)
1243627f7eb2Smrg {
1244627f7eb2Smrg #undef DEF_HSA_BUILTIN
1245627f7eb2Smrg #define DEF_HSA_BUILTIN(code, name, type, attr) \
1246627f7eb2Smrg gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1247627f7eb2Smrg code, name, attr);
1248627f7eb2Smrg #include "../hsa-builtins.def"
1249627f7eb2Smrg }
1250627f7eb2Smrg #endif
1251627f7eb2Smrg
1252627f7eb2Smrg gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1253627f7eb2Smrg BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
1254627f7eb2Smrg TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
1255627f7eb2Smrg
1256627f7eb2Smrg ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
1257627f7eb2Smrg size_type_node, NULL_TREE);
1258627f7eb2Smrg gfc_define_builtin ("__builtin_assume_aligned", ftype,
1259627f7eb2Smrg BUILT_IN_ASSUME_ALIGNED,
1260627f7eb2Smrg "__builtin_assume_aligned",
1261627f7eb2Smrg ATTR_CONST_NOTHROW_LEAF_LIST);
1262627f7eb2Smrg
1263627f7eb2Smrg gfc_define_builtin ("__emutls_get_address",
1264627f7eb2Smrg builtin_types[BT_FN_PTR_PTR],
1265627f7eb2Smrg BUILT_IN_EMUTLS_GET_ADDRESS,
1266627f7eb2Smrg "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
1267627f7eb2Smrg gfc_define_builtin ("__emutls_register_common",
1268627f7eb2Smrg builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
1269627f7eb2Smrg BUILT_IN_EMUTLS_REGISTER_COMMON,
1270627f7eb2Smrg "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
1271627f7eb2Smrg
1272627f7eb2Smrg build_common_builtin_nodes ();
1273627f7eb2Smrg targetm.init_builtins ();
1274627f7eb2Smrg }
1275627f7eb2Smrg
1276627f7eb2Smrg #undef DEFINE_MATH_BUILTIN_C
1277627f7eb2Smrg #undef DEFINE_MATH_BUILTIN
1278627f7eb2Smrg
1279627f7eb2Smrg static void
gfc_init_ts(void)1280627f7eb2Smrg gfc_init_ts (void)
1281627f7eb2Smrg {
1282627f7eb2Smrg tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
1283627f7eb2Smrg tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
1284627f7eb2Smrg tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
1285627f7eb2Smrg tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
1286627f7eb2Smrg tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
1287627f7eb2Smrg }
1288627f7eb2Smrg
1289627f7eb2Smrg void
gfc_maybe_initialize_eh(void)1290627f7eb2Smrg gfc_maybe_initialize_eh (void)
1291627f7eb2Smrg {
1292627f7eb2Smrg if (!flag_exceptions || gfc_eh_initialized_p)
1293627f7eb2Smrg return;
1294627f7eb2Smrg
1295627f7eb2Smrg gfc_eh_initialized_p = true;
1296627f7eb2Smrg using_eh_for_cleanups ();
1297627f7eb2Smrg }
1298627f7eb2Smrg
1299627f7eb2Smrg
1300627f7eb2Smrg #include "gt-fortran-f95-lang.h"
1301627f7eb2Smrg #include "gtype-fortran.h"
1302