+/* Return a FIELD_DECL node modeled on OLD_FIELD. FIELD_TYPE is its type
+ and RECORD_TYPE is the type of the parent. If SIZE is nonzero, it is the
+ specified size for this field. POS_LIST is a position list describing
+ the layout of OLD_FIELD and SUBST_LIST a substitution list to be applied
+ to this layout. */
+
+static tree
+create_field_decl_from (tree old_field, tree field_type, tree record_type,
+ tree size, tree pos_list, tree subst_list)
+{
+ tree t = TREE_VALUE (purpose_member (old_field, pos_list));
+ tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2);
+ unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1);
+ tree new_pos, new_field;
+
+ if (CONTAINS_PLACEHOLDER_P (pos))
+ for (t = subst_list; t; t = TREE_CHAIN (t))
+ pos = SUBSTITUTE_IN_EXPR (pos, TREE_PURPOSE (t), TREE_VALUE (t));
+
+ /* If the position is now a constant, we can set it as the position of the
+ field when we make it. Otherwise, we need to deal with it specially. */
+ if (TREE_CONSTANT (pos))
+ new_pos = bit_from_pos (pos, bitpos);
+ else
+ new_pos = NULL_TREE;
+
+ new_field
+ = create_field_decl (DECL_NAME (old_field), field_type, record_type,
+ DECL_PACKED (old_field), size, new_pos,
+ !DECL_NONADDRESSABLE_P (old_field));
+
+ if (!new_pos)
+ {
+ normalize_offset (&pos, &bitpos, offset_align);
+ DECL_FIELD_OFFSET (new_field) = pos;
+ DECL_FIELD_BIT_OFFSET (new_field) = bitpos;
+ SET_DECL_OFFSET_ALIGN (new_field, offset_align);
+ DECL_SIZE (new_field) = size;
+ DECL_SIZE_UNIT (new_field)
+ = convert (sizetype,
+ size_binop (CEIL_DIV_EXPR, size, bitsize_unit_node));
+ layout_decl (new_field, DECL_OFFSET_ALIGN (new_field));
+ }
+
+ DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
+ t = DECL_ORIGINAL_FIELD (old_field);
+ SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field);
+ DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field);
+ TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field);
+
+ return new_field;
+}
+
+/* Return the REP part of RECORD_TYPE, if any. Otherwise return NULL. */
+
+static tree
+get_rep_part (tree record_type)
+{
+ tree field = TYPE_FIELDS (record_type);
+
+ /* The REP part is the first field, internal, another record, and its name
+ doesn't start with an underscore (i.e. is not generated by the FE). */
+ if (DECL_INTERNAL_P (field)
+ && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
+ && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_')
+ return field;
+
+ return NULL_TREE;
+}
+
+/* Return the variant part of RECORD_TYPE, if any. Otherwise return NULL. */
+
+static tree
+get_variant_part (tree record_type)
+{
+ tree field;
+
+ /* The variant part is the only internal field that is a qualified union. */
+ for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field))
+ if (DECL_INTERNAL_P (field)
+ && TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE)
+ return field;
+
+ return NULL_TREE;
+}
+
+/* Return a new variant part modeled on OLD_VARIANT_PART. VARIANT_LIST is
+ the list of variants to be used and RECORD_TYPE is the type of the parent.
+ POS_LIST is a position list describing the layout of fields present in
+ OLD_VARIANT_PART and SUBST_LIST a substitution list to be applied to this
+ layout. */
+
+static tree
+create_variant_part_from (tree old_variant_part, tree variant_list,
+ tree record_type, tree pos_list, tree subst_list)
+{
+ tree offset = DECL_FIELD_OFFSET (old_variant_part);
+ tree bitpos = DECL_FIELD_BIT_OFFSET (old_variant_part);
+ tree old_union_type = TREE_TYPE (old_variant_part);
+ tree new_union_type, new_variant_part, t;
+ tree union_field_list = NULL_TREE;
+
+ /* First create the type of the variant part from that of the old one. */
+ new_union_type = make_node (QUAL_UNION_TYPE);
+ TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type));
+
+ /* If the position of the variant part is constant, subtract it from the
+ size of the type of the parent to get the new size. This manual CSE
+ reduces the code size when not optimizing. */
+ if (TREE_CODE (offset) == INTEGER_CST && TREE_CODE (bitpos) == INTEGER_CST)
+ {
+ tree first_bit = bit_from_pos (offset, bitpos);
+ TYPE_SIZE (new_union_type)
+ = size_binop (MINUS_EXPR, TYPE_SIZE (record_type), first_bit);
+ TYPE_SIZE_UNIT (new_union_type)
+ = size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (record_type),
+ byte_from_pos (offset, bitpos));
+ SET_TYPE_ADA_SIZE (new_union_type,
+ size_binop (MINUS_EXPR, TYPE_ADA_SIZE (record_type),
+ first_bit));
+ TYPE_ALIGN (new_union_type) = TYPE_ALIGN (old_union_type);
+ relate_alias_sets (new_union_type, old_union_type, ALIAS_SET_COPY);
+ }
+ else
+ copy_and_substitute_in_size (new_union_type, old_union_type, subst_list);
+
+ /* Now finish up the new variants and populate the union type. */
+ for (t = variant_list; t; t = TREE_CHAIN (t))
+ {
+ tree old_field = TREE_VEC_ELT (TREE_VALUE (t), 0), new_field;
+ tree old_variant, old_variant_subpart, new_variant, field_list;
+
+ /* Skip variants that don't belong to this nesting level. */
+ if (DECL_CONTEXT (old_field) != old_union_type)
+ continue;
+
+ /* Retrieve the list of fields already added to the new variant. */
+ new_variant = TREE_VEC_ELT (TREE_VALUE (t), 2);
+ field_list = TYPE_FIELDS (new_variant);
+
+ /* If the old variant had a variant subpart, we need to create a new
+ variant subpart and add it to the field list. */
+ old_variant = TREE_PURPOSE (t);
+ old_variant_subpart = get_variant_part (old_variant);
+ if (old_variant_subpart)
+ {
+ tree new_variant_subpart
+ = create_variant_part_from (old_variant_subpart, variant_list,
+ new_variant, pos_list, subst_list);
+ TREE_CHAIN (new_variant_subpart) = field_list;
+ field_list = new_variant_subpart;
+ }
+
+ /* Finish up the new variant and create the field. */
+ finish_record_type (new_variant, nreverse (field_list), 2, true);
+ compute_record_mode (new_variant);
+ rest_of_record_type_compilation (new_variant);
+
+ /* No need for debug info thanks to the XVS type. */
+ create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
+ true, false, Empty);
+
+ new_field
+ = create_field_decl_from (old_field, new_variant, new_union_type,
+ TYPE_SIZE (new_variant),
+ pos_list, subst_list);
+ DECL_QUALIFIER (new_field) = TREE_VEC_ELT (TREE_VALUE (t), 1);
+ DECL_INTERNAL_P (new_field) = 1;
+ TREE_CHAIN (new_field) = union_field_list;
+ union_field_list = new_field;
+ }
+
+ /* Finish up the union type and create the variant part. */
+ finish_record_type (new_union_type, union_field_list, 2, true);
+ compute_record_mode (new_union_type);
+ rest_of_record_type_compilation (new_union_type);
+
+ /* No need for debug info thanks to the XVS type. */
+ create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
+ true, false, Empty);
+
+ new_variant_part
+ = create_field_decl_from (old_variant_part, new_union_type, record_type,
+ TYPE_SIZE (new_union_type),
+ pos_list, subst_list);
+ DECL_INTERNAL_P (new_variant_part) = 1;
+
+ /* With multiple discriminants it is possible for an inner variant to be
+ statically selected while outer ones are not; in this case, the list
+ of fields of the inner variant is not flattened and we end up with a
+ qualified union with a single member. Drop the useless container. */
+ if (!TREE_CHAIN (union_field_list))
+ {
+ DECL_CONTEXT (union_field_list) = record_type;
+ DECL_FIELD_OFFSET (union_field_list)
+ = DECL_FIELD_OFFSET (new_variant_part);
+ DECL_FIELD_BIT_OFFSET (union_field_list)
+ = DECL_FIELD_BIT_OFFSET (new_variant_part);
+ SET_DECL_OFFSET_ALIGN (union_field_list,
+ DECL_OFFSET_ALIGN (new_variant_part));
+ new_variant_part = union_field_list;
+ }
+
+ return new_variant_part;
+}
+
+/* Copy the size (and alignment and alias set) from OLD_TYPE to NEW_TYPE,
+ which are both RECORD_TYPE, after applying the substitutions described
+ in SUBST_LIST. */
+
+static void
+copy_and_substitute_in_size (tree new_type, tree old_type, tree subst_list)
+{
+ tree t;
+
+ TYPE_SIZE (new_type) = TYPE_SIZE (old_type);
+ TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (old_type);
+ SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (old_type));
+ TYPE_ALIGN (new_type) = TYPE_ALIGN (old_type);
+ relate_alias_sets (new_type, old_type, ALIAS_SET_COPY);
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (new_type)))
+ for (t = subst_list; t; t = TREE_CHAIN (t))
+ TYPE_SIZE (new_type)
+ = SUBSTITUTE_IN_EXPR (TYPE_SIZE (new_type),
+ TREE_PURPOSE (t),
+ TREE_VALUE (t));
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (new_type)))
+ for (t = subst_list; t; t = TREE_CHAIN (t))
+ TYPE_SIZE_UNIT (new_type)
+ = SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (new_type),
+ TREE_PURPOSE (t),
+ TREE_VALUE (t));
+
+ if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (new_type)))
+ for (t = subst_list; t; t = TREE_CHAIN (t))
+ SET_TYPE_ADA_SIZE
+ (new_type, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (new_type),
+ TREE_PURPOSE (t),
+ TREE_VALUE (t)));
+
+ /* Finalize the size. */
+ TYPE_SIZE (new_type) = variable_size (TYPE_SIZE (new_type));
+ TYPE_SIZE_UNIT (new_type) = variable_size (TYPE_SIZE_UNIT (new_type));
+}
+\f
+/* Given a type T, a FIELD_DECL F, and a replacement value R, return a
+ type with all size expressions that contain F in a PLACEHOLDER_EXPR
+ updated by replacing F with R.
+
+ The function doesn't update the layout of the type, i.e. it assumes
+ that the substitution is purely formal. That's why the replacement
+ value R must itself contain a PLACEHOLDER_EXPR. */