1 /* G95 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"
55 /* Language-dependent contents of an identifier. */
57 struct lang_identifier
60 struct tree_identifier common
;
63 /* The resulting tree type. */
66 GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE")))
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; */
84 int returns_abnormally
;
85 int warn_about_return_type
;
87 struct binding_level
*binding_level
;
90 /* We don't have a lex/yacc lexer/parser, but toplev expects these to
92 void yyerror (const char *str
);
95 static void gfc_init_decl_processing (void);
96 static void gfc_init_builtin_functions (void);
98 /* Each front end provides its own. */
99 static bool gfc_init (void);
100 static void gfc_finish (void);
101 static void gfc_print_identifier (FILE *, tree
, int);
102 static bool gfc_mark_addressable (tree
);
103 void do_function_end (void);
104 int global_bindings_p (void);
105 void insert_block (tree
);
106 void set_block (tree
);
107 static void gfc_be_parse_file (int);
108 static void gfc_expand_function (tree
);
110 #undef LANG_HOOKS_NAME
111 #undef LANG_HOOKS_INIT
112 #undef LANG_HOOKS_FINISH
113 #undef LANG_HOOKS_INIT_OPTIONS
114 #undef LANG_HOOKS_HANDLE_OPTION
115 #undef LANG_HOOKS_POST_OPTIONS
116 #undef LANG_HOOKS_PRINT_IDENTIFIER
117 #undef LANG_HOOKS_PARSE_FILE
118 #undef LANG_HOOKS_TRUTHVALUE_CONVERSION
119 #undef LANG_HOOKS_MARK_ADDRESSABLE
120 #undef LANG_HOOKS_TYPE_FOR_MODE
121 #undef LANG_HOOKS_TYPE_FOR_SIZE
122 #undef LANG_HOOKS_UNSIGNED_TYPE
123 #undef LANG_HOOKS_SIGNED_TYPE
124 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
125 #undef LANG_HOOKS_GIMPLE_BEFORE_INLINING
126 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
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_TRUTHVALUE_CONVERSION gfc_truthvalue_conversion
138 #define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
139 #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
140 #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
141 #define LANG_HOOKS_UNSIGNED_TYPE gfc_unsigned_type
142 #define LANG_HOOKS_SIGNED_TYPE gfc_signed_type
143 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
144 #define LANG_HOOKS_GIMPLE_BEFORE_INLINING false
145 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
147 const struct lang_hooks lang_hooks
= LANG_HOOKS_INITIALIZER
;
149 /* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
150 that have names. Here so we can clear out their names' definitions
151 at the end of the function. */
153 /* Tree code classes. */
155 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
157 const char tree_code_type
[] = {
162 /* Table indexed by tree code giving number of expression
163 operands beyond the fixed part of the node structure.
164 Not used for types or decls. */
166 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
168 const unsigned char tree_code_length
[] = {
173 /* Names of tree components.
174 Used for printing out the tree and error messages. */
175 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
177 const char *const tree_code_name
[] = {
182 static tree named_labels
;
184 #define NULL_BINDING_LEVEL (struct binding_level *) NULL
186 /* A chain of binding_level structures awaiting reuse. */
188 static GTY(()) struct binding_level
*free_binding_level
;
190 /* The elements of `ridpointers' are identifier nodes
191 for the reserved type names and storage classes.
192 It is indexed by a RID_... value. */
193 tree
*ridpointers
= NULL
;
195 /* language-specific flags. */
198 gfc_expand_function (tree fndecl
)
200 tree_rest_of_compilation (fndecl
, 0);
204 /* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
205 or validate its data type for an `if' or `while' statement or ?..: exp.
207 This preparation consists of taking the ordinary
208 representation of an expression expr and producing a valid tree
209 boolean expression describing whether expr is nonzero. We could
210 simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
211 but we optimize comparisons, &&, ||, and !.
213 The resulting type should always be `boolean_type_node'.
214 This is much simpler than the corresponding C version because we have a
215 distinct boolean type. */
218 gfc_truthvalue_conversion (tree expr
)
220 switch (TREE_CODE (TREE_TYPE (expr
)))
223 if (TREE_TYPE (expr
) == boolean_type_node
)
225 else if (TREE_CODE_CLASS (TREE_CODE (expr
)) == '<')
227 TREE_TYPE (expr
) = boolean_type_node
;
230 else if (TREE_CODE (expr
) == NOP_EXPR
)
231 return build1 (NOP_EXPR
, boolean_type_node
,
232 TREE_OPERAND (expr
, 0));
234 return build1 (NOP_EXPR
, boolean_type_node
, expr
);
237 if (TREE_CODE (expr
) == INTEGER_CST
)
238 return integer_zerop (expr
) ? boolean_false_node
: boolean_true_node
;
240 return build (NE_EXPR
, boolean_type_node
, expr
, integer_zero_node
);
243 internal_error ("Unexpected type in truthvalue_conversion");
248 gfc_create_decls (void)
251 gfc_init_builtin_functions ();
253 /* Runtime/IO library functions. */
254 gfc_build_builtin_function_decls ();
256 gfc_init_constants ();
260 gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED
)
267 gfc_generate_constructors ();
269 cgraph_finalize_compilation_unit ();
272 /* Tell the frontent about any errors. */
273 gfc_get_errors (&warnings
, &errors
);
274 errorcount
+= errors
;
275 warningcount
+= warnings
;
278 /* Initialize everything. */
283 /* First initialize the backend. */
284 gfc_init_decl_processing ();
285 gfc_static_ctors
= NULL_TREE
;
287 /* Then the frontend. */
290 if (gfc_new_file (gfc_option
.source
, gfc_option
.source_form
) != SUCCESS
)
291 fatal_error ("can't open input file: %s", gfc_option
.source
);
300 gfc_release_include_path ();
305 gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED
,
306 tree node ATTRIBUTE_UNUSED
,
307 int indent ATTRIBUTE_UNUSED
)
313 /* These functions and variables deal with binding contours. We only
314 need these functions for the list of PARM_DECLs, but we leave the
315 functions more general; these are a simplified version of the
316 functions from GNAT. */
318 /* For each binding contour we allocate a binding_level structure which records
319 the entities defined or declared in that contour. Contours include:
322 one for each subprogram definition
323 one for each compound statement (declare block)
325 Binding contours are used to create GCC tree BLOCK nodes. */
330 /* A chain of ..._DECL nodes for all variables, constants, functions,
331 parameters and type declarations. These ..._DECL nodes are chained
332 through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
333 in the reverse of the order supplied to be compatible with the
336 /* For each level (except the global one), a chain of BLOCK nodes for all
337 the levels that were entered and exited one level down from this one. */
339 /* The back end may need, for its own internal processing, to create a BLOCK
340 node. This field is set aside for this purpose. If this field is non-null
341 when the level is popped, i.e. when poplevel is invoked, we will use such
342 block instead of creating a new one from the 'names' field, that is the
343 ..._DECL nodes accumulated so far. Typically the routine 'pushlevel'
344 will be called before setting this field, so that if the front-end had
345 inserted ..._DECL nodes in the current block they will not be lost. */
346 tree block_created_by_back_end
;
347 /* The binding level containing this one (the enclosing binding level). */
348 struct binding_level
*level_chain
;
351 /* The binding level currently in effect. */
352 static GTY(()) struct binding_level
*current_binding_level
= NULL
;
354 /* The outermost binding level. This binding level is created when the
355 compiler is started and it will exist through the entire compilation. */
356 static GTY(()) struct binding_level
*global_binding_level
;
358 /* Binding level structures are initialized by copying this one. */
359 static struct binding_level clear_binding_level
= { NULL
, NULL
, NULL
, NULL
};
361 /* Return non-zero if we are currently in the global binding level. */
364 global_bindings_p (void)
366 return current_binding_level
== global_binding_level
? -1 : 0;
372 return current_binding_level
->names
;
375 /* Enter a new binding level. The input parameter is ignored, but has to be
376 specified for back-end compatibility. */
379 pushlevel (int ignore ATTRIBUTE_UNUSED
)
381 struct binding_level
*newlevel
382 = (struct binding_level
*) ggc_alloc (sizeof (struct binding_level
));
384 *newlevel
= clear_binding_level
;
386 /* Add this level to the front of the chain (stack) of levels that are
388 newlevel
->level_chain
= current_binding_level
;
389 current_binding_level
= newlevel
;
392 /* Exit a binding level.
393 Pop the level off, and restore the state of the identifier-decl mappings
394 that were in effect when this level was entered.
396 If KEEP is nonzero, this level had explicit declarations, so
397 and create a "block" (a BLOCK node) for the level
398 to record its declarations and subblocks for symbol table output.
400 If FUNCTIONBODY is nonzero, this level is the body of a function,
401 so create a block as if KEEP were set and also clear out all
404 If REVERSE is nonzero, reverse the order of decls before putting
405 them into the BLOCK. */
408 poplevel (int keep
, int reverse
, int functionbody
)
410 /* Points to a BLOCK tree node. This is the BLOCK node construted for the
411 binding level that we are about to exit and which is returned by this
413 tree block_node
= NULL_TREE
;
415 tree subblock_chain
= current_binding_level
->blocks
;
417 tree block_created_by_back_end
;
419 /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
420 nodes chained through the `names' field of current_binding_level are in
421 reverse order except for PARM_DECL node, which are explicitely stored in
423 decl_chain
= (reverse
) ? nreverse (current_binding_level
->names
)
424 : current_binding_level
->names
;
426 block_created_by_back_end
=
427 current_binding_level
->block_created_by_back_end
;
428 if (block_created_by_back_end
!= 0)
430 block_node
= block_created_by_back_end
;
432 /* Check if we are about to discard some information that was gathered
433 by the front-end. Nameley check if the back-end created a new block
434 without calling pushlevel first. To understand why things are lost
435 just look at the next case (i.e. no block created by back-end. */
436 if ((keep
|| functionbody
) && (decl_chain
|| subblock_chain
))
440 /* If there were any declarations in the current binding level, or if this
441 binding level is a function body, or if there are any nested blocks then
442 create a BLOCK node to record them for the life of this function. */
443 else if (keep
|| functionbody
)
444 block_node
= build_block (keep
? decl_chain
: 0, 0, subblock_chain
, 0, 0);
446 /* Record the BLOCK node just built as the subblock its enclosing scope. */
447 for (subblock_node
= subblock_chain
; subblock_node
;
448 subblock_node
= TREE_CHAIN (subblock_node
))
449 BLOCK_SUPERCONTEXT (subblock_node
) = block_node
;
451 /* Clear out the meanings of the local variables of this level. */
453 for (subblock_node
= decl_chain
; subblock_node
;
454 subblock_node
= TREE_CHAIN (subblock_node
))
455 if (DECL_NAME (subblock_node
) != 0)
456 /* If the identifier was used or addressed via a local extern decl,
457 don't forget that fact. */
458 if (DECL_EXTERNAL (subblock_node
))
460 if (TREE_USED (subblock_node
))
461 TREE_USED (DECL_NAME (subblock_node
)) = 1;
462 if (TREE_ADDRESSABLE (subblock_node
))
463 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node
)) = 1;
466 /* Pop the current level. */
467 current_binding_level
= current_binding_level
->level_chain
;
471 /* This is the top level block of a function. The ..._DECL chain stored
472 in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
473 leave them in the BLOCK because they are found in the FUNCTION_DECL
475 DECL_INITIAL (current_function_decl
) = block_node
;
476 BLOCK_VARS (block_node
) = 0;
480 if (block_created_by_back_end
== NULL
)
481 current_binding_level
->blocks
482 = chainon (current_binding_level
->blocks
, block_node
);
485 /* If we did not make a block for the level just exited, any blocks made for
486 inner levels (since they cannot be recorded as subblocks in that level)
487 must be carried forward so they will later become subblocks of something
489 else if (subblock_chain
)
490 current_binding_level
->blocks
491 = chainon (current_binding_level
->blocks
, subblock_chain
);
493 TREE_USED (block_node
) = 1;
498 /* Insert BLOCK at the end of the list of subblocks of the
499 current binding level. This is used when a BIND_EXPR is expanded,
500 to handle the BLOCK node inside the BIND_EXPR. */
503 insert_block (tree block
)
505 TREE_USED (block
) = 1;
506 current_binding_level
->blocks
507 = chainon (current_binding_level
->blocks
, block
);
510 /* Set the BLOCK node for the innermost scope
511 (the one we are currently in). */
514 set_block (tree block
)
516 current_binding_level
->block_created_by_back_end
= block
;
519 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
520 Returns the ..._DECL node. */
525 /* External objects aren't nested, other objects may be. */
526 if ((DECL_EXTERNAL (decl
)) || (decl
== current_function_decl
))
527 DECL_CONTEXT (decl
) = 0;
529 DECL_CONTEXT (decl
) = current_function_decl
;
531 /* Put the declaration on the list. The list of declarations is in reverse
532 order. The list will be reversed later if necessary. This needs to be
533 this way for compatibility with the back-end. */
535 TREE_CHAIN (decl
) = current_binding_level
->names
;
536 current_binding_level
->names
= decl
;
538 /* For the declartion of a type, set its name if it is not already set. */
540 if (TREE_CODE (decl
) == TYPE_DECL
&& TYPE_NAME (TREE_TYPE (decl
)) == 0)
542 if (DECL_SOURCE_LINE (decl
) == 0)
543 TYPE_NAME (TREE_TYPE (decl
)) = decl
;
545 TYPE_NAME (TREE_TYPE (decl
)) = DECL_NAME (decl
);
552 /* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL. */
555 pushdecl_top_level (tree x
)
558 struct binding_level
*b
= current_binding_level
;
560 current_binding_level
= global_binding_level
;
562 current_binding_level
= b
;
567 #ifndef CHAR_TYPE_SIZE
568 #define CHAR_TYPE_SIZE BITS_PER_UNIT
571 #ifndef INT_TYPE_SIZE
572 #define INT_TYPE_SIZE BITS_PER_WORD
576 #define SIZE_TYPE "long unsigned int"
578 /* Create tree nodes for the basic scalar types of Fortran 95,
579 and some nodes representing standard constants (0, 1, (void *) 0).
580 Initialize the global binding level.
581 Make definitions for built-in primitive functions. */
583 gfc_init_decl_processing (void)
585 current_function_decl
= NULL
;
587 current_binding_level
= NULL_BINDING_LEVEL
;
588 free_binding_level
= NULL_BINDING_LEVEL
;
590 /* Make the binding_level structure for global names. We move all
591 variables that are in a COMMON block to this binding level. */
593 global_binding_level
= current_binding_level
;
595 /* Build common tree nodes. char_type_node is unsigned because we
596 only use it for actual characters, not for INTEGER(1). Also, we
597 want double_type_node to actually have double precision. */
598 build_common_tree_nodes (0);
599 set_sizetype (long_unsigned_type_node
);
600 build_common_tree_nodes_2 (0);
602 /* Set up F95 type nodes. */
606 /* Mark EXP saying that we need to be able to take the
607 address of it; it should not be allocated in a register.
608 In Fortran 95 this is only the case for variables with
609 the TARGET attribute, but we implement it here for a
610 likely future Cray pointer extension.
611 Value is 1 if successful. */
612 /* TODO: Check/fix mark_addressable. */
614 gfc_mark_addressable (tree exp
)
616 register tree x
= exp
;
618 switch (TREE_CODE (x
))
625 x
= TREE_OPERAND (x
, 0);
629 TREE_ADDRESSABLE (x
) = 1;
636 if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
) && DECL_NONLOCAL (x
))
641 ("global register variable `%s' used in nested function",
642 IDENTIFIER_POINTER (DECL_NAME (x
)));
645 pedwarn ("register variable `%s' used in nested function",
646 IDENTIFIER_POINTER (DECL_NAME (x
)));
648 else if (DECL_REGISTER (x
) && !TREE_ADDRESSABLE (x
))
652 error ("address of global register variable `%s' requested",
653 IDENTIFIER_POINTER (DECL_NAME (x
)));
658 /* If we are making this addressable due to its having
659 volatile components, give a different error message. Also
660 handle the case of an unnamed parameter by not trying
663 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x
)))
665 error ("cannot put object with volatile field into register");
670 pedwarn ("address of register variable `%s' requested",
671 IDENTIFIER_POINTER (DECL_NAME (x
)));
673 put_var_into_stack (x
, /*rescan=*/true);
677 TREE_ADDRESSABLE (x
) = 1;
684 /* press the big red button - garbage (ggc) collection is on */
688 /* Builtin function initialisation. */
690 /* Return a definition for a builtin function named NAME and whose data type
691 is TYPE. TYPE should be a function type with argument types.
692 FUNCTION_CODE tells later passes how to compile calls to this function.
693 See tree.h for its possible values.
695 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
696 the name to be called if we can't opencode the function. If
697 ATTRS is nonzero, use that for the function's attribute list. */
700 builtin_function (const char *name
,
703 enum built_in_class
class,
704 const char *library_name
,
705 tree attrs ATTRIBUTE_UNUSED
)
707 tree decl
= build_decl (FUNCTION_DECL
, get_identifier (name
), type
);
708 DECL_EXTERNAL (decl
) = 1;
709 TREE_PUBLIC (decl
) = 1;
711 SET_DECL_ASSEMBLER_NAME (decl
, get_identifier (library_name
));
712 make_decl_rtl (decl
, NULL
);
714 DECL_BUILT_IN_CLASS (decl
) = class;
715 DECL_FUNCTION_CODE (decl
) = function_code
;
721 gfc_define_builtin (const char * name
,
724 const char * library_name
,
729 decl
= builtin_function (name
, type
, code
, BUILT_IN_NORMAL
,
730 library_name
, NULL_TREE
);
732 TREE_READONLY (decl
) = 1;
734 built_in_decls
[code
] = decl
;
735 implicit_built_in_decls
[code
] = decl
;
739 #define DEFINE_MATH_BUILTIN(code, name, nargs) \
740 gfc_define_builtin ("__builtin_" name, mfunc_double[nargs-1], \
741 BUILT_IN_ ## code, name, true); \
742 gfc_define_builtin ("__builtin_" name "f", mfunc_float[nargs-1], \
743 BUILT_IN_ ## code ## F, name "f", true);
745 /* Initialisation of builtin function nodes. */
747 gfc_init_builtin_functions (void)
750 tree mfunc_double
[2];
755 voidchain
= tree_cons (NULL_TREE
, void_type_node
, NULL_TREE
);
757 tmp
= tree_cons (NULL_TREE
, float_type_node
, voidchain
);
758 mfunc_float
[0] = build_function_type (float_type_node
, tmp
);
759 tmp
= tree_cons (NULL_TREE
, float_type_node
, tmp
);
760 mfunc_float
[1] = build_function_type (float_type_node
, tmp
);
762 tmp
= tree_cons (NULL_TREE
, double_type_node
, voidchain
);
763 mfunc_double
[0] = build_function_type (double_type_node
, tmp
);
764 tmp
= tree_cons (NULL_TREE
, double_type_node
, tmp
);
765 mfunc_double
[1] = build_function_type (double_type_node
, tmp
);
767 #include "mathbuiltins.def"
769 /* We define these seperately as the fortran versions have different
770 semantics (they return an integer type) */
771 gfc_define_builtin ("__builtin_floor", mfunc_double
[0],
772 BUILT_IN_FLOOR
, "floor", true);
773 gfc_define_builtin ("__builtin_floorf", mfunc_float
[0],
774 BUILT_IN_FLOORF
, "floorf", true);
775 gfc_define_builtin ("__builtin_round", mfunc_double
[0],
776 BUILT_IN_ROUND
, "round", true);
777 gfc_define_builtin ("__builtin_roundf", mfunc_float
[0],
778 BUILT_IN_ROUNDF
, "roundf", true);
780 /* Other builtin functions we use. */
782 tmp
= tree_cons (NULL_TREE
, long_integer_type_node
, voidchain
);
783 tmp
= tree_cons (NULL_TREE
, long_integer_type_node
, tmp
);
784 ftype
= build_function_type (long_integer_type_node
, tmp
);
785 gfc_define_builtin ("__builtin_expect", ftype
, BUILT_IN_EXPECT
,
786 "__builtin_expect", true);
788 tmp
= tree_cons (NULL_TREE
, size_type_node
, voidchain
);
789 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, tmp
);
790 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, tmp
);
791 ftype
= build_function_type (pvoid_type_node
, tmp
);
792 gfc_define_builtin ("__builtin_memcpy", ftype
, BUILT_IN_MEMCPY
,
795 tmp
= tree_cons (NULL_TREE
, integer_type_node
, voidchain
);
796 ftype
= build_function_type (integer_type_node
, tmp
);
797 gfc_define_builtin ("__builtin_clz", ftype
, BUILT_IN_CLZ
, "clz", true);
799 tmp
= tree_cons (NULL_TREE
, long_integer_type_node
, voidchain
);
800 ftype
= build_function_type (integer_type_node
, tmp
);
801 gfc_define_builtin ("__builtin_clzl", ftype
, BUILT_IN_CLZL
, "clzl", true);
803 tmp
= tree_cons (NULL_TREE
, long_long_integer_type_node
, voidchain
);
804 ftype
= build_function_type (integer_type_node
, tmp
);
805 gfc_define_builtin ("__builtin_clzll", ftype
, BUILT_IN_CLZLL
, "clzll", true);
807 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, voidchain
);
808 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, tmp
);
809 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, tmp
);
810 ftype
= build_function_type (void_type_node
, tmp
);
811 gfc_define_builtin ("__builtin_init_trampoline", ftype
,
812 BUILT_IN_INIT_TRAMPOLINE
, "init_trampoline", false);
814 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, voidchain
);
815 ftype
= build_function_type (pvoid_type_node
, tmp
);
816 gfc_define_builtin ("__builtin_adjust_trampoline", ftype
,
817 BUILT_IN_ADJUST_TRAMPOLINE
, "adjust_trampoline", true);
819 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, voidchain
);
820 tmp
= tree_cons (NULL_TREE
, size_type_node
, voidchain
);
821 ftype
= build_function_type (pvoid_type_node
, tmp
);
822 gfc_define_builtin ("__builtin_stack_alloc", ftype
, BUILT_IN_STACK_ALLOC
,
823 "stack_alloc", false);
825 /* The stack_save and stack_restore builtins aren't used directly. They
826 are inserted during gimplification to implement stack_alloc calls. */
827 ftype
= build_function_type (pvoid_type_node
, voidchain
);
828 gfc_define_builtin ("__builtin_stack_save", ftype
, BUILT_IN_STACK_SAVE
,
829 "stack_save", false);
830 tmp
= tree_cons (NULL_TREE
, pvoid_type_node
, voidchain
);
831 ftype
= build_function_type (void_type_node
, tmp
);
832 gfc_define_builtin ("__builtin_stack_restore", ftype
, BUILT_IN_STACK_RESTORE
,
833 "stack_restore", false);
836 #undef DEFINE_MATH_BUILTIN
838 #include "gt-fortran-f95-lang.h"
839 #include "gtype-fortran.h"