1 /* gfortran backend interface
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
3 Free Software Foundation, Inc.
4 Contributed by Paul Brook.
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING. If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
23 /* f95-lang.c-- GCC backend interface stuff */
25 /* declare required prototypes: */
31 #include "coretypes.h"
33 #include "tree-gimple.h"
35 #include "langhooks.h"
36 #include "langhooks-def.h"
44 #include "diagnostic.h"
45 #include "tree-dump.h"
50 #include "trans-types.h"
51 #include "trans-const.h"
53 /* Language-dependent contents of an identifier. */
55 struct lang_identifier
58 struct tree_identifier common;
61 /* The resulting tree type. */
64 GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
65 chain_next ("(GIMPLE_STMT_P (&%h.generic) ? (union lang_tree_node *) 0 : (union lang_tree_node *)TREE_CHAIN (&%h.generic))")))
68 union tree_node GTY((tag ("0"),
69 desc ("tree_node_structure (&%h)"))) generic;
70 struct lang_identifier GTY((tag ("1"))) identifier;
73 /* Save and restore the variables in this file and elsewhere
74 that keep track of the progress of compilation of the current function.
75 Used for nested functions. */
77 struct language_function
80 /* struct gfc_language_function base; */
81 struct binding_level *binding_level;
84 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
86 void yyerror (const char *str);
89 static void gfc_init_decl_processing (void);
90 static void gfc_init_builtin_functions (void);
92 /* Each front end provides its own. */
93 static bool gfc_init (void);
94 static void gfc_finish (void);
95 static void gfc_print_identifier (FILE *, tree, int);
96 static bool gfc_mark_addressable (tree);
97 void do_function_end (void);
98 int global_bindings_p (void);
99 void insert_block (tree);
100 static void gfc_clear_binding_stack (void);
101 static void gfc_be_parse_file (int);
102 static void gfc_expand_function (tree);
103 static HOST_WIDE_INT gfc_get_alias_set (tree);
105 #undef LANG_HOOKS_NAME
106 #undef LANG_HOOKS_INIT
107 #undef LANG_HOOKS_FINISH
108 #undef LANG_HOOKS_INIT_OPTIONS
109 #undef LANG_HOOKS_HANDLE_OPTION
110 #undef LANG_HOOKS_POST_OPTIONS
111 #undef LANG_HOOKS_PRINT_IDENTIFIER
112 #undef LANG_HOOKS_PARSE_FILE
113 #undef LANG_HOOKS_MARK_ADDRESSABLE
114 #undef LANG_HOOKS_TYPE_FOR_MODE
115 #undef LANG_HOOKS_TYPE_FOR_SIZE
116 #undef LANG_HOOKS_UNSIGNED_TYPE
117 #undef LANG_HOOKS_SIGNED_TYPE
118 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
119 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
120 #undef LANG_HOOKS_CLEAR_BINDING_STACK
121 #undef LANG_HOOKS_GET_ALIAS_SET
122 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
123 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
124 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
125 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
126 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
127 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
128 #undef LANG_HOOKS_BUILTIN_FUNCTION
130 /* Define lang hooks. */
131 #define LANG_HOOKS_NAME "GNU F95"
132 #define LANG_HOOKS_INIT gfc_init
133 #define LANG_HOOKS_FINISH gfc_finish
134 #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
135 #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
136 #define LANG_HOOKS_POST_OPTIONS gfc_post_options
137 #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
138 #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
139 #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
140 #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
141 #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
142 #define LANG_HOOKS_UNSIGNED_TYPE gfc_unsigned_type
143 #define LANG_HOOKS_SIGNED_TYPE gfc_signed_type
144 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
145 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
146 #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack
147 #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
148 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
149 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
150 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
151 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
152 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
153 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
154 gfc_omp_firstprivatize_type_sizes
155 #define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
157 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
159 /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
160 that have names. Here so we can clear out their names' definitions
161 at the end of the function. */
163 /* Tree code classes. */
165 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
167 const enum tree_code_class tree_code_type[] = {
172 /* Table indexed by tree code giving number of expression
173 operands beyond the fixed part of the node structure.
174 Not used for types or decls. */
176 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
178 const unsigned char tree_code_length[] = {
183 /* Names of tree components.
184 Used for printing out the tree and error messages. */
185 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
187 const char *const tree_code_name[] = {
193 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
195 /* A chain of binding_level structures awaiting reuse. */
197 static GTY(()) struct binding_level *free_binding_level;
199 /* The elements of `ridpointers' are identifier nodes
200 for the reserved type names and storage classes.
201 It is indexed by a RID_... value. */
202 tree *ridpointers = NULL;
204 /* language-specific flags. */
207 gfc_expand_function (tree fndecl)
211 if (DECL_INITIAL (fndecl)
212 && BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl)))
214 /* Local static equivalenced variables are never seen by
215 check_global_declarations, so we need to output debug
218 t = BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl));
219 for (t = BLOCK_VARS (t); t; t = TREE_CHAIN (t))
220 if (TREE_CODE (t) == VAR_DECL && DECL_HAS_VALUE_EXPR_P (t)
223 tree expr = DECL_VALUE_EXPR (t);
225 if (TREE_CODE (expr) == COMPONENT_REF
226 && TREE_CODE (TREE_OPERAND (expr, 0)) == VAR_DECL
227 && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0)))
229 && varpool_node (TREE_OPERAND (expr, 0))->needed
230 && errorcount == 0 && sorrycount == 0)
232 timevar_push (TV_SYMOUT);
233 (*debug_hooks->global_decl) (t);
234 timevar_pop (TV_SYMOUT);
239 tree_rest_of_compilation (fndecl);
243 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
244 or validate its data type for an `if' or `while' statement or ?..: exp.
246 This preparation consists of taking the ordinary
247 representation of an expression expr and producing a valid tree
248 boolean expression describing whether expr is nonzero. We could
249 simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
250 but we optimize comparisons, &&, ||, and !.
252 The resulting type should always be `boolean_type_node'.
253 This is much simpler than the corresponding C version because we have a
254 distinct boolean type. */
257 gfc_truthvalue_conversion (tree expr)
259 switch (TREE_CODE (TREE_TYPE (expr)))
262 if (TREE_TYPE (expr) == boolean_type_node)
264 else if (COMPARISON_CLASS_P (expr))
266 TREE_TYPE (expr) = boolean_type_node;
269 else if (TREE_CODE (expr) == NOP_EXPR)
270 return build1 (NOP_EXPR, boolean_type_node, TREE_OPERAND (expr, 0));
272 return build1 (NOP_EXPR, boolean_type_node, expr);
275 if (TREE_CODE (expr) == INTEGER_CST)
276 return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
278 return build2 (NE_EXPR, boolean_type_node, expr,
279 build_int_cst (TREE_TYPE (expr), 0));
282 internal_error ("Unexpected type in truthvalue_conversion");
288 gfc_create_decls (void)
291 gfc_init_builtin_functions ();
293 /* Runtime/IO library functions. */
294 gfc_build_builtin_function_decls ();
296 gfc_init_constants ();
301 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
308 gfc_generate_constructors ();
310 cgraph_finalize_compilation_unit ();
313 /* Tell the frontent about any errors. */
314 gfc_get_errors (&warnings, &errors);
315 errorcount += errors;
316 warningcount += warnings;
320 /* Initialize everything. */
325 #ifdef USE_MAPPED_LOCATION
326 linemap_add (&line_table, LC_ENTER, false, gfc_source_file, 1);
327 linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
330 /* First initialize the backend. */
331 gfc_init_decl_processing ();
332 gfc_static_ctors = NULL_TREE;
334 /* Then the frontend. */
337 if (gfc_new_file () != SUCCESS)
338 fatal_error ("can't open input file: %s", gfc_source_file);
347 gfc_release_include_path ();
352 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
353 tree node ATTRIBUTE_UNUSED,
354 int indent ATTRIBUTE_UNUSED)
360 /* These functions and variables deal with binding contours. We only
361 need these functions for the list of PARM_DECLs, but we leave the
362 functions more general; these are a simplified version of the
363 functions from GNAT. */
365 /* For each binding contour we allocate a binding_level structure which
366 records the entities defined or declared in that contour. Contours
370 one for each subprogram definition
371 one for each compound statement (declare block)
373 Binding contours are used to create GCC tree BLOCK nodes. */
378 /* A chain of ..._DECL nodes for all variables, constants, functions,
379 parameters and type declarations. These ..._DECL nodes are chained
380 through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
381 in the reverse of the order supplied to be compatible with the
384 /* For each level (except the global one), a chain of BLOCK nodes for all
385 the levels that were entered and exited one level down from this one. */
387 /* The binding level containing this one (the enclosing binding level). */
388 struct binding_level *level_chain;
391 /* The binding level currently in effect. */
392 static GTY(()) struct binding_level *current_binding_level = NULL;
394 /* The outermost binding level. This binding level is created when the
395 compiler is started and it will exist through the entire compilation. */
396 static GTY(()) struct binding_level *global_binding_level;
398 /* Binding level structures are initialized by copying this one. */
399 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
402 /* Return nonzero if we are currently in the global binding level. */
405 global_bindings_p (void)
407 return current_binding_level == global_binding_level ? -1 : 0;
413 return current_binding_level->names;
416 /* Enter a new binding level. The input parameter is ignored, but has to be
417 specified for back-end compatibility. */
420 pushlevel (int ignore ATTRIBUTE_UNUSED)
422 struct binding_level *newlevel
423 = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
425 *newlevel = clear_binding_level;
427 /* Add this level to the front of the chain (stack) of levels that are
429 newlevel->level_chain = current_binding_level;
430 current_binding_level = newlevel;
433 /* Exit a binding level.
434 Pop the level off, and restore the state of the identifier-decl mappings
435 that were in effect when this level was entered.
437 If KEEP is nonzero, this level had explicit declarations, so
438 and create a "block" (a BLOCK node) for the level
439 to record its declarations and subblocks for symbol table output.
441 If FUNCTIONBODY is nonzero, this level is the body of a function,
442 so create a block as if KEEP were set and also clear out all
445 If REVERSE is nonzero, reverse the order of decls before putting
446 them into the BLOCK. */
449 poplevel (int keep, int reverse, int functionbody)
451 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
452 binding level that we are about to exit and which is returned by this
454 tree block_node = NULL_TREE;
456 tree subblock_chain = current_binding_level->blocks;
459 /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
460 nodes chained through the `names' field of current_binding_level are in
461 reverse order except for PARM_DECL node, which are explicitly stored in
463 decl_chain = (reverse) ? nreverse (current_binding_level->names)
464 : current_binding_level->names;
466 /* If there were any declarations in the current binding level, or if this
467 binding level is a function body, or if there are any nested blocks then
468 create a BLOCK node to record them for the life of this function. */
469 if (keep || functionbody)
470 block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
472 /* Record the BLOCK node just built as the subblock its enclosing scope. */
473 for (subblock_node = subblock_chain; subblock_node;
474 subblock_node = TREE_CHAIN (subblock_node))
475 BLOCK_SUPERCONTEXT (subblock_node) = block_node;
477 /* Clear out the meanings of the local variables of this level. */
479 for (subblock_node = decl_chain; subblock_node;
480 subblock_node = TREE_CHAIN (subblock_node))
481 if (DECL_NAME (subblock_node) != 0)
482 /* If the identifier was used or addressed via a local extern decl,
483 don't forget that fact. */
484 if (DECL_EXTERNAL (subblock_node))
486 if (TREE_USED (subblock_node))
487 TREE_USED (DECL_NAME (subblock_node)) = 1;
488 if (TREE_ADDRESSABLE (subblock_node))
489 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
492 /* Pop the current level. */
493 current_binding_level = current_binding_level->level_chain;
497 /* This is the top level block of a function. The ..._DECL chain stored
498 in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
499 leave them in the BLOCK because they are found in the FUNCTION_DECL
501 DECL_INITIAL (current_function_decl) = block_node;
502 BLOCK_VARS (block_node) = 0;
506 current_binding_level->blocks
507 = chainon (current_binding_level->blocks, block_node);
510 /* If we did not make a block for the level just exited, any blocks made for
511 inner levels (since they cannot be recorded as subblocks in that level)
512 must be carried forward so they will later become subblocks of something
514 else if (subblock_chain)
515 current_binding_level->blocks
516 = chainon (current_binding_level->blocks, subblock_chain);
518 TREE_USED (block_node) = 1;
524 /* Insert BLOCK at the end of the list of subblocks of the
525 current binding level. This is used when a BIND_EXPR is expanded,
526 to handle the BLOCK node inside the BIND_EXPR. */
529 insert_block (tree block)
531 TREE_USED (block) = 1;
532 current_binding_level->blocks
533 = chainon (current_binding_level->blocks, block);
537 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
538 Returns the ..._DECL node. */
543 /* External objects aren't nested, other objects may be. */
544 if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
545 DECL_CONTEXT (decl) = 0;
547 DECL_CONTEXT (decl) = current_function_decl;
549 /* Put the declaration on the list. The list of declarations is in reverse
550 order. The list will be reversed later if necessary. This needs to be
551 this way for compatibility with the back-end. */
553 TREE_CHAIN (decl) = current_binding_level->names;
554 current_binding_level->names = decl;
556 /* For the declaration of a type, set its name if it is not already set. */
558 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
560 if (DECL_SOURCE_LINE (decl) == 0)
561 TYPE_NAME (TREE_TYPE (decl)) = decl;
563 TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
570 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
573 pushdecl_top_level (tree x)
576 struct binding_level *b = current_binding_level;
578 current_binding_level = global_binding_level;
580 current_binding_level = b;
585 /* Clear the binding stack. */
587 gfc_clear_binding_stack (void)
589 while (!global_bindings_p ())
594 #ifndef CHAR_TYPE_SIZE
595 #define CHAR_TYPE_SIZE BITS_PER_UNIT
598 #ifndef INT_TYPE_SIZE
599 #define INT_TYPE_SIZE BITS_PER_WORD
603 #define SIZE_TYPE "long unsigned int"
605 /* Create tree nodes for the basic scalar types of Fortran 95,
606 and some nodes representing standard constants (0, 1, (void *) 0).
607 Initialize the global binding level.
608 Make definitions for built-in primitive functions. */
610 gfc_init_decl_processing (void)
612 current_function_decl = NULL;
613 current_binding_level = NULL_BINDING_LEVEL;
614 free_binding_level = NULL_BINDING_LEVEL;
616 /* Make the binding_level structure for global names. We move all
617 variables that are in a COMMON block to this binding level. */
619 global_binding_level = current_binding_level;
621 /* Build common tree nodes. char_type_node is unsigned because we
622 only use it for actual characters, not for INTEGER(1). Also, we
623 want double_type_node to actually have double precision. */
624 build_common_tree_nodes (false, false);
625 set_sizetype (long_unsigned_type_node);
626 build_common_tree_nodes_2 (0);
627 void_list_node = build_tree_list (NULL_TREE, void_type_node);
629 /* Set up F95 type nodes. */
635 /* Mark EXP saying that we need to be able to take the
636 address of it; it should not be allocated in a register.
637 In Fortran 95 this is only the case for variables with
638 the TARGET attribute, but we implement it here for a
639 likely future Cray pointer extension.
640 Value is 1 if successful. */
641 /* TODO: Check/fix mark_addressable. */
644 gfc_mark_addressable (tree exp)
646 register tree x = exp;
648 switch (TREE_CODE (x))
655 x = TREE_OPERAND (x, 0);
659 TREE_ADDRESSABLE (x) = 1;
666 if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x))
670 error ("global register variable %qs used in nested function",
671 IDENTIFIER_POINTER (DECL_NAME (x)));
674 pedwarn ("register variable %qs used in nested function",
675 IDENTIFIER_POINTER (DECL_NAME (x)));
677 else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
681 error ("address of global register variable %qs requested",
682 IDENTIFIER_POINTER (DECL_NAME (x)));
687 /* If we are making this addressable due to its having
688 volatile components, give a different error message. Also
689 handle the case of an unnamed parameter by not trying
692 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
694 error ("cannot put object with volatile field into register");
699 pedwarn ("address of register variable %qs requested",
700 IDENTIFIER_POINTER (DECL_NAME (x)));
705 TREE_ADDRESSABLE (x) = 1;
713 /* Return the typed-based alias set for T, which may be an expression
714 or a type. Return -1 if we don't do anything special. */
717 gfc_get_alias_set (tree t)
721 /* Permit type-punning when accessing an EQUIVALENCEd variable or
722 mixed type entry master's return value. */
723 for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
724 if (TREE_CODE (u) == COMPONENT_REF
725 && TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
732 /* press the big red button - garbage (ggc) collection is on */
736 /* Builtin function initialization. */
739 gfc_builtin_function (tree decl)
741 make_decl_rtl (decl);
748 gfc_define_builtin (const char *name,
751 const char *library_name,
756 decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
757 library_name, NULL_TREE);
759 TREE_READONLY (decl) = 1;
761 built_in_decls[code] = decl;
762 implicit_built_in_decls[code] = decl;
766 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
767 gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
768 BUILT_IN_ ## code ## L, name "l", true); \
769 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
770 BUILT_IN_ ## code, name, true); \
771 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
772 BUILT_IN_ ## code ## F, name "f", true);
774 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
775 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
777 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
778 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
779 DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
782 /* Create function types for builtin functions. */
785 build_builtin_fntypes (tree *fntype, tree type)
789 /* type (*) (type) */
790 tmp = tree_cons (NULL_TREE, type, void_list_node);
791 fntype[0] = build_function_type (type, tmp);
792 /* type (*) (type, type) */
793 tmp = tree_cons (NULL_TREE, type, tmp);
794 fntype[1] = build_function_type (type, tmp);
795 /* type (*) (int, type) */
796 tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
797 tmp = tree_cons (NULL_TREE, type, tmp);
798 fntype[2] = build_function_type (type, tmp);
803 builtin_type_for_size (int size, bool unsignedp)
805 tree type = lang_hooks.types.type_for_size (size, unsignedp);
806 return type ? type : error_mark_node;
809 /* Initialization of builtin function nodes. */
812 gfc_init_builtin_functions (void)
816 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
817 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
818 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
819 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
820 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
821 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
822 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
823 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
824 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
825 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
826 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
828 #undef DEF_PRIMITIVE_TYPE
829 #undef DEF_FUNCTION_TYPE_0
830 #undef DEF_FUNCTION_TYPE_1
831 #undef DEF_FUNCTION_TYPE_2
832 #undef DEF_FUNCTION_TYPE_3
833 #undef DEF_FUNCTION_TYPE_4
834 #undef DEF_FUNCTION_TYPE_5
835 #undef DEF_FUNCTION_TYPE_6
836 #undef DEF_FUNCTION_TYPE_7
837 #undef DEF_FUNCTION_TYPE_VAR_0
838 #undef DEF_POINTER_TYPE
841 typedef enum builtin_type builtin_type;
844 /* So far we need just these 2 attribute types. */
846 ATTR_CONST_NOTHROW_LIST
850 tree mfunc_double[3];
851 tree mfunc_longdouble[3];
852 tree mfunc_cfloat[3];
853 tree mfunc_cdouble[3];
854 tree mfunc_clongdouble[3];
855 tree func_cfloat_float, func_float_cfloat;
856 tree func_cdouble_double, func_double_cdouble;
857 tree func_clongdouble_longdouble, func_longdouble_clongdouble;
858 tree func_float_floatp_floatp;
859 tree func_double_doublep_doublep;
860 tree func_longdouble_longdoublep_longdoublep;
863 tree builtin_types[(int) BT_LAST + 1];
865 build_builtin_fntypes (mfunc_float, float_type_node);
866 build_builtin_fntypes (mfunc_double, double_type_node);
867 build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
868 build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
869 build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
870 build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
872 tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
873 func_cfloat_float = build_function_type (float_type_node, tmp);
875 tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
876 func_float_cfloat = build_function_type (complex_float_type_node, tmp);
878 tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
879 func_cdouble_double = build_function_type (double_type_node, tmp);
881 tmp = tree_cons (NULL_TREE, double_type_node, void_list_node);
882 func_double_cdouble = build_function_type (complex_double_type_node, tmp);
884 tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
885 func_clongdouble_longdouble =
886 build_function_type (long_double_type_node, tmp);
888 tmp = tree_cons (NULL_TREE, long_double_type_node, void_list_node);
889 func_longdouble_clongdouble =
890 build_function_type (complex_long_double_type_node, tmp);
892 ptype = build_pointer_type (float_type_node);
893 tmp = tree_cons (NULL_TREE, float_type_node,
894 tree_cons (NULL_TREE, ptype,
895 build_tree_list (NULL_TREE, ptype)));
896 func_float_floatp_floatp =
897 build_function_type (void_type_node, tmp);
899 ptype = build_pointer_type (double_type_node);
900 tmp = tree_cons (NULL_TREE, double_type_node,
901 tree_cons (NULL_TREE, ptype,
902 build_tree_list (NULL_TREE, ptype)));
903 func_double_doublep_doublep =
904 build_function_type (void_type_node, tmp);
906 ptype = build_pointer_type (long_double_type_node);
907 tmp = tree_cons (NULL_TREE, long_double_type_node,
908 tree_cons (NULL_TREE, ptype,
909 build_tree_list (NULL_TREE, ptype)));
910 func_longdouble_longdoublep_longdoublep =
911 build_function_type (void_type_node, tmp);
913 #include "mathbuiltins.def"
915 /* We define these separately as the fortran versions have different
916 semantics (they return an integer type) */
917 gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
918 BUILT_IN_ROUNDL, "roundl", true);
919 gfc_define_builtin ("__builtin_round", mfunc_double[0],
920 BUILT_IN_ROUND, "round", true);
921 gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
922 BUILT_IN_ROUNDF, "roundf", true);
924 gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
925 BUILT_IN_TRUNCL, "truncl", true);
926 gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
927 BUILT_IN_TRUNC, "trunc", true);
928 gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
929 BUILT_IN_TRUNCF, "truncf", true);
931 gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
932 BUILT_IN_CABSL, "cabsl", true);
933 gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
934 BUILT_IN_CABS, "cabs", true);
935 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
936 BUILT_IN_CABSF, "cabsf", true);
938 gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
939 BUILT_IN_COPYSIGNL, "copysignl", true);
940 gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
941 BUILT_IN_COPYSIGN, "copysign", true);
942 gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
943 BUILT_IN_COPYSIGNF, "copysignf", true);
945 gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
946 BUILT_IN_FMODL, "fmodl", true);
947 gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
948 BUILT_IN_FMOD, "fmod", true);
949 gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
950 BUILT_IN_FMODF, "fmodf", true);
952 /* These are used to implement the ** operator. */
953 gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
954 BUILT_IN_POWL, "powl", true);
955 gfc_define_builtin ("__builtin_pow", mfunc_double[1],
956 BUILT_IN_POW, "pow", true);
957 gfc_define_builtin ("__builtin_powf", mfunc_float[1],
958 BUILT_IN_POWF, "powf", true);
960 if (TARGET_C99_FUNCTIONS)
962 gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
963 BUILT_IN_CBRTL, "cbrtl", true);
964 gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
965 BUILT_IN_CBRT, "cbrt", true);
966 gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
967 BUILT_IN_CBRTF, "cbrtf", true);
968 gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
969 BUILT_IN_CEXPIL, "cexpil", true);
970 gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
971 BUILT_IN_CEXPI, "cexpi", true);
972 gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
973 BUILT_IN_CEXPIF, "cexpif", true);
976 if (TARGET_HAS_SINCOS)
978 gfc_define_builtin ("__builtin_sincosl",
979 func_longdouble_longdoublep_longdoublep,
980 BUILT_IN_SINCOSL, "sincosl", false);
981 gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
982 BUILT_IN_SINCOS, "sincos", false);
983 gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
984 BUILT_IN_SINCOSF, "sincosf", false);
987 /* Other builtin functions we use. */
989 tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
990 tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
991 ftype = build_function_type (long_integer_type_node, tmp);
992 gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
993 "__builtin_expect", true);
995 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
996 builtin_types[(int) ENUM] = VALUE;
997 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
998 builtin_types[(int) ENUM] \
999 = build_function_type (builtin_types[(int) RETURN], \
1001 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
1002 builtin_types[(int) ENUM] \
1003 = build_function_type (builtin_types[(int) RETURN], \
1004 tree_cons (NULL_TREE, \
1005 builtin_types[(int) ARG1], \
1007 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
1008 builtin_types[(int) ENUM] \
1009 = build_function_type \
1010 (builtin_types[(int) RETURN], \
1011 tree_cons (NULL_TREE, \
1012 builtin_types[(int) ARG1], \
1013 tree_cons (NULL_TREE, \
1014 builtin_types[(int) ARG2], \
1016 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
1017 builtin_types[(int) ENUM] \
1018 = build_function_type \
1019 (builtin_types[(int) RETURN], \
1020 tree_cons (NULL_TREE, \
1021 builtin_types[(int) ARG1], \
1022 tree_cons (NULL_TREE, \
1023 builtin_types[(int) ARG2], \
1024 tree_cons (NULL_TREE, \
1025 builtin_types[(int) ARG3], \
1027 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
1028 builtin_types[(int) ENUM] \
1029 = build_function_type \
1030 (builtin_types[(int) RETURN], \
1031 tree_cons (NULL_TREE, \
1032 builtin_types[(int) ARG1], \
1033 tree_cons (NULL_TREE, \
1034 builtin_types[(int) ARG2], \
1037 builtin_types[(int) ARG3], \
1038 tree_cons (NULL_TREE, \
1039 builtin_types[(int) ARG4], \
1040 void_list_node)))));
1041 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
1042 builtin_types[(int) ENUM] \
1043 = build_function_type \
1044 (builtin_types[(int) RETURN], \
1045 tree_cons (NULL_TREE, \
1046 builtin_types[(int) ARG1], \
1047 tree_cons (NULL_TREE, \
1048 builtin_types[(int) ARG2], \
1051 builtin_types[(int) ARG3], \
1052 tree_cons (NULL_TREE, \
1053 builtin_types[(int) ARG4], \
1054 tree_cons (NULL_TREE, \
1055 builtin_types[(int) ARG5],\
1056 void_list_node))))));
1057 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1059 builtin_types[(int) ENUM] \
1060 = build_function_type \
1061 (builtin_types[(int) RETURN], \
1062 tree_cons (NULL_TREE, \
1063 builtin_types[(int) ARG1], \
1064 tree_cons (NULL_TREE, \
1065 builtin_types[(int) ARG2], \
1068 builtin_types[(int) ARG3], \
1071 builtin_types[(int) ARG4], \
1072 tree_cons (NULL_TREE, \
1073 builtin_types[(int) ARG5], \
1074 tree_cons (NULL_TREE, \
1075 builtin_types[(int) ARG6],\
1076 void_list_node)))))));
1077 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1079 builtin_types[(int) ENUM] \
1080 = build_function_type \
1081 (builtin_types[(int) RETURN], \
1082 tree_cons (NULL_TREE, \
1083 builtin_types[(int) ARG1], \
1084 tree_cons (NULL_TREE, \
1085 builtin_types[(int) ARG2], \
1088 builtin_types[(int) ARG3], \
1091 builtin_types[(int) ARG4], \
1092 tree_cons (NULL_TREE, \
1093 builtin_types[(int) ARG5], \
1094 tree_cons (NULL_TREE, \
1095 builtin_types[(int) ARG6],\
1096 tree_cons (NULL_TREE, \
1097 builtin_types[(int) ARG6], \
1098 void_list_node))))))));
1099 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1100 builtin_types[(int) ENUM] \
1101 = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
1102 #define DEF_POINTER_TYPE(ENUM, TYPE) \
1103 builtin_types[(int) ENUM] \
1104 = build_pointer_type (builtin_types[(int) TYPE]);
1105 #include "types.def"
1106 #undef DEF_PRIMITIVE_TYPE
1107 #undef DEF_FUNCTION_TYPE_1
1108 #undef DEF_FUNCTION_TYPE_2
1109 #undef DEF_FUNCTION_TYPE_3
1110 #undef DEF_FUNCTION_TYPE_4
1111 #undef DEF_FUNCTION_TYPE_5
1112 #undef DEF_FUNCTION_TYPE_6
1113 #undef DEF_FUNCTION_TYPE_VAR_0
1114 #undef DEF_POINTER_TYPE
1115 builtin_types[(int) BT_LAST] = NULL_TREE;
1117 /* Initialize synchronization builtins. */
1118 #undef DEF_SYNC_BUILTIN
1119 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1120 gfc_define_builtin (name, builtin_types[type], code, name, \
1121 attr == ATTR_CONST_NOTHROW_LIST);
1122 #include "../sync-builtins.def"
1123 #undef DEF_SYNC_BUILTIN
1125 if (gfc_option.flag_openmp)
1127 #undef DEF_GOMP_BUILTIN
1128 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1129 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1130 code, name, attr == ATTR_CONST_NOTHROW_LIST);
1131 #include "../omp-builtins.def"
1132 #undef DEF_GOMP_BUILTIN
1135 gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
1136 BUILT_IN_TRAP, NULL, false);
1137 TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
1139 build_common_builtin_nodes ();
1140 targetm.init_builtins ();
1143 #undef DEFINE_MATH_BUILTIN_C
1144 #undef DEFINE_MATH_BUILTIN
1146 #include "gt-fortran-f95-lang.h"
1147 #include "gtype-fortran.h"