+ gnu_result
+ = gnat_build_constructor (gnu_result_type, nreverse (gnu_list));
+ }
+ break;
+
+ case N_Pragma:
+ gnu_result = Pragma_to_gnu (gnat_node);
+ break;
+
+ /**************************************/
+ /* Chapter 3: Declarations and Types: */
+ /**************************************/
+
+ case N_Subtype_Declaration:
+ case N_Full_Type_Declaration:
+ case N_Incomplete_Type_Declaration:
+ case N_Private_Type_Declaration:
+ case N_Private_Extension_Declaration:
+ case N_Task_Type_Declaration:
+ process_type (Defining_Entity (gnat_node));
+ gnu_result = alloc_stmt_list ();
+ break;
+
+ case N_Object_Declaration:
+ case N_Exception_Declaration:
+ gnat_temp = Defining_Entity (gnat_node);
+ gnu_result = alloc_stmt_list ();
+
+ /* If we are just annotating types and this object has an unconstrained
+ or task type, don't elaborate it. */
+ if (type_annotate_only
+ && (((Is_Array_Type (Etype (gnat_temp))
+ || Is_Record_Type (Etype (gnat_temp)))
+ && !Is_Constrained (Etype (gnat_temp)))
+ || Is_Concurrent_Type (Etype (gnat_temp))))
+ break;
+
+ if (Present (Expression (gnat_node))
+ && !(Nkind (gnat_node) == N_Object_Declaration
+ && No_Initialization (gnat_node))
+ && (!type_annotate_only
+ || Compile_Time_Known_Value (Expression (gnat_node))))
+ {
+ gnu_expr = gnat_to_gnu (Expression (gnat_node));
+ if (Do_Range_Check (Expression (gnat_node)))
+ gnu_expr = emit_range_check (gnu_expr, Etype (gnat_temp));
+
+ /* If this object has its elaboration delayed, we must force
+ evaluation of GNU_EXPR right now and save it for when the object
+ is frozen. */
+ if (Present (Freeze_Node (gnat_temp)))
+ {
+ if ((Is_Public (gnat_temp) || global_bindings_p ())
+ && !TREE_CONSTANT (gnu_expr))
+ gnu_expr
+ = create_var_decl (create_concat_name (gnat_temp, "init"),
+ NULL_TREE, TREE_TYPE (gnu_expr),
+ gnu_expr, false, Is_Public (gnat_temp),
+ false, false, NULL, gnat_temp);
+ else
+ gnu_expr = maybe_variable (gnu_expr);
+
+ save_gnu_tree (gnat_node, gnu_expr, true);
+ }
+ }
+ else
+ gnu_expr = NULL_TREE;
+
+ if (type_annotate_only && gnu_expr && TREE_CODE (gnu_expr) == ERROR_MARK)
+ gnu_expr = NULL_TREE;
+
+ if (No (Freeze_Node (gnat_temp)))
+ gnat_to_gnu_entity (gnat_temp, gnu_expr, 1);
+ break;
+
+ case N_Object_Renaming_Declaration:
+ gnat_temp = Defining_Entity (gnat_node);
+
+ /* Don't do anything if this renaming is handled by the front end or if
+ we are just annotating types and this object has a composite or task
+ type, don't elaborate it. We return the result in case it has any
+ SAVE_EXPRs in it that need to be evaluated here. */
+ if (!Is_Renaming_Of_Object (gnat_temp)
+ && ! (type_annotate_only
+ && (Is_Array_Type (Etype (gnat_temp))
+ || Is_Record_Type (Etype (gnat_temp))
+ || Is_Concurrent_Type (Etype (gnat_temp)))))
+ gnu_result
+ = gnat_to_gnu_entity (gnat_temp,
+ gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
+ else
+ gnu_result = alloc_stmt_list ();
+ break;
+
+ case N_Implicit_Label_Declaration:
+ gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1);
+ gnu_result = alloc_stmt_list ();
+ break;
+
+ case N_Exception_Renaming_Declaration:
+ case N_Number_Declaration:
+ case N_Package_Renaming_Declaration:
+ case N_Subprogram_Renaming_Declaration:
+ /* These are fully handled in the front end. */
+ gnu_result = alloc_stmt_list ();
+ break;
+
+ /*************************************/
+ /* Chapter 4: Names and Expressions: */
+ /*************************************/
+
+ case N_Explicit_Dereference:
+ gnu_result = gnat_to_gnu (Prefix (gnat_node));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+ break;
+
+ case N_Indexed_Component:
+ {
+ tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node));
+ tree gnu_type;
+ int ndim;
+ int i;
+ Node_Id *gnat_expr_array;
+
+ gnu_array_object = maybe_implicit_deref (gnu_array_object);
+ gnu_array_object = maybe_unconstrained_array (gnu_array_object);
+
+ /* If we got a padded type, remove it too. */
+ if (TREE_CODE (TREE_TYPE (gnu_array_object)) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (TREE_TYPE (gnu_array_object)))
+ gnu_array_object
+ = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_array_object))),
+ gnu_array_object);
+
+ gnu_result = gnu_array_object;
+
+ /* First compute the number of dimensions of the array, then
+ fill the expression array, the order depending on whether
+ this is a Convention_Fortran array or not. */
+ for (ndim = 1, gnu_type = TREE_TYPE (gnu_array_object);
+ TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+ && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type));
+ ndim++, gnu_type = TREE_TYPE (gnu_type))
+ ;
+
+ gnat_expr_array = (Node_Id *) alloca (ndim * sizeof (Node_Id));
+
+ if (TYPE_CONVENTION_FORTRAN_P (TREE_TYPE (gnu_array_object)))
+ for (i = ndim - 1, gnat_temp = First (Expressions (gnat_node));
+ i >= 0;
+ i--, gnat_temp = Next (gnat_temp))
+ gnat_expr_array[i] = gnat_temp;
+ else
+ for (i = 0, gnat_temp = First (Expressions (gnat_node));
+ i < ndim;
+ i++, gnat_temp = Next (gnat_temp))
+ gnat_expr_array[i] = gnat_temp;
+
+ for (i = 0, gnu_type = TREE_TYPE (gnu_array_object);
+ i < ndim; i++, gnu_type = TREE_TYPE (gnu_type))
+ {
+ gcc_assert (TREE_CODE (gnu_type) == ARRAY_TYPE);
+ gnat_temp = gnat_expr_array[i];
+ gnu_expr = gnat_to_gnu (gnat_temp);
+
+ if (Do_Range_Check (gnat_temp))
+ gnu_expr
+ = emit_index_check
+ (gnu_array_object, gnu_expr,
+ TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
+ TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
+
+ gnu_result = build_binary_op (ARRAY_REF, NULL_TREE,
+ gnu_result, gnu_expr);
+ }
+ }
+
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ break;
+
+ case N_Slice:
+ {
+ tree gnu_type;
+ Node_Id gnat_range_node = Discrete_Range (gnat_node);
+
+ gnu_result = gnat_to_gnu (Prefix (gnat_node));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+ /* Do any implicit dereferences of the prefix and do any needed
+ range check. */
+ gnu_result = maybe_implicit_deref (gnu_result);
+ gnu_result = maybe_unconstrained_array (gnu_result);
+ gnu_type = TREE_TYPE (gnu_result);
+ if (Do_Range_Check (gnat_range_node))
+ {
+ /* Get the bounds of the slice. */
+ tree gnu_index_type
+ = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_result_type));
+ tree gnu_min_expr = TYPE_MIN_VALUE (gnu_index_type);
+ tree gnu_max_expr = TYPE_MAX_VALUE (gnu_index_type);
+ tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
+
+ /* Check to see that the minimum slice value is in range */
+ gnu_expr_l
+ = emit_index_check
+ (gnu_result, gnu_min_expr,
+ TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
+ TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
+
+ /* Check to see that the maximum slice value is in range */
+ gnu_expr_h
+ = emit_index_check
+ (gnu_result, gnu_max_expr,
+ TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
+ TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
+
+ /* Derive a good type to convert everything too */
+ gnu_expr_type = get_base_type (TREE_TYPE (gnu_expr_l));
+
+ /* Build a compound expression that does the range checks */
+ gnu_expr
+ = build_binary_op (COMPOUND_EXPR, gnu_expr_type,
+ convert (gnu_expr_type, gnu_expr_h),
+ convert (gnu_expr_type, gnu_expr_l));
+
+ /* Build a conditional expression that returns the range checks
+ expression if the slice range is not null (max >= min) or
+ returns the min if the slice range is null */
+ gnu_expr
+ = fold (build3 (COND_EXPR, gnu_expr_type,
+ build_binary_op (GE_EXPR, gnu_expr_type,
+ convert (gnu_expr_type,
+ gnu_max_expr),
+ convert (gnu_expr_type,
+ gnu_min_expr)),
+ gnu_expr, gnu_min_expr));
+ }
+ else
+ gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
+
+ gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
+ gnu_result, gnu_expr);
+ }
+ break;
+
+ case N_Selected_Component:
+ {
+ tree gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
+ Entity_Id gnat_field = Entity (Selector_Name (gnat_node));
+ Entity_Id gnat_pref_type = Etype (Prefix (gnat_node));
+ tree gnu_field;
+
+ while (IN (Ekind (gnat_pref_type), Incomplete_Or_Private_Kind)
+ || IN (Ekind (gnat_pref_type), Access_Kind))
+ {
+ if (IN (Ekind (gnat_pref_type), Incomplete_Or_Private_Kind))
+ gnat_pref_type = Underlying_Type (gnat_pref_type);
+ else if (IN (Ekind (gnat_pref_type), Access_Kind))
+ gnat_pref_type = Designated_Type (gnat_pref_type);
+ }
+
+ gnu_prefix = maybe_implicit_deref (gnu_prefix);
+
+ /* For discriminant references in tagged types always substitute the
+ corresponding discriminant as the actual selected component. */
+
+ if (Is_Tagged_Type (gnat_pref_type))
+ while (Present (Corresponding_Discriminant (gnat_field)))
+ gnat_field = Corresponding_Discriminant (gnat_field);
+
+ /* For discriminant references of untagged types always substitute the
+ corresponding stored discriminant. */
+
+ else if (Present (Corresponding_Discriminant (gnat_field)))
+ gnat_field = Original_Record_Component (gnat_field);
+
+ /* Handle extracting the real or imaginary part of a complex.
+ The real part is the first field and the imaginary the last. */
+
+ if (TREE_CODE (TREE_TYPE (gnu_prefix)) == COMPLEX_TYPE)
+ gnu_result = build_unary_op (Present (Next_Entity (gnat_field))
+ ? REALPART_EXPR : IMAGPART_EXPR,
+ NULL_TREE, gnu_prefix);
+ else
+ {
+ gnu_field = gnat_to_gnu_field_decl (gnat_field);
+
+ /* If there are discriminants, the prefix might be
+ evaluated more than once, which is a problem if it has
+ side-effects. */
+ if (Has_Discriminants (Is_Access_Type (Etype (Prefix (gnat_node)))
+ ? Designated_Type (Etype
+ (Prefix (gnat_node)))
+ : Etype (Prefix (gnat_node))))
+ gnu_prefix = gnat_stabilize_reference (gnu_prefix, 0);
+
+ gnu_result
+ = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
+ (Nkind (Parent (gnat_node))
+ == N_Attribute_Reference));
+ }
+
+ gcc_assert (gnu_result);
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ }
+ break;
+
+ case N_Attribute_Reference:
+ {
+ /* The attribute designator (like an enumeration value). */
+ int attribute = Get_Attribute_Id (Attribute_Name (gnat_node));
+
+ /* The Elab_Spec and Elab_Body attributes are special in that
+ Prefix is a unit, not an object with a GCC equivalent. Similarly
+ for Elaborated, since that variable isn't otherwise known. */
+ if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
+ return (create_subprog_decl
+ (create_concat_name (Entity (Prefix (gnat_node)),
+ attribute == Attr_Elab_Body
+ ? "elabb" : "elabs"),
+ NULL_TREE, void_ftype, NULL_TREE, false, true, true, NULL,
+ gnat_node));
+
+ gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attribute);
+ }
+ break;
+
+ case N_Reference:
+ /* Like 'Access as far as we are concerned. */
+ gnu_result = gnat_to_gnu (Prefix (gnat_node));
+ gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_result);
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ break;
+
+ case N_Aggregate:
+ case N_Extension_Aggregate:
+ {
+ tree gnu_aggr_type;
+
+ /* ??? It is wrong to evaluate the type now, but there doesn't
+ seem to be any other practical way of doing it. */
+
+ gcc_assert (!Expansion_Delayed (gnat_node));
+
+ gnu_aggr_type = gnu_result_type
+ = get_unpadded_type (Etype (gnat_node));
+
+ if (TREE_CODE (gnu_result_type) == RECORD_TYPE
+ && TYPE_CONTAINS_TEMPLATE_P (gnu_result_type))
+ gnu_aggr_type
+ = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_result_type)));
+
+ if (Null_Record_Present (gnat_node))
+ gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE);
+
+ else if (TREE_CODE (gnu_aggr_type) == UNION_TYPE
+ && TYPE_UNCHECKED_UNION_P (gnu_aggr_type))
+ {
+ /* The first element is the discrimant, which we ignore. The
+ next is the field we're building. Convert the expression
+ to the type of the field and then to the union type. */
+ Node_Id gnat_assoc
+ = Next (First (Component_Associations (gnat_node)));
+ Entity_Id gnat_field = Entity (First (Choices (gnat_assoc)));
+ tree gnu_field_type
+ = TREE_TYPE (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0));
+
+ gnu_result = convert (gnu_field_type,
+ gnat_to_gnu (Expression (gnat_assoc)));
+ }
+ else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
+ || TREE_CODE (gnu_aggr_type) == UNION_TYPE)
+ gnu_result
+ = assoc_to_constructor (First (Component_Associations (gnat_node)),
+ gnu_aggr_type);
+ else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
+ gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
+ gnu_aggr_type,
+ Component_Type (Etype (gnat_node)));
+ else if (TREE_CODE (gnu_aggr_type) == COMPLEX_TYPE)
+ gnu_result
+ = build_binary_op
+ (COMPLEX_EXPR, gnu_aggr_type,
+ gnat_to_gnu (Expression (First
+ (Component_Associations (gnat_node)))),
+ gnat_to_gnu (Expression
+ (Next
+ (First (Component_Associations (gnat_node))))));
+ else
+ gcc_unreachable ();
+
+ gnu_result = convert (gnu_result_type, gnu_result);
+ }
+ break;
+
+ case N_Null:
+ gnu_result = null_pointer_node;
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ break;
+
+ case N_Type_Conversion:
+ case N_Qualified_Expression:
+ /* Get the operand expression. */
+ gnu_result = gnat_to_gnu (Expression (gnat_node));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+ gnu_result
+ = convert_with_check (Etype (gnat_node), gnu_result,
+ Do_Overflow_Check (gnat_node),
+ Do_Range_Check (Expression (gnat_node)),
+ Nkind (gnat_node) == N_Type_Conversion
+ && Float_Truncate (gnat_node));
+ break;
+
+ case N_Unchecked_Type_Conversion:
+ gnu_result = gnat_to_gnu (Expression (gnat_node));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
+ /* If the result is a pointer type, see if we are improperly
+ converting to a stricter alignment. */
+
+ if (STRICT_ALIGNMENT && POINTER_TYPE_P (gnu_result_type)
+ && IN (Ekind (Etype (gnat_node)), Access_Kind))
+ {
+ unsigned int align = known_alignment (gnu_result);
+ tree gnu_obj_type = TREE_TYPE (gnu_result_type);
+ unsigned int oalign = TYPE_ALIGN (gnu_obj_type);
+
+ if (align != 0 && align < oalign && !TYPE_ALIGN_OK (gnu_obj_type))
+ post_error_ne_tree_2
+ ("?source alignment (^) < alignment of & (^)",
+ gnat_node, Designated_Type (Etype (gnat_node)),
+ size_int (align / BITS_PER_UNIT), oalign / BITS_PER_UNIT);
+ }
+
+ gnu_result = unchecked_convert (gnu_result_type, gnu_result,
+ No_Truncation (gnat_node));