1 /* gfortran backend interface
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
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 ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
67 union tree_node
GTY((tag ("0"),
68 desc ("tree_node_structure (&%h)"))) generic
;
69 struct lang_identifier
GTY((tag ("1"))) identifier
;
72 /* Save and restore the variables in this file and elsewhere
73 that keep track of the progress of compilation of the current function.
74 Used for nested functions. */
76 struct language_function
79 /* struct gfc_language_function base; */
80 struct binding_level
*binding_level
;
83 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
85 void yyerror (const char *str
);
88 static void gfc_init_decl_processing (void);
89 static void gfc_init_builtin_functions (void);
91 /* Each front end provides its own. */
92 static bool gfc_init (void);
93 static void gfc_finish (void);
94 static void gfc_print_identifier (FILE *, tree
, int);
95 static bool gfc_mark_addressable (tree
);
96 void do_function_end (void);
97 int global_bindings_p (void);
98 void insert_block (tree
);
99 static void gfc_clear_binding_stack (void);
100 static void gfc_be_parse_file (int);
101 static void gfc_expand_function (tree
);
102 static HOST_WIDE_INT
gfc_get_alias_set (tree
);
104 #undef LANG_HOOKS_NAME
105 #undef LANG_HOOKS_INIT
106 #undef LANG_HOOKS_FINISH
107 #undef LANG_HOOKS_INIT_OPTIONS
108 #undef LANG_HOOKS_HANDLE_OPTION
109 #undef LANG_HOOKS_POST_OPTIONS
110 #undef LANG_HOOKS_PRINT_IDENTIFIER
111 #undef LANG_HOOKS_PARSE_FILE
112 #undef LANG_HOOKS_MARK_ADDRESSABLE
113 #undef LANG_HOOKS_TYPE_FOR_MODE
114 #undef LANG_HOOKS_TYPE_FOR_SIZE
115 #undef LANG_HOOKS_UNSIGNED_TYPE
116 #undef LANG_HOOKS_SIGNED_TYPE
117 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
118 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
119 #undef LANG_HOOKS_CLEAR_BINDING_STACK
120 #undef LANG_HOOKS_GET_ALIAS_SET
121 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
122 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
123 #undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
124 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
125 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
126 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
128 /* Define lang hooks. */
129 #define LANG_HOOKS_NAME "GNU F95"
130 #define LANG_HOOKS_INIT gfc_init
131 #define LANG_HOOKS_FINISH gfc_finish
132 #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
133 #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
134 #define LANG_HOOKS_POST_OPTIONS gfc_post_options
135 #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
136 #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
137 #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
138 #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
139 #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
140 #define LANG_HOOKS_UNSIGNED_TYPE gfc_unsigned_type
141 #define LANG_HOOKS_SIGNED_TYPE gfc_signed_type
142 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
143 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
144 #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack
145 #define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
146 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
147 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
148 #define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
149 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
150 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
151 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
152 gfc_omp_firstprivatize_type_sizes
154 const struct lang_hooks lang_hooks
= LANG_HOOKS_INITIALIZER
;
156 /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
157 that have names. Here so we can clear out their names' definitions
158 at the end of the function. */
160 /* Tree code classes. */
162 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
164 const enum tree_code_class tree_code_type
[] = {
169 /* Table indexed by tree code giving number of expression
170 operands beyond the fixed part of the node structure.
171 Not used for types or decls. */
173 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
175 const unsigned char tree_code_length
[] = {
180 /* Names of tree components.
181 Used for printing out the tree and error messages. */
182 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
184 const char *const tree_code_name
[] = {
190 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
192 /* A chain of binding_level structures awaiting reuse. */
194 static GTY(()) struct binding_level
*free_binding_level
;
196 /* The elements of `ridpointers' are identifier nodes
197 for the reserved type names and storage classes.
198 It is indexed by a RID_... value. */
199 tree
*ridpointers
= NULL
;
201 /* language-specific flags. */
204 gfc_expand_function (tree fndecl
)
208 if (DECL_INITIAL (fndecl
)
209 && BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl
)))
211 /* Local static equivalenced variables are never seen by
212 check_global_declarations, so we need to output debug
215 t
= BLOCK_SUBBLOCKS (DECL_INITIAL (fndecl
));
216 for (t
= BLOCK_VARS (t
); t
; t
= TREE_CHAIN (t
))
217 if (TREE_CODE (t
) == VAR_DECL
&& DECL_HAS_VALUE_EXPR_P (t
)
220 tree expr
= DECL_VALUE_EXPR (t
);
222 if (TREE_CODE (expr
) == COMPONENT_REF
223 && TREE_CODE (TREE_OPERAND (expr
, 0)) == VAR_DECL
224 && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr
, 0)))
226 && cgraph_varpool_node (TREE_OPERAND (expr
, 0))->needed
227 && errorcount
== 0 && sorrycount
== 0)
229 timevar_push (TV_SYMOUT
);
230 (*debug_hooks
->global_decl
) (t
);
231 timevar_pop (TV_SYMOUT
);
236 tree_rest_of_compilation (fndecl
);
240 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
241 or validate its data type for an `if' or `while' statement or ?..: exp.
243 This preparation consists of taking the ordinary
244 representation of an expression expr and producing a valid tree
245 boolean expression describing whether expr is nonzero. We could
246 simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
247 but we optimize comparisons, &&, ||, and !.
249 The resulting type should always be `boolean_type_node'.
250 This is much simpler than the corresponding C version because we have a
251 distinct boolean type. */
254 gfc_truthvalue_conversion (tree expr
)
256 switch (TREE_CODE (TREE_TYPE (expr
)))
259 if (TREE_TYPE (expr
) == boolean_type_node
)
261 else if (COMPARISON_CLASS_P (expr
))
263 TREE_TYPE (expr
) = boolean_type_node
;
266 else if (TREE_CODE (expr
) == NOP_EXPR
)
267 return build1 (NOP_EXPR
, boolean_type_node
,
268 TREE_OPERAND (expr
, 0));
270 return build1 (NOP_EXPR
, boolean_type_node
, expr
);
273 if (TREE_CODE (expr
) == INTEGER_CST
)
274 return integer_zerop (expr
) ? boolean_false_node
: boolean_true_node
;
276 return build2 (NE_EXPR
, boolean_type_node
, expr
,
277 build_int_cst (TREE_TYPE (expr
), 0));
280 internal_error ("Unexpected type in truthvalue_conversion");
285 gfc_create_decls (void)
288 gfc_init_builtin_functions ();
290 /* Runtime/IO library functions. */
291 gfc_build_builtin_function_decls ();
293 gfc_init_constants ();
297 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED
)
304 gfc_generate_constructors ();
306 cgraph_finalize_compilation_unit ();
309 /* Tell the frontent about any errors. */
310 gfc_get_errors (&warnings
, &errors
);
311 errorcount
+= errors
;
312 warningcount
+= warnings
;
315 /* Initialize everything. */
320 #ifdef USE_MAPPED_LOCATION
321 linemap_add (&line_table
, LC_ENTER
, false, gfc_source_file
, 1);
322 linemap_add (&line_table
, LC_RENAME
, false, "<built-in>", 0);
325 /* First initialize the backend. */
326 gfc_init_decl_processing ();
327 gfc_static_ctors
= NULL_TREE
;
329 /* Then the frontend. */
332 if (gfc_new_file () != SUCCESS
)
333 fatal_error ("can't open input file: %s", gfc_source_file
);
342 gfc_release_include_path ();
347 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED
,
348 tree node ATTRIBUTE_UNUSED
,
349 int indent ATTRIBUTE_UNUSED
)
355 /* These functions and variables deal with binding contours. We only
356 need these functions for the list of PARM_DECLs, but we leave the
357 functions more general; these are a simplified version of the
358 functions from GNAT. */
360 /* For each binding contour we allocate a binding_level structure which records
361 the entities defined or declared in that contour. Contours include:
364 one for each subprogram definition
365 one for each compound statement (declare block)
367 Binding contours are used to create GCC tree BLOCK nodes. */
372 /* A chain of ..._DECL nodes for all variables, constants, functions,
373 parameters and type declarations. These ..._DECL nodes are chained
374 through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
375 in the reverse of the order supplied to be compatible with the
378 /* For each level (except the global one), a chain of BLOCK nodes for all
379 the levels that were entered and exited one level down from this one. */
381 /* The binding level containing this one (the enclosing binding level). */
382 struct binding_level
*level_chain
;
385 /* The binding level currently in effect. */
386 static GTY(()) struct binding_level
*current_binding_level
= NULL
;
388 /* The outermost binding level. This binding level is created when the
389 compiler is started and it will exist through the entire compilation. */
390 static GTY(()) struct binding_level
*global_binding_level
;
392 /* Binding level structures are initialized by copying this one. */
393 static struct binding_level clear_binding_level
= { NULL
, NULL
, NULL
};
395 /* Return nonzero if we are currently in the global binding level. */
398 global_bindings_p (void)
400 return current_binding_level
== global_binding_level
? -1 : 0;
406 return current_binding_level
->names
;
409 /* Enter a new binding level. The input parameter is ignored, but has to be
410 specified for back-end compatibility. */
413 pushlevel (int ignore ATTRIBUTE_UNUSED
)
415 struct binding_level
*newlevel
416 = (struct binding_level
*) ggc_alloc (sizeof (struct binding_level
));
418 *newlevel
= clear_binding_level
;
420 /* Add this level to the front of the chain (stack) of levels that are
422 newlevel
->level_chain
= current_binding_level
;
423 current_binding_level
= newlevel
;
426 /* Exit a binding level.
427 Pop the level off, and restore the state of the identifier-decl mappings
428 that were in effect when this level was entered.
430 If KEEP is nonzero, this level had explicit declarations, so
431 and create a "block" (a BLOCK node) for the level
432 to record its declarations and subblocks for symbol table output.
434 If FUNCTIONBODY is nonzero, this level is the body of a function,
435 so create a block as if KEEP were set and also clear out all
438 If REVERSE is nonzero, reverse the order of decls before putting
439 them into the BLOCK. */
442 poplevel (int keep
, int reverse
, int functionbody
)
444 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
445 binding level that we are about to exit and which is returned by this
447 tree block_node
= NULL_TREE
;
449 tree subblock_chain
= current_binding_level
->blocks
;
452 /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
453 nodes chained through the `names' field of current_binding_level are in
454 reverse order except for PARM_DECL node, which are explicitly stored in
456 decl_chain
= (reverse
) ? nreverse (current_binding_level
->names
)
457 : current_binding_level
->names
;
459 /* If there were any declarations in the current binding level, or if this
460 binding level is a function body, or if there are any nested blocks then
461 create a BLOCK node to record them for the life of this function. */
462 if (keep
|| functionbody
)
463 block_node
= build_block (keep
? decl_chain
: 0, subblock_chain
, 0, 0);
465 /* Record the BLOCK node just built as the subblock its enclosing scope. */
466 for (subblock_node
= subblock_chain
; subblock_node
;
467 subblock_node
= TREE_CHAIN (subblock_node
))
468 BLOCK_SUPERCONTEXT (subblock_node
) = block_node
;
470 /* Clear out the meanings of the local variables of this level. */
472 for (subblock_node
= decl_chain
; subblock_node
;
473 subblock_node
= TREE_CHAIN (subblock_node
))
474 if (DECL_NAME (subblock_node
) != 0)
475 /* If the identifier was used or addressed via a local extern decl,
476 don't forget that fact. */
477 if (DECL_EXTERNAL (subblock_node
))
479 if (TREE_USED (subblock_node
))
480 TREE_USED (DECL_NAME (subblock_node
)) = 1;
481 if (TREE_ADDRESSABLE (subblock_node
))
482 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node
)) = 1;
485 /* Pop the current level. */
486 current_binding_level
= current_binding_level
->level_chain
;
490 /* This is the top level block of a function. The ..._DECL chain stored
491 in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
492 leave them in the BLOCK because they are found in the FUNCTION_DECL
494 DECL_INITIAL (current_function_decl
) = block_node
;
495 BLOCK_VARS (block_node
) = 0;
499 current_binding_level
->blocks
500 = chainon (current_binding_level
->blocks
, block_node
);
503 /* If we did not make a block for the level just exited, any blocks made for
504 inner levels (since they cannot be recorded as subblocks in that level)
505 must be carried forward so they will later become subblocks of something
507 else if (subblock_chain
)
508 current_binding_level
->blocks
509 = chainon (current_binding_level
->blocks
, subblock_chain
);
511 TREE_USED (block_node
) = 1;
516 /* Insert BLOCK at the end of the list of subblocks of the
517 current binding level. This is used when a BIND_EXPR is expanded,
518 to handle the BLOCK node inside the BIND_EXPR. */
521 insert_block (tree block
)
523 TREE_USED (block
) = 1;
524 current_binding_level
->blocks
525 = chainon (current_binding_level
->blocks
, block
);
528 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
529 Returns the ..._DECL node. */
534 /* External objects aren't nested, other objects may be. */
535 if ((DECL_EXTERNAL (decl
)) || (decl
== current_function_decl
))
536 DECL_CONTEXT (decl
) = 0;
538 DECL_CONTEXT (decl
) = current_function_decl
;
540 /* Put the declaration on the list. The list of declarations is in reverse
541 order. The list will be reversed later if necessary. This needs to be
542 this way for compatibility with the back-end. */
544 TREE_CHAIN (decl
) = current_binding_level
->names
;
545 current_binding_level
->names
= decl
;
547 /* For the declaration of a type, set its name if it is not already set. */
549 if (TREE_CODE (decl
) == TYPE_DECL
&& TYPE_NAME (TREE_TYPE (decl
)) == 0)
551 if (DECL_SOURCE_LINE (decl
) == 0)
552 TYPE_NAME (TREE_TYPE (decl
)) = decl
;
554 TYPE_NAME (TREE_TYPE (decl
)) = DECL_NAME (decl
);
561 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
564 pushdecl_top_level (tree x
)
567 struct binding_level
*b
= current_binding_level
;
569 current_binding_level
= global_binding_level
;
571 current_binding_level
= b
;
576 /* Clear the binding stack. */
578 gfc_clear_binding_stack (void)
580 while (!global_bindings_p ())
585 #ifndef CHAR_TYPE_SIZE
586 #define CHAR_TYPE_SIZE BITS_PER_UNIT
589 #ifndef INT_TYPE_SIZE
590 #define INT_TYPE_SIZE BITS_PER_WORD
594 #define SIZE_TYPE "long unsigned int"
596 /* Create tree nodes for the basic scalar types of Fortran 95,
597 and some nodes representing standard constants (0, 1, (void *) 0).
598 Initialize the global binding level.
599 Make definitions for built-in primitive functions. */
601 gfc_init_decl_processing (void)
603 current_function_decl
= NULL
;
604 current_binding_level
= NULL_BINDING_LEVEL
;
605 free_binding_level
= NULL_BINDING_LEVEL
;
607 /* Make the binding_level structure for global names. We move all
608 variables that are in a COMMON block to this binding level. */
610 global_binding_level
= current_binding_level
;
612 /* Build common tree nodes. char_type_node is unsigned because we
613 only use it for actual characters, not for INTEGER(1). Also, we
614 want double_type_node to actually have double precision. */
615 build_common_tree_nodes (false, false);
616 set_sizetype (long_unsigned_type_node
);
617 build_common_tree_nodes_2 (0);
618 void_list_node
= build_tree_list (NULL_TREE
, void_type_node
);
620 /* Set up F95 type nodes. */
625 /* Mark EXP saying that we need to be able to take the
626 address of it; it should not be allocated in a register.
627 In Fortran 95 this is only the case for variables with
628 the TARGET attribute, but we implement it here for a
629 likely future Cray pointer extension.
630 Value is 1 if successful. */
631 /* TODO: Check/fix mark_addressable. */
633 gfc_mark_addressable (tree exp
)
635 register tree x
= exp
;
637 switch (TREE_CODE (x
))
644 x
= TREE_OPERAND (x
, 0);
648 TREE_ADDRESSABLE (x
) = 1;
655 if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
) && DECL_NONLOCAL (x
))
660 ("global register variable %qs used in nested function",
661 IDENTIFIER_POINTER (DECL_NAME (x
)));
664 pedwarn ("register variable %qs used in nested function",
665 IDENTIFIER_POINTER (DECL_NAME (x
)));
667 else if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
))
671 error ("address of global register variable %qs requested",
672 IDENTIFIER_POINTER (DECL_NAME (x
)));
677 /* If we are making this addressable due to its having
678 volatile components, give a different error message. Also
679 handle the case of an unnamed parameter by not trying
682 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x
)))
684 error ("cannot put object with volatile field into register");
689 pedwarn ("address of register variable %qs requested",
690 IDENTIFIER_POINTER (DECL_NAME (x
)));
695 TREE_ADDRESSABLE (x
) = 1;
702 /* Return the typed-based alias set for T, which may be an expression
703 or a type. Return -1 if we don't do anything special. */
706 gfc_get_alias_set (tree t
)
710 /* Permit type-punning when accessing an EQUIVALENCEd variable or
711 mixed type entry master's return value. */
712 for (u
= t
; handled_component_p (u
); u
= TREE_OPERAND (u
, 0))
713 if (TREE_CODE (u
) == COMPONENT_REF
714 && TREE_CODE (TREE_TYPE (TREE_OPERAND (u
, 0))) == UNION_TYPE
)
720 /* press the big red button - garbage (ggc) collection is on */
724 /* Builtin function initialization. */
726 /* Return a definition for a builtin function named NAME and whose data type
727 is TYPE. TYPE should be a function type with argument types.
728 FUNCTION_CODE tells later passes how to compile calls to this function.
729 See tree.h for its possible values.
731 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
732 the name to be called if we can't opencode the function. If
733 ATTRS is nonzero, use that for the function's attribute list. */
736 builtin_function (const char *name
,
739 enum built_in_class
class,
740 const char *library_name
,
743 tree decl
= build_decl (FUNCTION_DECL
, get_identifier (name
), type
);
744 DECL_EXTERNAL (decl
) = 1;
745 TREE_PUBLIC (decl
) = 1;
747 SET_DECL_ASSEMBLER_NAME (decl
, get_identifier (library_name
));
748 make_decl_rtl (decl
);
750 DECL_BUILT_IN_CLASS (decl
) = class;
751 DECL_FUNCTION_CODE (decl
) = function_code
;
753 /* Possibly apply some default attributes to this built-in function. */
756 /* FORNOW the only supported attribute is "const". If others need
757 to be supported then see the more general solution in procedure
758 builtin_function in c-decl.c */
759 if (lookup_attribute ( "const", attrs
))
760 TREE_READONLY (decl
) = 1;
768 gfc_define_builtin (const char * name
,
771 const char * library_name
,
776 decl
= builtin_function (name
, type
, code
, BUILT_IN_NORMAL
,
777 library_name
, NULL_TREE
);
779 TREE_READONLY (decl
) = 1;
781 built_in_decls
[code
] = decl
;
782 implicit_built_in_decls
[code
] = decl
;
786 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
787 gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
788 BUILT_IN_ ## code ## L, name "l", true); \
789 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
790 BUILT_IN_ ## code, name, true); \
791 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
792 BUILT_IN_ ## code ## F, name "f", true);
794 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
795 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
797 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
798 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
799 DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
802 /* Create function types for builtin functions. */
805 build_builtin_fntypes (tree
* fntype
, tree type
)
809 /* type (*) (type) */
810 tmp
= tree_cons (NULL_TREE
, type
, void_list_node
);
811 fntype
[0] = build_function_type (type
, tmp
);
812 /* type (*) (type, type) */
813 tmp
= tree_cons (NULL_TREE
, type
, tmp
);
814 fntype
[1] = build_function_type (type
, tmp
);
815 /* type (*) (int, type) */
816 tmp
= tree_cons (NULL_TREE
, integer_type_node
, void_list_node
);
817 tmp
= tree_cons (NULL_TREE
, type
, tmp
);
818 fntype
[2] = build_function_type (type
, tmp
);
822 builtin_type_for_size (int size
, bool unsignedp
)
824 tree type
= lang_hooks
.types
.type_for_size (size
, unsignedp
);
825 return type
? type
: error_mark_node
;
828 /* Initialization of builtin function nodes. */
831 gfc_init_builtin_functions (void)
835 #define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
836 #define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
837 #define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
838 #define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
839 #define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
840 #define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
841 #define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
842 #define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
843 #define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
844 #define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
845 #define DEF_POINTER_TYPE(NAME, TYPE) NAME,
847 #undef DEF_PRIMITIVE_TYPE
848 #undef DEF_FUNCTION_TYPE_0
849 #undef DEF_FUNCTION_TYPE_1
850 #undef DEF_FUNCTION_TYPE_2
851 #undef DEF_FUNCTION_TYPE_3
852 #undef DEF_FUNCTION_TYPE_4
853 #undef DEF_FUNCTION_TYPE_5
854 #undef DEF_FUNCTION_TYPE_6
855 #undef DEF_FUNCTION_TYPE_7
856 #undef DEF_FUNCTION_TYPE_VAR_0
857 #undef DEF_POINTER_TYPE
860 typedef enum builtin_type builtin_type
;
863 /* So far we need just these 2 attribute types. */
865 ATTR_CONST_NOTHROW_LIST
869 tree mfunc_double
[3];
870 tree mfunc_longdouble
[3];
871 tree mfunc_cfloat
[3];
872 tree mfunc_cdouble
[3];
873 tree mfunc_clongdouble
[3];
874 tree func_cfloat_float
;
875 tree func_cdouble_double
;
876 tree func_clongdouble_longdouble
;
879 tree builtin_types
[(int) BT_LAST
+ 1];
881 build_builtin_fntypes (mfunc_float
, float_type_node
);
882 build_builtin_fntypes (mfunc_double
, double_type_node
);
883 build_builtin_fntypes (mfunc_longdouble
, long_double_type_node
);
884 build_builtin_fntypes (mfunc_cfloat
, complex_float_type_node
);
885 build_builtin_fntypes (mfunc_cdouble
, complex_double_type_node
);
886 build_builtin_fntypes (mfunc_clongdouble
, complex_long_double_type_node
);
888 tmp
= tree_cons (NULL_TREE
, complex_float_type_node
, void_list_node
);
889 func_cfloat_float
= build_function_type (float_type_node
, tmp
);
891 tmp
= tree_cons (NULL_TREE
, complex_double_type_node
, void_list_node
);
892 func_cdouble_double
= build_function_type (double_type_node
, tmp
);
894 tmp
= tree_cons (NULL_TREE
, complex_long_double_type_node
, void_list_node
);
895 func_clongdouble_longdouble
=
896 build_function_type (long_double_type_node
, tmp
);
898 #include "mathbuiltins.def"
900 /* We define these separately as the fortran versions have different
901 semantics (they return an integer type) */
902 gfc_define_builtin ("__builtin_roundl", mfunc_longdouble
[0],
903 BUILT_IN_ROUNDL
, "roundl", true);
904 gfc_define_builtin ("__builtin_round", mfunc_double
[0],
905 BUILT_IN_ROUND
, "round", true);
906 gfc_define_builtin ("__builtin_roundf", mfunc_float
[0],
907 BUILT_IN_ROUNDF
, "roundf", true);
909 gfc_define_builtin ("__builtin_truncl", mfunc_longdouble
[0],
910 BUILT_IN_TRUNCL
, "truncl", true);
911 gfc_define_builtin ("__builtin_trunc", mfunc_double
[0],
912 BUILT_IN_TRUNC
, "trunc", true);
913 gfc_define_builtin ("__builtin_truncf", mfunc_float
[0],
914 BUILT_IN_TRUNCF
, "truncf", true);
916 gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble
,
917 BUILT_IN_CABSL
, "cabsl", true);
918 gfc_define_builtin ("__builtin_cabs", func_cdouble_double
,
919 BUILT_IN_CABS
, "cabs", true);
920 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float
,
921 BUILT_IN_CABSF
, "cabsf", true);
923 gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble
[1],
924 BUILT_IN_COPYSIGNL
, "copysignl", true);
925 gfc_define_builtin ("__builtin_copysign", mfunc_double
[1],
926 BUILT_IN_COPYSIGN
, "copysign", true);
927 gfc_define_builtin ("__builtin_copysignf", mfunc_float
[1],
928 BUILT_IN_COPYSIGNF
, "copysignf", true);
930 /* These are used to implement the ** operator. */
931 gfc_define_builtin ("__builtin_powl", mfunc_longdouble
[1],
932 BUILT_IN_POWL
, "powl", true);
933 gfc_define_builtin ("__builtin_pow", mfunc_double
[1],
934 BUILT_IN_POW
, "pow", true);
935 gfc_define_builtin ("__builtin_powf", mfunc_float
[1],
936 BUILT_IN_POWF
, "powf", true);
938 /* Other builtin functions we use. */
940 tmp
= tree_cons (NULL_TREE
, long_integer_type_node
, void_list_node
);
941 tmp
= tree_cons (NULL_TREE
, long_integer_type_node
, tmp
);
942 ftype
= build_function_type (long_integer_type_node
, tmp
);
943 gfc_define_builtin ("__builtin_expect", ftype
, BUILT_IN_EXPECT
,
944 "__builtin_expect", true);
946 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
947 builtin_types[(int) ENUM] = VALUE;
948 #define DEF_FUNCTION_TYPE_0(ENUM, RETURN) \
949 builtin_types[(int) ENUM] \
950 = build_function_type (builtin_types[(int) RETURN], \
952 #define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1) \
953 builtin_types[(int) ENUM] \
954 = build_function_type (builtin_types[(int) RETURN], \
955 tree_cons (NULL_TREE, \
956 builtin_types[(int) ARG1], \
958 #define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2) \
959 builtin_types[(int) ENUM] \
960 = build_function_type \
961 (builtin_types[(int) RETURN], \
962 tree_cons (NULL_TREE, \
963 builtin_types[(int) ARG1], \
964 tree_cons (NULL_TREE, \
965 builtin_types[(int) ARG2], \
967 #define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3) \
968 builtin_types[(int) ENUM] \
969 = build_function_type \
970 (builtin_types[(int) RETURN], \
971 tree_cons (NULL_TREE, \
972 builtin_types[(int) ARG1], \
973 tree_cons (NULL_TREE, \
974 builtin_types[(int) ARG2], \
975 tree_cons (NULL_TREE, \
976 builtin_types[(int) ARG3], \
978 #define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4) \
979 builtin_types[(int) ENUM] \
980 = build_function_type \
981 (builtin_types[(int) RETURN], \
982 tree_cons (NULL_TREE, \
983 builtin_types[(int) ARG1], \
984 tree_cons (NULL_TREE, \
985 builtin_types[(int) ARG2], \
988 builtin_types[(int) ARG3], \
989 tree_cons (NULL_TREE, \
990 builtin_types[(int) ARG4], \
992 #define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
993 builtin_types[(int) ENUM] \
994 = build_function_type \
995 (builtin_types[(int) RETURN], \
996 tree_cons (NULL_TREE, \
997 builtin_types[(int) ARG1], \
998 tree_cons (NULL_TREE, \
999 builtin_types[(int) ARG2], \
1002 builtin_types[(int) ARG3], \
1003 tree_cons (NULL_TREE, \
1004 builtin_types[(int) ARG4], \
1005 tree_cons (NULL_TREE, \
1006 builtin_types[(int) ARG5],\
1007 void_list_node))))));
1008 #define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1010 builtin_types[(int) ENUM] \
1011 = build_function_type \
1012 (builtin_types[(int) RETURN], \
1013 tree_cons (NULL_TREE, \
1014 builtin_types[(int) ARG1], \
1015 tree_cons (NULL_TREE, \
1016 builtin_types[(int) ARG2], \
1019 builtin_types[(int) ARG3], \
1022 builtin_types[(int) ARG4], \
1023 tree_cons (NULL_TREE, \
1024 builtin_types[(int) ARG5], \
1025 tree_cons (NULL_TREE, \
1026 builtin_types[(int) ARG6],\
1027 void_list_node)))))));
1028 #define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
1030 builtin_types[(int) ENUM] \
1031 = build_function_type \
1032 (builtin_types[(int) RETURN], \
1033 tree_cons (NULL_TREE, \
1034 builtin_types[(int) ARG1], \
1035 tree_cons (NULL_TREE, \
1036 builtin_types[(int) ARG2], \
1039 builtin_types[(int) ARG3], \
1042 builtin_types[(int) ARG4], \
1043 tree_cons (NULL_TREE, \
1044 builtin_types[(int) ARG5], \
1045 tree_cons (NULL_TREE, \
1046 builtin_types[(int) ARG6],\
1047 tree_cons (NULL_TREE, \
1048 builtin_types[(int) ARG6], \
1049 void_list_node))))))));
1050 #define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN) \
1051 builtin_types[(int) ENUM] \
1052 = build_function_type (builtin_types[(int) RETURN], NULL_TREE);
1053 #define DEF_POINTER_TYPE(ENUM, TYPE) \
1054 builtin_types[(int) ENUM] \
1055 = build_pointer_type (builtin_types[(int) TYPE]);
1056 #include "types.def"
1057 #undef DEF_PRIMITIVE_TYPE
1058 #undef DEF_FUNCTION_TYPE_1
1059 #undef DEF_FUNCTION_TYPE_2
1060 #undef DEF_FUNCTION_TYPE_3
1061 #undef DEF_FUNCTION_TYPE_4
1062 #undef DEF_FUNCTION_TYPE_5
1063 #undef DEF_FUNCTION_TYPE_6
1064 #undef DEF_FUNCTION_TYPE_VAR_0
1065 #undef DEF_POINTER_TYPE
1066 builtin_types
[(int) BT_LAST
] = NULL_TREE
;
1068 /* Initialize synchronization builtins. */
1069 #undef DEF_SYNC_BUILTIN
1070 #define DEF_SYNC_BUILTIN(code, name, type, attr) \
1071 gfc_define_builtin (name, builtin_types[type], code, name, \
1072 attr == ATTR_CONST_NOTHROW_LIST);
1073 #include "../sync-builtins.def"
1074 #undef DEF_SYNC_BUILTIN
1076 if (gfc_option
.flag_openmp
)
1078 #undef DEF_GOMP_BUILTIN
1079 #define DEF_GOMP_BUILTIN(code, name, type, attr) \
1080 gfc_define_builtin ("__builtin_" name, builtin_types[type], \
1081 code, name, attr == ATTR_CONST_NOTHROW_LIST);
1082 #include "../omp-builtins.def"
1083 #undef DEF_GOMP_BUILTIN
1086 gfc_define_builtin ("__builtin_trap", builtin_types
[BT_FN_VOID
],
1087 BUILT_IN_TRAP
, NULL
, false);
1088 TREE_THIS_VOLATILE (built_in_decls
[BUILT_IN_TRAP
]) = 1;
1090 build_common_builtin_nodes ();
1091 targetm
.init_builtins ();
1094 #undef DEFINE_MATH_BUILTIN_C
1095 #undef DEFINE_MATH_BUILTIN
1097 #include "gt-fortran-f95-lang.h"
1098 #include "gtype-fortran.h"