tree
build_capture_proxy (tree member)
{
tree var, object, fn, closure, name, lam, type;
if (PACK_EXPANSION_P (member))
member = PACK_EXPANSION_PATTERN (member);
closure = DECL_CONTEXT (member);
fn = lambda_function (closure);
lam = CLASSTYPE_LAMBDA_EXPR (closure);
/* The proxy variable forwards to the capture field. */
object = build_fold_indirect_ref (DECL_ARGUMENTS (fn));
object = finish_non_static_data_member (member, object, NULL_TREE);
if (REFERENCE_REF_P (object))
object = TREE_OPERAND (object, 0);
/* Remove the __ inserted by add_capture. */
if (DECL_NORMAL_CAPTURE_P (member))
name = get_identifier (IDENTIFIER_POINTER (DECL_NAME (member)) + 2);
else
name = DECL_NAME (member);
type = lambda_proxy_type (object);
if (DECL_VLA_CAPTURE_P (member))
{
/* Rebuild the VLA type from the pointer and maxindex. */
tree field = next_initializable_field (TYPE_FIELDS (type));
tree ptr = build_simple_component_ref (object, field);
field = next_initializable_field (DECL_CHAIN (field));
tree max = build_simple_component_ref (object, field);
type = build_array_type (TREE_TYPE (TREE_TYPE (ptr)),
build_index_type (max));
type = build_reference_type (type);
REFERENCE_VLA_OK (type) = true;
object = convert (type, ptr);
}
var = build_decl (input_location, VAR_DECL, name, type);
SET_DECL_VALUE_EXPR (var, object);
DECL_HAS_VALUE_EXPR_P (var) = 1;
DECL_ARTIFICIAL (var) = 1;
TREE_USED (var) = 1;
DECL_CONTEXT (var) = fn;
if (name == this_identifier)
{
gcc_assert (LAMBDA_EXPR_THIS_CAPTURE (lam) == member);
LAMBDA_EXPR_THIS_CAPTURE (lam) = var;
}
if (fn == current_function_decl)
insert_capture_proxy (var);
else
vec_safe_push (LAMBDA_EXPR_PENDING_PROXIES (lam), var);
return var;
}
static tree
build_equiv_decl (tree union_type, bool is_init)
{
tree decl;
char name[15];
static int serial = 0;
if (is_init)
{
decl = gfc_create_var (union_type, "equiv");
TREE_STATIC (decl) = 1;
return decl;
}
snprintf (name, sizeof (name), "equiv.%d", serial++);
decl = build_decl (VAR_DECL, get_identifier (name), union_type);
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)))
TREE_STATIC (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
TREE_USED (decl) = 1;
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
gfc_set_decl_location (decl, &gfc_current_locus);
gfc_add_decl_to_function (decl);
return decl;
}
static void
build_field (segment_info *h, tree union_type, record_layout_info rli)
{
tree field;
tree name;
HOST_WIDE_INT offset = h->offset;
unsigned HOST_WIDE_INT desired_align, known_align;
name = get_identifier (h->sym->name);
field = build_decl (h->sym->declared_at.lb->location,
FIELD_DECL, name, h->field);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
known_align = BIGGEST_ALIGNMENT;
desired_align = update_alignment_for_field (rli, field, known_align);
if (desired_align > known_align)
DECL_PACKED (field) = 1;
DECL_FIELD_CONTEXT (field) = union_type;
DECL_FIELD_OFFSET (field) = size_int (offset);
DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
SET_DECL_OFFSET_ALIGN (field, known_align);
rli->offset = size_binop (MAX_EXPR, rli->offset,
size_binop (PLUS_EXPR,
DECL_FIELD_OFFSET (field),
DECL_SIZE_UNIT (field)));
/* If this field is assigned to a label, we create another two variables.
One will hold the address of target label or format label. The other will
hold the length of format label string. */
if (h->sym->attr.assign)
{
tree len;
tree addr;
gfc_allocate_lang_decl (field);
GFC_DECL_ASSIGN (field) = 1;
len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name);
addr = gfc_create_var_np (pvoid_type_node, h->sym->name);
TREE_STATIC (len) = 1;
TREE_STATIC (addr) = 1;
DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2);
gfc_set_decl_location (len, &h->sym->declared_at);
gfc_set_decl_location (addr, &h->sym->declared_at);
GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len);
GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr);
}
/* If this field is volatile, mark it. */
if (h->sym->attr.volatile_)
{
tree new_type;
TREE_THIS_VOLATILE (field) = 1;
new_type = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE);
TREE_TYPE (field) = new_type;
}
h->field = field;
}
static tree
ubsan_source_location_type (void)
{
static const char *field_names[3]
= { "__filename", "__line", "__column" };
tree fields[3], ret;
tree const_char_type = build_qualified_type (char_type_node,
TYPE_QUAL_CONST);
ret = make_node (RECORD_TYPE);
for (int i = 0; i < 3; i++)
{
fields[i] = build_decl (UNKNOWN_LOCATION, FIELD_DECL,
get_identifier (field_names[i]),
(i == 0) ? build_pointer_type (const_char_type)
: unsigned_type_node);
DECL_CONTEXT (fields[i]) = ret;
if (i)
DECL_CHAIN (fields[i - 1]) = fields[i];
}
TYPE_FIELDS (ret) = fields[0];
TYPE_NAME (ret) = get_identifier ("__ubsan_source_location");
layout_type (ret);
return ret;
}
tree
make_alias_for (tree function, tree newid)
{
tree alias = build_decl (FUNCTION_DECL, newid, TREE_TYPE (function));
DECL_LANG_SPECIFIC (alias) = DECL_LANG_SPECIFIC (function);
cxx_dup_lang_specific_decl (alias);
DECL_CONTEXT (alias) = NULL;
TREE_READONLY (alias) = TREE_READONLY (function);
TREE_THIS_VOLATILE (alias) = TREE_THIS_VOLATILE (function);
TREE_PUBLIC (alias) = 0;
DECL_INTERFACE_KNOWN (alias) = 1;
DECL_NOT_REALLY_EXTERN (alias) = 1;
DECL_THIS_STATIC (alias) = 1;
DECL_SAVED_FUNCTION_DATA (alias) = NULL;
DECL_DESTRUCTOR_P (alias) = 0;
DECL_CONSTRUCTOR_P (alias) = 0;
DECL_CLONED_FUNCTION (alias) = NULL_TREE;
DECL_EXTERNAL (alias) = 0;
DECL_ARTIFICIAL (alias) = 1;
DECL_NO_STATIC_CHAIN (alias) = 1;
DECL_PENDING_INLINE_P (alias) = 0;
DECL_INLINE (alias) = 0;
DECL_DECLARED_INLINE_P (alias) = 0;
DECL_DEFERRED_FN (alias) = 0;
DECL_USE_TEMPLATE (alias) = 0;
DECL_TEMPLATE_INSTANTIATED (alias) = 0;
DECL_TEMPLATE_INFO (alias) = NULL;
DECL_INITIAL (alias) = error_mark_node;
TREE_ADDRESSABLE (alias) = 1;
TREE_USED (alias) = 1;
SET_DECL_ASSEMBLER_NAME (alias, DECL_NAME (alias));
TREE_SYMBOL_REFERENCED (DECL_ASSEMBLER_NAME (alias)) = 1;
return alias;
}
static tree
ubsan_type_descriptor_type (void)
{
static const char *field_names[3]
= { "__typekind", "__typeinfo", "__typename" };
tree fields[3], ret;
tree itype = build_range_type (sizetype, size_zero_node, NULL_TREE);
tree flex_arr_type = build_array_type (char_type_node, itype);
ret = make_node (RECORD_TYPE);
for (int i = 0; i < 3; i++)
{
fields[i] = build_decl (UNKNOWN_LOCATION, FIELD_DECL,
get_identifier (field_names[i]),
(i == 2) ? flex_arr_type
: short_unsigned_type_node);
DECL_CONTEXT (fields[i]) = ret;
if (i)
DECL_CHAIN (fields[i - 1]) = fields[i];
}
TYPE_FIELDS (ret) = fields[0];
TYPE_NAME (ret) = get_identifier ("__ubsan_type_descriptor");
layout_type (ret);
return ret;
}
static tree
build_equiv_decl (tree union_type, bool is_init)
{
tree decl;
if (is_init)
{
decl = gfc_create_var (union_type, "equiv");
TREE_STATIC (decl) = 1;
return decl;
}
decl = build_decl (VAR_DECL, NULL, union_type);
DECL_ARTIFICIAL (decl) = 1;
DECL_COMMON (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
TREE_USED (decl) = 1;
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
gfc_set_decl_location (decl, &gfc_current_locus);
gfc_add_decl_to_function (decl);
return decl;
}
static tree
make_fname_decl ()
{
const char *name = lang_hooks.decl_printable_name (current_function_decl, 0);
tree decl, type, init;
size_t length = strlen (name);
type = build_array_type (build_type_variant (char_type_node, true, false),
build_index_type (size_int (length)));
decl = build_decl (UNKNOWN_LOCATION, VAR_DECL,
get_identifier ("__function_name__"), type);
TREE_STATIC (decl) = 1;
TREE_READONLY (decl) = 1;
DECL_ARTIFICIAL (decl) = 1;
init = build_string (length + 1, name);
TREE_TYPE (init) = type;
TREE_READONLY (init) = 1;
DECL_READ_P (decl) = 1;
DECL_INITIAL (decl) = init;
TREE_USED (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
DECL_CONTEXT (decl) = current_function_decl;
return decl;
}
static void
build_field (segment_info *h, tree union_type, record_layout_info rli)
{
tree field;
tree name;
HOST_WIDE_INT offset = h->offset;
unsigned HOST_WIDE_INT desired_align, known_align;
name = get_identifier (h->sym->name);
field = build_decl (FIELD_DECL, name, h->field);
gfc_set_decl_location (field, &h->sym->declared_at);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
known_align = BIGGEST_ALIGNMENT;
desired_align = update_alignment_for_field (rli, field, known_align);
if (desired_align > known_align)
DECL_PACKED (field) = 1;
DECL_FIELD_CONTEXT (field) = union_type;
DECL_FIELD_OFFSET (field) = size_int (offset);
DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
SET_DECL_OFFSET_ALIGN (field, known_align);
rli->offset = size_binop (MAX_EXPR, rli->offset,
size_binop (PLUS_EXPR,
DECL_FIELD_OFFSET (field),
DECL_SIZE_UNIT (field)));
h->field = field;
}
static tree
create_struct_type(tree decl, size_t front_rz_size, size_t rear_rz_size)
{
// TODO make this dynamic rather than static
char type_name[50];
tree fieldfront, orig_var, fieldrear, struct_type;
gcc_assert(front_rz_size % 8 == 0 && rear_rz_size % 8 == 0);
struct_type = mf_mark(make_node (RECORD_TYPE));
// Build the front red zone
tree front_array_idx = build_index_type (size_int (front_rz_size / sizeof(unsigned int)));
tree front_rz_array = build_array_type (unsigned_type_node, front_array_idx);
fieldfront = build_decl (UNKNOWN_LOCATION,
FIELD_DECL, get_identifier ("rz_front"), front_rz_array);
DECL_ALIGN(fieldfront) = 8;
DECL_CONTEXT (fieldfront) = struct_type;
// orig variable
orig_var = build_decl (UNKNOWN_LOCATION,
FIELD_DECL, get_identifier("orig_var"), TREE_TYPE(decl));
DECL_CONTEXT (orig_var) = struct_type; // Look at comments above
DECL_CHAIN (fieldfront) = orig_var;
// Rear zone
if (COMPLETE_TYPE_P(decl)){
tree rear_array_idx = build_index_type (size_int (rear_rz_size / sizeof(unsigned int)));
tree rear_rz_array = build_array_type (unsigned_type_node, rear_array_idx);
fieldrear = build_decl (UNKNOWN_LOCATION,
FIELD_DECL, get_identifier ("rz_rear"), rear_rz_array);
DECL_ALIGN(fieldrear) = 8;
DECL_CONTEXT (fieldrear) = struct_type;
DECL_CHAIN (orig_var) = fieldrear;
}
TYPE_FIELDS (struct_type) = fieldfront;
strcpy(type_name, "rz_");
strcat(type_name, get_name(decl));
strcat(type_name, "_type");
TYPE_NAME (struct_type) = get_identifier (type_name);
layout_type (struct_type);
return struct_type;
}
static tree
add_field (const char *name, tree type, tree fields)
{
tree t = get_identifier (name);
tree field = build_decl (BUILTINS_LOCATION, FIELD_DECL, t, type);
TREE_CHAIN (field) = fields;
return field;
}
static tree
create_cilk_helper_decl (struct wrapper_data *wd)
{
char name[20];
if (wd->type == CILK_BLOCK_FOR)
sprintf (name, "_cilk_for_" HOST_WIDE_INT_PRINT_DEC, cilk_wrapper_count++);
else if (wd->type == CILK_BLOCK_SPAWN)
sprintf (name, "_cilk_spn_" HOST_WIDE_INT_PRINT_DEC, cilk_wrapper_count++);
else
gcc_unreachable ();
clean_symbol_name (name);
tree fndecl = build_decl (DECL_SOURCE_LOCATION (current_function_decl),
FUNCTION_DECL, get_identifier (name), wd->fntype);
TREE_PUBLIC (fndecl) = 0;
TREE_STATIC (fndecl) = 1;
TREE_USED (fndecl) = 1;
DECL_ARTIFICIAL (fndecl) = 0;
DECL_IGNORED_P (fndecl) = 0;
DECL_EXTERNAL (fndecl) = 0;
DECL_CONTEXT (fndecl) = wd->context;
tree block = make_node (BLOCK);
DECL_INITIAL (fndecl) = block;
TREE_USED (block) = 1;
BLOCK_SUPERCONTEXT (block) = fndecl;
gcc_assert (!DECL_SAVED_TREE (fndecl));
/* Inlining would defeat the purpose of this wrapper.
Either it secretly switches stack frames or it allocates
a stable stack frame to hold function arguments even if
the parent stack frame is stolen. */
DECL_UNINLINABLE (fndecl) = 1;
tree result_decl = build_decl (UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE,
void_type_node);
DECL_ARTIFICIAL (result_decl) = 0;
DECL_IGNORED_P (result_decl) = 1;
DECL_CONTEXT (result_decl) = fndecl;
DECL_RESULT (fndecl) = result_decl;
return fndecl;
}
/* Helper for mudflap_init: construct a decl with the given category,
name, and type, mark it an external reference, and pushdecl it. */
static inline tree
mf_make_builtin (enum tree_code category, const char *name, tree type)
{
tree decl = mf_mark (build_decl (category, get_identifier (name), type));
TREE_PUBLIC (decl) = 1;
DECL_EXTERNAL (decl) = 1;
lang_hooks.decls.pushdecl (decl);
return decl;
}
/* Helper for mudflap_init: construct a tree corresponding to the type
struct __mf_cache { uintptr_t low; uintptr_t high; };
where uintptr_t is the FIELD_TYPE argument. */
static inline tree
mf_make_mf_cache_struct_type (tree field_type)
{
/* There is, abominably, no language-independent way to construct a
RECORD_TYPE. So we have to call the basic type construction
primitives by hand. */
tree fieldlo = build_decl (FIELD_DECL, get_identifier ("low"), field_type);
tree fieldhi = build_decl (FIELD_DECL, get_identifier ("high"), field_type);
tree struct_type = make_node (RECORD_TYPE);
DECL_CONTEXT (fieldlo) = struct_type;
DECL_CONTEXT (fieldhi) = struct_type;
TREE_CHAIN (fieldlo) = fieldhi;
TYPE_FIELDS (struct_type) = fieldlo;
TYPE_NAME (struct_type) = get_identifier ("__mf_cache");
layout_type (struct_type);
return struct_type;
}
static void start_unit_callback (void *gcc_data, void *user_data)
{
if (integer_type_node) {
fake_var = build_decl (VAR_DECL,
get_identifier ("_fake_var_"),
integer_type_node);
TREE_PUBLIC (fake_var) = 1;
DECL_ARTIFICIAL (fake_var) = 1;
}
}
/* Add code:
__thread gcov* __gcov_indirect_call_counters; // pointer to actual counter
__thread void* __gcov_indirect_call_callee; // actual callee address
__thread int __gcov_function_counter; // time profiler function counter
*/
static void
init_ic_make_global_vars (void)
{
tree gcov_type_ptr;
ptr_void = build_pointer_type (void_type_node);
ic_void_ptr_var
= build_decl (UNKNOWN_LOCATION, VAR_DECL,
get_identifier (
(PARAM_VALUE (PARAM_INDIR_CALL_TOPN_PROFILE) ?
"__gcov_indirect_call_topn_callee" :
"__gcov_indirect_call_callee")),
ptr_void);
TREE_PUBLIC (ic_void_ptr_var) = 1;
DECL_EXTERNAL (ic_void_ptr_var) = 1;
TREE_STATIC (ic_void_ptr_var) = 1;
DECL_ARTIFICIAL (ic_void_ptr_var) = 1;
DECL_INITIAL (ic_void_ptr_var) = NULL;
if (targetm.have_tls)
set_decl_tls_model (ic_void_ptr_var, decl_default_tls_model (ic_void_ptr_var));
varpool_node::finalize_decl (ic_void_ptr_var);
gcov_type_ptr = build_pointer_type (get_gcov_type ());
ic_gcov_type_ptr_var
= build_decl (UNKNOWN_LOCATION, VAR_DECL,
get_identifier (
(PARAM_VALUE (PARAM_INDIR_CALL_TOPN_PROFILE) ?
"__gcov_indirect_call_topn_counters" :
"__gcov_indirect_call_counters")),
gcov_type_ptr);
TREE_PUBLIC (ic_gcov_type_ptr_var) = 1;
DECL_EXTERNAL (ic_gcov_type_ptr_var) = 1;
TREE_STATIC (ic_gcov_type_ptr_var) = 1;
DECL_ARTIFICIAL (ic_gcov_type_ptr_var) = 1;
DECL_INITIAL (ic_gcov_type_ptr_var) = NULL;
if (targetm.have_tls)
set_decl_tls_model (ic_gcov_type_ptr_var, decl_default_tls_model (ic_gcov_type_ptr_var));
varpool_node::finalize_decl (ic_gcov_type_ptr_var);
}
static tree
vla_capture_type (tree array_type)
{
static tree ptr_id, max_id;
tree type = xref_tag (record_type, make_anon_name (), ts_current, false);
xref_basetypes (type, NULL_TREE);
type = begin_class_definition (type);
if (!ptr_id)
{
ptr_id = get_identifier ("ptr");
max_id = get_identifier ("max");
}
tree ptrtype = build_pointer_type (TREE_TYPE (array_type));
tree field = build_decl (input_location, FIELD_DECL, ptr_id, ptrtype);
finish_member_declaration (field);
field = build_decl (input_location, FIELD_DECL, max_id, sizetype);
finish_member_declaration (field);
return finish_struct (type, NULL_TREE);
}
/* Add code:
static gcov* __gcov_indirect_call_counters; // pointer to actual counter
static void* __gcov_indirect_call_callee; // actual callee address
*/
static void
init_ic_make_global_vars (void)
{
tree gcov_type_ptr;
ptr_void = build_pointer_type (void_type_node);
ic_void_ptr_var
= build_decl (UNKNOWN_LOCATION, VAR_DECL,
get_identifier ("__gcov_indirect_call_callee"),
ptr_void);
TREE_STATIC (ic_void_ptr_var) = 1;
TREE_PUBLIC (ic_void_ptr_var) = 0;
DECL_ARTIFICIAL (ic_void_ptr_var) = 1;
DECL_INITIAL (ic_void_ptr_var) = NULL;
if (targetm.have_tls)
DECL_TLS_MODEL (ic_void_ptr_var) =
decl_default_tls_model (ic_void_ptr_var);
varpool_finalize_decl (ic_void_ptr_var);
varpool_mark_needed_node (varpool_node (ic_void_ptr_var));
gcov_type_ptr = build_pointer_type (get_gcov_type ());
ic_gcov_type_ptr_var
= build_decl (UNKNOWN_LOCATION, VAR_DECL,
get_identifier ("__gcov_indirect_call_counters"),
gcov_type_ptr);
TREE_STATIC (ic_gcov_type_ptr_var) = 1;
TREE_PUBLIC (ic_gcov_type_ptr_var) = 0;
DECL_ARTIFICIAL (ic_gcov_type_ptr_var) = 1;
DECL_INITIAL (ic_gcov_type_ptr_var) = NULL;
if (targetm.have_tls)
DECL_TLS_MODEL (ic_gcov_type_ptr_var) =
decl_default_tls_model (ic_gcov_type_ptr_var);
varpool_finalize_decl (ic_gcov_type_ptr_var);
varpool_mark_needed_node (varpool_node (ic_gcov_type_ptr_var));
}
/* Helper for mudflap_init: construct a decl with the given category,
name, and type, mark it an external reference, and pushdecl it. */
static inline tree
mf_make_builtin (enum tree_code category, const char *name, tree type)
{
tree decl = mf_mark (build_decl (UNKNOWN_LOCATION,
category, get_identifier (name), type));
TREE_PUBLIC (decl) = 1;
DECL_EXTERNAL (decl) = 1;
lang_hooks.decls.pushdecl (decl);
/* The decl was declared by the compiler. */
DECL_ARTIFICIAL (decl) = 1;
/* And we don't want debug info for it. */
DECL_IGNORED_P (decl) = 1;
return decl;
}
static void
push_eh_info ()
{
tree decl, fn = call_eh_info ();
/* Remember the pointer to the current exception info; it won't change
during this catch block. */
decl = build_decl (VAR_DECL, get_identifier ("__exception_info"),
TREE_TYPE (fn));
DECL_ARTIFICIAL (decl) = 1;
DECL_INITIAL (decl) = fn;
decl = pushdecl (decl);
cp_finish_decl (decl, fn, NULL_TREE, 0);
}
tree
start_var_decl (tree type, const char *name)
{
tree var = build_decl (input_location,
VAR_DECL, get_identifier (name), type);
TREE_STATIC (var) = 1;
DECL_INITIAL (var) = error_mark_node; /* A real initializer is coming... */
DECL_IGNORED_P (var) = 1;
DECL_ARTIFICIAL (var) = 1;
DECL_CONTEXT (var) = NULL_TREE;
#ifdef OBJCPLUS
DECL_THIS_STATIC (var) = 1; /* squash redeclaration errors */
#endif
return var;
}
static inline void
make_triplet_val_inv (location_t loc, tree *value)
{
tree var, new_exp;
if (TREE_CODE (*value) != INTEGER_CST
&& TREE_CODE (*value) != PARM_DECL
&& TREE_CODE (*value) != VAR_DECL)
{
var = build_decl (loc, VAR_DECL, NULL_TREE, integer_type_node);
new_exp = build_modify_expr (loc, var, TREE_TYPE (var), NOP_EXPR, loc,
*value, TREE_TYPE (*value));
add_stmt (new_exp);
*value = var;
}
}
void
gfc_generate_module_code (gfc_namespace * ns)
{
gfc_namespace *n;
struct module_htab_entry *entry;
gcc_assert (ns->proc_name->backend_decl == NULL);
ns->proc_name->backend_decl
= build_decl (ns->proc_name->declared_at.lb->location,
NAMESPACE_DECL, get_identifier (ns->proc_name->name),
void_type_node);
entry = gfc_find_module (ns->proc_name->name);
if (entry->namespace_decl)
/* Buggy sourcecode, using a module before defining it? */
htab_empty (entry->decls);
entry->namespace_decl = ns->proc_name->backend_decl;
gfc_generate_module_vars (ns);
/* We need to generate all module function prototypes first, to allow
sibling calls. */
for (n = ns->contained; n; n = n->sibling)
{
gfc_entry_list *el;
if (!n->proc_name)
continue;
gfc_create_function_decl (n);
gcc_assert (DECL_CONTEXT (n->proc_name->backend_decl) == NULL_TREE);
DECL_CONTEXT (n->proc_name->backend_decl) = ns->proc_name->backend_decl;
gfc_module_add_decl (entry, n->proc_name->backend_decl);
for (el = ns->entries; el; el = el->next)
{
gcc_assert (DECL_CONTEXT (el->sym->backend_decl) == NULL_TREE);
DECL_CONTEXT (el->sym->backend_decl) = ns->proc_name->backend_decl;
gfc_module_add_decl (entry, el->sym->backend_decl);
}
}
for (n = ns->contained; n; n = n->sibling)
{
if (!n->proc_name)
continue;
gfc_generate_function_code (n);
}
}
static tree
build_exception_object_var (void)
{
tree decl = DECL_FUNCTION_EXC_OBJ (current_function_decl);
if (decl == NULL)
{
decl = build_decl (DECL_SOURCE_LOCATION (current_function_decl),
VAR_DECL, get_identifier ("#exc_obj"), ptr_type_node);
DECL_IGNORED_P (decl) = 1;
DECL_ARTIFICIAL (decl) = 1;
DECL_FUNCTION_EXC_OBJ (current_function_decl) = decl;
pushdecl_function_level (decl);
}
return decl;
}
static tree build_junk_fn(unsigned id)
{
char fnname[32] = {0};
tree decl, resdecl, initial, proto;
/* Func decl */
snprintf(fnname, 31, "__func%d", id);
proto = build_varargs_function_type_list(void_type_node, NULL_TREE);
decl = build_fn_decl(fnname, proto);
SET_DECL_ASSEMBLER_NAME(decl, get_identifier(fnname));
printf(TAG "Creating junk function: %s\n", fnname);
/* Result */
resdecl=build_decl(BUILTINS_LOCATION,RESULT_DECL,NULL_TREE,void_type_node);
DECL_ARTIFICIAL(resdecl) = 1;
DECL_CONTEXT(resdecl) = decl;
DECL_RESULT(decl) = resdecl;
/* Initial */
initial = make_node(BLOCK);
TREE_USED(initial) = 1;
DECL_INITIAL(decl) = initial;
DECL_UNINLINABLE(decl) = 1;
DECL_EXTERNAL(decl) = 0;
DECL_PRESERVE_P(decl) = 1;
/* Func decl */
TREE_USED(decl) = 1;
TREE_PUBLIC(decl) = 1;
TREE_STATIC(decl) = 1;
DECL_ARTIFICIAL(decl) = 1;
/* Make the function */
push_struct_function(decl);
/* DECL_SAVED_TREE(decl) = gen_junk(); */
cfun->function_end_locus = BUILTINS_LOCATION;
gimplify_function_tree(decl);
/* Update */
cgraph_add_new_function(decl, false);
cgraph_mark_needed_node(cgraph_node(decl));
current_function_decl = NULL_TREE;
pop_cfun();
return decl;
}
static tree
make_alias_for_thunk (tree function)
{
tree alias;
char buf[256];
#if defined (TARGET_IS_PE_COFF)
if (DECL_ONE_ONLY (function))
return function;
#endif
ASM_GENERATE_INTERNAL_LABEL (buf, "LTHUNK", thunk_labelno);
thunk_labelno++;
alias = build_decl (FUNCTION_DECL, get_identifier (buf),
TREE_TYPE (function));
DECL_LANG_SPECIFIC (alias) = DECL_LANG_SPECIFIC (function);
cxx_dup_lang_specific_decl (alias);
DECL_CONTEXT (alias) = NULL;
TREE_READONLY (alias) = TREE_READONLY (function);
TREE_THIS_VOLATILE (alias) = TREE_THIS_VOLATILE (function);
TREE_PUBLIC (alias) = 0;
DECL_INTERFACE_KNOWN (alias) = 1;
DECL_NOT_REALLY_EXTERN (alias) = 1;
DECL_THIS_STATIC (alias) = 1;
DECL_SAVED_FUNCTION_DATA (alias) = NULL;
DECL_DESTRUCTOR_P (alias) = 0;
DECL_CONSTRUCTOR_P (alias) = 0;
DECL_CLONED_FUNCTION (alias) = NULL_TREE;
DECL_EXTERNAL (alias) = 0;
DECL_ARTIFICIAL (alias) = 1;
DECL_NO_STATIC_CHAIN (alias) = 1;
DECL_PENDING_INLINE_P (alias) = 0;
DECL_INLINE (alias) = 0;
DECL_DECLARED_INLINE_P (alias) = 0;
DECL_DEFERRED_FN (alias) = 0;
DECL_USE_TEMPLATE (alias) = 0;
DECL_TEMPLATE_INSTANTIATED (alias) = 0;
DECL_TEMPLATE_INFO (alias) = NULL;
DECL_INITIAL (alias) = error_mark_node;
TREE_ADDRESSABLE (alias) = 1;
TREE_USED (alias) = 1;
SET_DECL_ASSEMBLER_NAME (alias, DECL_NAME (alias));
TREE_SYMBOL_REFERENCED (DECL_ASSEMBLER_NAME (alias)) = 1;
if (!flag_syntax_only)
assemble_alias (alias, DECL_ASSEMBLER_NAME (function));
return alias;
}
tree
copy_var_decl (tree var, tree name, tree type)
{
tree copy = build_decl (DECL_SOURCE_LOCATION (var), VAR_DECL, name, type);
TREE_ADDRESSABLE (copy) = TREE_ADDRESSABLE (var);
TREE_THIS_VOLATILE (copy) = TREE_THIS_VOLATILE (var);
DECL_GIMPLE_REG_P (copy) = DECL_GIMPLE_REG_P (var);
DECL_ARTIFICIAL (copy) = DECL_ARTIFICIAL (var);
DECL_IGNORED_P (copy) = DECL_IGNORED_P (var);
DECL_CONTEXT (copy) = DECL_CONTEXT (var);
TREE_NO_WARNING (copy) = TREE_NO_WARNING (var);
TREE_USED (copy) = 1;
DECL_SEEN_IN_BIND_EXPR_P (copy) = 1;
DECL_ATTRIBUTES (copy) = DECL_ATTRIBUTES (var);
return copy;
}
void
compile_resource_data (const char *name, const char *buffer, int length)
{
tree rtype, field = NULL_TREE, data_type, rinit, data, decl;
char buf[60];
data_type = build_prim_array_type (unsigned_byte_type_node,
strlen (name) + length);
rtype = make_node (RECORD_TYPE);
PUSH_FIELD (rtype, field, "name_length", unsigned_int_type_node);
PUSH_FIELD (rtype, field, "resource_length", unsigned_int_type_node);
PUSH_FIELD (rtype, field, "data", data_type);
FINISH_RECORD (rtype);
START_RECORD_CONSTRUCTOR (rinit, rtype);
PUSH_FIELD_VALUE (rinit, "name_length",
build_int_cst (NULL_TREE, strlen (name)));
PUSH_FIELD_VALUE (rinit, "resource_length",
build_int_cst (NULL_TREE, length));
data = build_string (strlen(name) + length, buffer);
TREE_TYPE (data) = data_type;
PUSH_FIELD_VALUE (rinit, "data", data);
FINISH_RECORD_CONSTRUCTOR (rinit);
TREE_CONSTANT (rinit) = 1;
TREE_INVARIANT (rinit) = 1;
/* Generate a unique-enough identifier. */
sprintf (buf, "_Jr%d", ++Jr_count);
decl = build_decl (VAR_DECL, get_identifier (buf), rtype);
TREE_STATIC (decl) = 1;
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
TREE_READONLY (decl) = 1;
TREE_THIS_VOLATILE (decl) = 0;
DECL_INITIAL (decl) = rinit;
layout_decl (decl, 0);
pushdecl (decl);
rest_of_decl_compilation (decl, global_bindings_p (), 0);
make_decl_rtl (decl);
assemble_variable (decl, 1, 0, 0);
resources = tree_cons (NULL_TREE, decl, resources);
}
static tree
build_trivial_generic_function ()
{
auto_vec <tree> param_types;
tree fndecl = make_fndecl (integer_type_node,
"test_fn",
param_types);
ASSERT_TRUE (fndecl != NULL);
/* Populate the function. */
tree retval = build_decl (UNKNOWN_LOCATION, RESULT_DECL,
NULL_TREE, integer_type_node);
DECL_ARTIFICIAL (retval) = 1;
DECL_IGNORED_P (retval) = 1;
DECL_RESULT (fndecl) = retval;
/* Create a BIND_EXPR, and within it, a statement list. */
tree stmt_list = alloc_stmt_list ();
tree_stmt_iterator stmt_iter = tsi_start (stmt_list);
tree block = make_node (BLOCK);
tree bind_expr
= build3 (BIND_EXPR, void_type_node, NULL, stmt_list, block);
tree modify_retval = build2 (MODIFY_EXPR,
integer_type_node,
retval,
build_int_cst (integer_type_node, 42));
tree return_stmt = build1 (RETURN_EXPR,
integer_type_node,
modify_retval);
tsi_link_after (&stmt_iter, return_stmt, TSI_CONTINUE_LINKING);
DECL_INITIAL (fndecl) = block;
/* how to add to function? the following appears to be how to
set the body of a fndecl: */
DECL_SAVED_TREE(fndecl) = bind_expr;
/* Ensure that locals appear in the debuginfo. */
BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
return fndecl;
}
static void
build_function (tree fndecl, tree stmts, tree block)
{
DECL_INITIAL(fndecl) = block;
DECL_SAVED_TREE (fndecl) = stmts ;
tree resdecl = build_decl(input_location,RESULT_DECL, NULL_TREE, integer_type_node);
DECL_CONTEXT (resdecl) = fndecl;
DECL_RESULT(fndecl) = resdecl;
current_function_decl = fndecl;
if (DECL_STRUCT_FUNCTION(fndecl) == NULL)
push_struct_function(fndecl);
else
push_cfun(DECL_STRUCT_FUNCTION(fndecl));
cfun->function_end_locus = BUILTINS_LOCATION;
}
