1 /* gfortran backend interface
2 Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation,
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, 59 Temple Place - Suite 330, Boston, MA
23 /* f95-lang.c-- GCC backend interface stuff */
25 /* declare required prototypes: */
30 #include "coretypes.h"
32 #include "tree-gimple.h"
34 #include "langhooks.h"
35 #include "langhooks-def.h"
43 #include "diagnostic.h"
44 #include "tree-dump.h"
49 #include "trans-types.h"
50 #include "trans-const.h"
54 /* Language-dependent contents of an identifier. */
56 struct lang_identifier
59 struct tree_identifier common;
62 /* The resulting tree type. */
65 GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE")))
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; */
83 int returns_abnormally;
84 int warn_about_return_type;
86 struct binding_level *binding_level;
89 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
91 void yyerror (const char *str);
94 static void gfc_init_decl_processing (void);
95 static void gfc_init_builtin_functions (void);
97 /* Each front end provides its own. */
98 static bool gfc_init (void);
99 static void gfc_finish (void);
100 static void gfc_print_identifier (FILE *, tree, int);
101 static bool gfc_mark_addressable (tree);
102 void do_function_end (void);
103 int global_bindings_p (void);
104 void insert_block (tree);
105 static void gfc_clear_binding_stack (void);
106 static void gfc_be_parse_file (int);
107 static void gfc_expand_function (tree);
109 #undef LANG_HOOKS_NAME
110 #undef LANG_HOOKS_INIT
111 #undef LANG_HOOKS_FINISH
112 #undef LANG_HOOKS_INIT_OPTIONS
113 #undef LANG_HOOKS_HANDLE_OPTION
114 #undef LANG_HOOKS_POST_OPTIONS
115 #undef LANG_HOOKS_PRINT_IDENTIFIER
116 #undef LANG_HOOKS_PARSE_FILE
117 #undef LANG_HOOKS_TRUTHVALUE_CONVERSION
118 #undef LANG_HOOKS_MARK_ADDRESSABLE
119 #undef LANG_HOOKS_TYPE_FOR_MODE
120 #undef LANG_HOOKS_TYPE_FOR_SIZE
121 #undef LANG_HOOKS_UNSIGNED_TYPE
122 #undef LANG_HOOKS_SIGNED_TYPE
123 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
124 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
125 #undef LANG_HOOKS_CLEAR_BINDING_STACK
127 /* Define lang hooks. */
128 #define LANG_HOOKS_NAME "GNU F95"
129 #define LANG_HOOKS_INIT gfc_init
130 #define LANG_HOOKS_FINISH gfc_finish
131 #define LANG_HOOKS_INIT_OPTIONS gfc_init_options
132 #define LANG_HOOKS_HANDLE_OPTION gfc_handle_option
133 #define LANG_HOOKS_POST_OPTIONS gfc_post_options
134 #define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
135 #define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
136 #define LANG_HOOKS_TRUTHVALUE_CONVERSION gfc_truthvalue_conversion
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
146 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
148 /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
149 that have names. Here so we can clear out their names' definitions
150 at the end of the function. */
152 /* Tree code classes. */
154 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
156 const enum tree_code_class tree_code_type[] = {
161 /* Table indexed by tree code giving number of expression
162 operands beyond the fixed part of the node structure.
163 Not used for types or decls. */
165 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
167 const unsigned char tree_code_length[] = {
172 /* Names of tree components.
173 Used for printing out the tree and error messages. */
174 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
176 const char *const tree_code_name[] = {
181 static tree named_labels;
183 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
185 /* A chain of binding_level structures awaiting reuse. */
187 static GTY(()) struct binding_level *free_binding_level;
189 /* The elements of `ridpointers' are identifier nodes
190 for the reserved type names and storage classes.
191 It is indexed by a RID_... value. */
192 tree *ridpointers = NULL;
194 /* language-specific flags. */
197 gfc_expand_function (tree fndecl)
199 tree_rest_of_compilation (fndecl, 0);
203 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
204 or validate its data type for an `if' or `while' statement or ?..: exp.
206 This preparation consists of taking the ordinary
207 representation of an expression expr and producing a valid tree
208 boolean expression describing whether expr is nonzero. We could
209 simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
210 but we optimize comparisons, &&, ||, and !.
212 The resulting type should always be `boolean_type_node'.
213 This is much simpler than the corresponding C version because we have a
214 distinct boolean type. */
217 gfc_truthvalue_conversion (tree expr)
219 switch (TREE_CODE (TREE_TYPE (expr)))
222 if (TREE_TYPE (expr) == boolean_type_node)
224 else if (COMPARISON_CLASS_P (expr))
226 TREE_TYPE (expr) = boolean_type_node;
229 else if (TREE_CODE (expr) == NOP_EXPR)
230 return build1 (NOP_EXPR, boolean_type_node,
231 TREE_OPERAND (expr, 0));
233 return build1 (NOP_EXPR, boolean_type_node, expr);
236 if (TREE_CODE (expr) == INTEGER_CST)
237 return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
239 return build2 (NE_EXPR, boolean_type_node, expr, integer_zero_node);
242 internal_error ("Unexpected type in truthvalue_conversion");
247 gfc_create_decls (void)
250 gfc_init_builtin_functions ();
252 /* Runtime/IO library functions. */
253 gfc_build_builtin_function_decls ();
255 gfc_init_constants ();
259 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
266 gfc_generate_constructors ();
268 cgraph_finalize_compilation_unit ();
271 /* Tell the frontent about any errors. */
272 gfc_get_errors (&warnings, &errors);
273 errorcount += errors;
274 warningcount += warnings;
277 /* Initialize everything. */
282 #ifdef USE_MAPPED_LOCATION
283 linemap_add (&line_table, LC_ENTER, false, gfc_option.source, 1);
284 linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
287 /* First initialize the backend. */
288 gfc_init_decl_processing ();
289 gfc_static_ctors = NULL_TREE;
291 /* Then the frontend. */
294 if (gfc_new_file (gfc_option.source, gfc_option.source_form) != SUCCESS)
295 fatal_error ("can't open input file: %s", gfc_option.source);
304 gfc_release_include_path ();
309 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
310 tree node ATTRIBUTE_UNUSED,
311 int indent ATTRIBUTE_UNUSED)
317 /* These functions and variables deal with binding contours. We only
318 need these functions for the list of PARM_DECLs, but we leave the
319 functions more general; these are a simplified version of the
320 functions from GNAT. */
322 /* For each binding contour we allocate a binding_level structure which records
323 the entities defined or declared in that contour. Contours include:
326 one for each subprogram definition
327 one for each compound statement (declare block)
329 Binding contours are used to create GCC tree BLOCK nodes. */
334 /* A chain of ..._DECL nodes for all variables, constants, functions,
335 parameters and type declarations. These ..._DECL nodes are chained
336 through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
337 in the reverse of the order supplied to be compatible with the
340 /* For each level (except the global one), a chain of BLOCK nodes for all
341 the levels that were entered and exited one level down from this one. */
343 /* The binding level containing this one (the enclosing binding level). */
344 struct binding_level *level_chain;
347 /* The binding level currently in effect. */
348 static GTY(()) struct binding_level *current_binding_level = NULL;
350 /* The outermost binding level. This binding level is created when the
351 compiler is started and it will exist through the entire compilation. */
352 static GTY(()) struct binding_level *global_binding_level;
354 /* Binding level structures are initialized by copying this one. */
355 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
357 /* Return nonzero if we are currently in the global binding level. */
360 global_bindings_p (void)
362 return current_binding_level == global_binding_level ? -1 : 0;
368 return current_binding_level->names;
371 /* Enter a new binding level. The input parameter is ignored, but has to be
372 specified for back-end compatibility. */
375 pushlevel (int ignore ATTRIBUTE_UNUSED)
377 struct binding_level *newlevel
378 = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
380 *newlevel = clear_binding_level;
382 /* Add this level to the front of the chain (stack) of levels that are
384 newlevel->level_chain = current_binding_level;
385 current_binding_level = newlevel;
388 /* Exit a binding level.
389 Pop the level off, and restore the state of the identifier-decl mappings
390 that were in effect when this level was entered.
392 If KEEP is nonzero, this level had explicit declarations, so
393 and create a "block" (a BLOCK node) for the level
394 to record its declarations and subblocks for symbol table output.
396 If FUNCTIONBODY is nonzero, this level is the body of a function,
397 so create a block as if KEEP were set and also clear out all
400 If REVERSE is nonzero, reverse the order of decls before putting
401 them into the BLOCK. */
404 poplevel (int keep, int reverse, int functionbody)
406 /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
407 binding level that we are about to exit and which is returned by this
409 tree block_node = NULL_TREE;
411 tree subblock_chain = current_binding_level->blocks;
414 /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
415 nodes chained through the `names' field of current_binding_level are in
416 reverse order except for PARM_DECL node, which are explicitly stored in
418 decl_chain = (reverse) ? nreverse (current_binding_level->names)
419 : current_binding_level->names;
421 /* If there were any declarations in the current binding level, or if this
422 binding level is a function body, or if there are any nested blocks then
423 create a BLOCK node to record them for the life of this function. */
424 if (keep || functionbody)
425 block_node = build_block (keep ? decl_chain : 0, 0, subblock_chain, 0, 0);
427 /* Record the BLOCK node just built as the subblock its enclosing scope. */
428 for (subblock_node = subblock_chain; subblock_node;
429 subblock_node = TREE_CHAIN (subblock_node))
430 BLOCK_SUPERCONTEXT (subblock_node) = block_node;
432 /* Clear out the meanings of the local variables of this level. */
434 for (subblock_node = decl_chain; subblock_node;
435 subblock_node = TREE_CHAIN (subblock_node))
436 if (DECL_NAME (subblock_node) != 0)
437 /* If the identifier was used or addressed via a local extern decl,
438 don't forget that fact. */
439 if (DECL_EXTERNAL (subblock_node))
441 if (TREE_USED (subblock_node))
442 TREE_USED (DECL_NAME (subblock_node)) = 1;
443 if (TREE_ADDRESSABLE (subblock_node))
444 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
447 /* Pop the current level. */
448 current_binding_level = current_binding_level->level_chain;
452 /* This is the top level block of a function. The ..._DECL chain stored
453 in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
454 leave them in the BLOCK because they are found in the FUNCTION_DECL
456 DECL_INITIAL (current_function_decl) = block_node;
457 BLOCK_VARS (block_node) = 0;
461 current_binding_level->blocks
462 = chainon (current_binding_level->blocks, block_node);
465 /* If we did not make a block for the level just exited, any blocks made for
466 inner levels (since they cannot be recorded as subblocks in that level)
467 must be carried forward so they will later become subblocks of something
469 else if (subblock_chain)
470 current_binding_level->blocks
471 = chainon (current_binding_level->blocks, subblock_chain);
473 TREE_USED (block_node) = 1;
478 /* Insert BLOCK at the end of the list of subblocks of the
479 current binding level. This is used when a BIND_EXPR is expanded,
480 to handle the BLOCK node inside the BIND_EXPR. */
483 insert_block (tree block)
485 TREE_USED (block) = 1;
486 current_binding_level->blocks
487 = chainon (current_binding_level->blocks, block);
490 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
491 Returns the ..._DECL node. */
496 /* External objects aren't nested, other objects may be. */
497 if ((DECL_EXTERNAL (decl)) || (decl == current_function_decl))
498 DECL_CONTEXT (decl) = 0;
500 DECL_CONTEXT (decl) = current_function_decl;
502 /* Put the declaration on the list. The list of declarations is in reverse
503 order. The list will be reversed later if necessary. This needs to be
504 this way for compatibility with the back-end. */
506 TREE_CHAIN (decl) = current_binding_level->names;
507 current_binding_level->names = decl;
509 /* For the declartion of a type, set its name if it is not already set. */
511 if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
513 if (DECL_SOURCE_LINE (decl) == 0)
514 TYPE_NAME (TREE_TYPE (decl)) = decl;
516 TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
523 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
526 pushdecl_top_level (tree x)
529 struct binding_level *b = current_binding_level;
531 current_binding_level = global_binding_level;
533 current_binding_level = b;
538 /* Clear the binding stack. */
540 gfc_clear_binding_stack (void)
542 while (!global_bindings_p ())
547 #ifndef CHAR_TYPE_SIZE
548 #define CHAR_TYPE_SIZE BITS_PER_UNIT
551 #ifndef INT_TYPE_SIZE
552 #define INT_TYPE_SIZE BITS_PER_WORD
556 #define SIZE_TYPE "long unsigned int"
558 /* Create tree nodes for the basic scalar types of Fortran 95,
559 and some nodes representing standard constants (0, 1, (void *) 0).
560 Initialize the global binding level.
561 Make definitions for built-in primitive functions. */
563 gfc_init_decl_processing (void)
565 current_function_decl = NULL;
567 current_binding_level = NULL_BINDING_LEVEL;
568 free_binding_level = NULL_BINDING_LEVEL;
570 /* Make the binding_level structure for global names. We move all
571 variables that are in a COMMON block to this binding level. */
573 global_binding_level = current_binding_level;
575 /* Build common tree nodes. char_type_node is unsigned because we
576 only use it for actual characters, not for INTEGER(1). Also, we
577 want double_type_node to actually have double precision. */
578 build_common_tree_nodes (false, false);
579 set_sizetype (long_unsigned_type_node);
580 build_common_tree_nodes_2 (0);
582 /* Set up F95 type nodes. */
587 /* Mark EXP saying that we need to be able to take the
588 address of it; it should not be allocated in a register.
589 In Fortran 95 this is only the case for variables with
590 the TARGET attribute, but we implement it here for a
591 likely future Cray pointer extension.
592 Value is 1 if successful. */
593 /* TODO: Check/fix mark_addressable. */
595 gfc_mark_addressable (tree exp)
597 register tree x = exp;
599 switch (TREE_CODE (x))
606 x = TREE_OPERAND (x, 0);
610 TREE_ADDRESSABLE (x) = 1;
617 if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) && DECL_NONLOCAL (x))
622 ("global register variable `%s' used in nested function",
623 IDENTIFIER_POINTER (DECL_NAME (x)));
626 pedwarn ("register variable `%s' used in nested function",
627 IDENTIFIER_POINTER (DECL_NAME (x)));
629 else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
633 error ("address of global register variable `%s' requested",
634 IDENTIFIER_POINTER (DECL_NAME (x)));
639 /* If we are making this addressable due to its having
640 volatile components, give a different error message. Also
641 handle the case of an unnamed parameter by not trying
644 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x)))
646 error ("cannot put object with volatile field into register");
651 pedwarn ("address of register variable `%s' requested",
652 IDENTIFIER_POINTER (DECL_NAME (x)));
657 TREE_ADDRESSABLE (x) = 1;
664 /* press the big red button - garbage (ggc) collection is on */
668 /* Builtin function initialization. */
670 /* Return a definition for a builtin function named NAME and whose data type
671 is TYPE. TYPE should be a function type with argument types.
672 FUNCTION_CODE tells later passes how to compile calls to this function.
673 See tree.h for its possible values.
675 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
676 the name to be called if we can't opencode the function. If
677 ATTRS is nonzero, use that for the function's attribute list. */
680 builtin_function (const char *name,
683 enum built_in_class class,
684 const char *library_name,
685 tree attrs ATTRIBUTE_UNUSED)
687 tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
688 DECL_EXTERNAL (decl) = 1;
689 TREE_PUBLIC (decl) = 1;
691 SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
692 make_decl_rtl (decl);
694 DECL_BUILT_IN_CLASS (decl) = class;
695 DECL_FUNCTION_CODE (decl) = function_code;
701 gfc_define_builtin (const char * name,
704 const char * library_name,
709 decl = builtin_function (name, type, code, BUILT_IN_NORMAL,
710 library_name, NULL_TREE);
712 TREE_READONLY (decl) = 1;
714 built_in_decls[code] = decl;
715 implicit_built_in_decls[code] = decl;
719 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
720 gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
721 BUILT_IN_ ## code, name, true); \
722 gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
723 BUILT_IN_ ## code ## F, name "f", true);
725 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
726 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
728 /* The middle-end is missing builtins for some complex math functions, so
729 we don't use them yet. */
730 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
731 DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
732 /* DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/
735 /* Create function types for builtin functions. */
738 build_builtin_fntypes (tree * fntype, tree type)
742 /* type (*) (type) */
743 tmp = tree_cons (NULL_TREE, float_type_node, void_list_node);
744 fntype[0] = build_function_type (type, tmp);
745 /* type (*) (type, type) */
746 tmp = tree_cons (NULL_TREE, float_type_node, tmp);
747 fntype[1] = build_function_type (type, tmp);
748 /* type (*) (int, type) */
749 tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
750 tmp = tree_cons (NULL_TREE, type, tmp);
751 fntype[2] = build_function_type (type, tmp);
755 /* Initialization of builtin function nodes. */
758 gfc_init_builtin_functions (void)
761 tree mfunc_double[3];
762 tree mfunc_cfloat[3];
763 tree mfunc_cdouble[3];
764 tree func_cfloat_float;
765 tree func_cdouble_double;
769 build_builtin_fntypes (mfunc_float, float_type_node);
770 build_builtin_fntypes (mfunc_double, double_type_node);
771 build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
772 build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
774 tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
775 func_cfloat_float = build_function_type (float_type_node, tmp);
777 tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
778 func_cdouble_double = build_function_type (double_type_node, tmp);
780 #include "mathbuiltins.def"
782 /* We define these seperately as the fortran versions have different
783 semantics (they return an integer type) */
784 gfc_define_builtin ("__builtin_floor", mfunc_double[0],
785 BUILT_IN_FLOOR, "floor", true);
786 gfc_define_builtin ("__builtin_floorf", mfunc_float[0],
787 BUILT_IN_FLOORF, "floorf", true);
788 gfc_define_builtin ("__builtin_round", mfunc_double[0],
789 BUILT_IN_ROUND, "round", true);
790 gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
791 BUILT_IN_ROUNDF, "roundf", true);
793 gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
794 BUILT_IN_CABS, "cabs", true);
795 gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
796 BUILT_IN_CABSF, "cabsf", true);
799 gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
800 BUILT_IN_COPYSIGN, "copysign", true);
801 gfc_define_builtin ("__builtin_copysignf", mfunc_float[1],
802 BUILT_IN_COPYSIGNF, "copysignf", true);
804 /* These are used to implement the ** operator. */
805 gfc_define_builtin ("__builtin_pow", mfunc_double[1],
806 BUILT_IN_POW, "pow", true);
807 gfc_define_builtin ("__builtin_powf", mfunc_float[1],
808 BUILT_IN_POWF, "powf", true);
810 /* Other builtin functions we use. */
812 tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
813 tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
814 ftype = build_function_type (long_integer_type_node, tmp);
815 gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
816 "__builtin_expect", true);
818 tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
819 tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
820 tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
821 ftype = build_function_type (pvoid_type_node, tmp);
822 gfc_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
825 tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
826 ftype = build_function_type (integer_type_node, tmp);
827 gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
829 tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
830 ftype = build_function_type (integer_type_node, tmp);
831 gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, "clzl", true);
833 tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
834 ftype = build_function_type (integer_type_node, tmp);
835 gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, "clzll", true);
837 tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
838 tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
839 tmp = tree_cons (NULL_TREE, pvoid_type_node, tmp);
840 ftype = build_function_type (void_type_node, tmp);
841 gfc_define_builtin ("__builtin_init_trampoline", ftype,
842 BUILT_IN_INIT_TRAMPOLINE, "init_trampoline", false);
844 tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
845 ftype = build_function_type (pvoid_type_node, tmp);
846 gfc_define_builtin ("__builtin_adjust_trampoline", ftype,
847 BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true);
849 /* The stack_save, stack_restore, and alloca builtins aren't used directly.
850 They are inserted during gimplification to implement variable sized
853 ftype = build_function_type (pvoid_type_node, void_list_node);
854 gfc_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE,
855 "stack_save", false);
857 tmp = tree_cons (NULL_TREE, pvoid_type_node, void_list_node);
858 ftype = build_function_type (void_type_node, tmp);
859 gfc_define_builtin ("__builtin_stack_restore", ftype, BUILT_IN_STACK_RESTORE,
860 "stack_restore", false);
862 tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
863 ftype = build_function_type (pvoid_type_node, tmp);
864 gfc_define_builtin ("__builtin_alloca", ftype, BUILT_IN_ALLOCA,
868 #undef DEFINE_MATH_BUILTIN_C
869 #undef DEFINE_MATH_BUILTIN
871 #include "gt-fortran-f95-lang.h"
872 #include "gtype-fortran.h"