CbC/CbC_gcc: gcc/ada/exp_attr.adb comparison

comparison gcc/ada/exp_attr.adb @ 145:1830386684a0

gcc-9.2.0

author	anatofuz
date	Thu, 13 Feb 2020 11:34:05 +0900
parents	84e7813d76e9
children

comparison

equal deleted inserted replaced

-:84e7813d76e9
+:1830386684a0
 --                                                                          --
 --                             E X P _ A T T R                              --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 with Exp_Imgv; use Exp_Imgv;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Strm; use Exp_Strm;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
+with Expander; use Expander;
 with Freeze;   use Freeze;
 with Gnatvsn;  use Gnatvsn;
 with Itypes;   use Itypes;
 with Lib;      use Lib;
 with Namet;    use Namet;
 --  Assume that none of the components and variants are eligible for
 --  verification.
 Stmts := No_List;
---  Validate componants
+--  Validate components
 Validate_Component_List
 (Obj_Id    => Obj_Id,
 Comp_List => Component_List (Var),
 Stmts     => Stmts);
 Func_Decl : Node_Id;
 Func_Id   : Entity_Id;
 Stmts     : List_Id;
 begin
+Func_Id := Make_Temporary (Loc, 'F');
 --  Wrap the condition of the while loop in a Boolean function.
 --  This avoids the duplication of the same code which may lead
 --  to gigi issues with respect to multiple declaration of the
 --  same entity in the presence of side effects or checks. Note
---  that the condition actions must also be relocated to the
+--  that the condition actions must also be relocated into the
---  wrapping function.
+--  wrapping function because they may contain itypes, e.g. in
+--  the case of a comparison involving slices.
 --  Generate:
 --    <condition actions>
 --    return <condition>;
 Stmts := New_List;
 end if;
 Append_To (Stmts,
 Make_Simple_Return_Statement (Loc,
-Expression => Relocate_Node (Condition (Scheme))));
+Expression =>
+New_Copy_Tree (Condition (Scheme),
+New_Scope => Func_Id)));
 --  Generate:
 --    function Fnn return Boolean is
 --    begin
 --       <Stmts>
 --    end Fnn;
-Func_Id   := Make_Temporary (Loc, 'F');
 Func_Decl :=
 Make_Subprogram_Body (Loc,
 Specification              =>
 Make_Function_Specification (Loc,
 Defining_Unit_Name => Func_Id,
 --  to analyze it in the context of the loop's enclosing scope.
 Push_Scope (Scope (Loop_Id));
 Insert_Action (Loop_Stmt, Func_Decl);
 Pop_Scope;
+--  The analysis of the condition may have generated itypes
+--  that are now used within the function: Adjust their
+--  scopes accordingly so that their use appears in their
+--  scope of definition.
+declare
+Ityp : Entity_Id;
+begin
+Ityp := First_Entity (Loop_Id);
+while Present (Ityp) loop
+if Is_Itype (Ityp) then
+Set_Scope (Ityp, Func_Id);
+end if;
+Next_Entity (Ityp);
+end loop;
+end;
 --  Transform the original while loop into an infinite loop
 --  where the last statement checks the negated condition. This
 --  placement ensures that the condition will not be evaluated
 --  twice on the first iteration.
 --  back end should not count on this). The one bit of special processing
 --  required in the normal case is that these two attributes typically
 --  generate conditionals in the code, so check the relevant restriction.
 Check_Restriction (No_Implicit_Conditionals, N);
---  In Modify_Tree_For_C mode, we rewrite as an if expression
-if Modify_Tree_For_C then
-declare
-Loc   : constant Source_Ptr := Sloc (N);
-Typ   : constant Entity_Id  := Etype (N);
-Expr  : constant Node_Id    := First (Expressions (N));
-Left  : constant Node_Id    := Relocate_Node (Expr);
-Right : constant Node_Id    := Relocate_Node (Next (Expr));
-function Make_Compare (Left, Right : Node_Id) return Node_Id;
---  Returns Left >= Right for Max, Left <= Right for Min
-------------------
--- Make_Compare --
-------------------
-function Make_Compare (Left, Right : Node_Id) return Node_Id is
-begin
-if Attribute_Name (N) = Name_Max then
-return
-Make_Op_Ge (Loc,
-Left_Opnd  => Left,
-Right_Opnd => Right);
-else
-return
-Make_Op_Le (Loc,
-Left_Opnd  => Left,
-Right_Opnd => Right);
-end if;
-end Make_Compare;
---  Start of processing for Min_Max
-begin
---  If both Left and Right are side effect free, then we can just
---  use Duplicate_Expr to duplicate the references and return
---    (if Left >=|<= Right then Left else Right)
-if Side_Effect_Free (Left) and then Side_Effect_Free (Right) then
-Rewrite (N,
-Make_If_Expression (Loc,
-Expressions => New_List (
-Make_Compare (Left, Right),
-Duplicate_Subexpr_No_Checks (Left),
-Duplicate_Subexpr_No_Checks (Right))));
---  Otherwise we generate declarations to capture the values.
---  The translation is
---    do
---      T1 : constant typ := Left;
---      T2 : constant typ := Right;
---    in
---      (if T1 >=|<= T2 then T1 else T2)
---    end;
-else
-declare
-T1 : constant Entity_Id := Make_Temporary (Loc, 'T', Left);
-T2 : constant Entity_Id := Make_Temporary (Loc, 'T', Right);
-begin
-Rewrite (N,
-Make_Expression_With_Actions (Loc,
-Actions    => New_List (
-Make_Object_Declaration (Loc,
-Defining_Identifier => T1,
-Constant_Present    => True,
-Object_Definition   =>
-New_Occurrence_Of (Etype (Left), Loc),
-Expression          => Relocate_Node (Left)),
-Make_Object_Declaration (Loc,
-Defining_Identifier => T2,
-Constant_Present    => True,
-Object_Definition   =>
-New_Occurrence_Of (Etype (Right), Loc),
-Expression          => Relocate_Node (Right))),
-Expression =>
-Make_If_Expression (Loc,
-Expressions => New_List (
-Make_Compare
-(New_Occurrence_Of (T1, Loc),
-New_Occurrence_Of (T2, Loc)),
-New_Occurrence_Of (T1, Loc),
-New_Occurrence_Of (T2, Loc)))));
-end;
-end if;
-Analyze_And_Resolve (N, Typ);
-end;
-end if;
 end Expand_Min_Max_Attribute;
 ----------------------------------
 -- Expand_N_Attribute_Reference --
 ----------------------------------
 -------------
 when Attribute_Address => Address : declare
 Task_Proc : Entity_Id;
+function Is_Unnested_Component_Init (N : Node_Id) return Boolean;
+--  Returns True if N is being used to initialize a component of
+--  an activation record object where the component corresponds to
+--  the object denoted by the prefix of the attribute N.
+function Is_Unnested_Component_Init (N : Node_Id) return Boolean is
+begin
+return Present (Parent (N))
+and then Nkind (Parent (N)) = N_Assignment_Statement
+and then Is_Entity_Name (Pref)
+and then Present (Activation_Record_Component (Entity (Pref)))
+and then Nkind (Name (Parent (N))) = N_Selected_Component
+and then Entity (Selector_Name (Name (Parent (N)))) =
+Activation_Record_Component (Entity (Pref));
+end Is_Unnested_Component_Init;
+--  Start of processing for Address
 begin
 --  If the prefix is a task or a task type, the useful address is that
 --  of the procedure for the task body, i.e. the actual program unit.
 --  We replace the original entity with that of the procedure.
 --  Ada 2005 (AI-251): Class-wide interface objects are always
 --  "displaced" to reference the tag associated with the interface
 --  type. In order to obtain the real address of such objects we
 --  generate a call to a run-time subprogram that returns the base
---  address of the object.
+--  address of the object. This call is not generated in cases where
+--  the attribute is being used to initialize a component of an
---  This processing is not needed in the VM case, where dispatching
+--  activation record object where the component corresponds to
---  issues are taken care of by the virtual machine.
+--  prefix of the attribute (for back ends that require "unnesting"
+--  of nested subprograms), since the address needs to be assigned
+--  as-is to such components.
 elsif Is_Class_Wide_Type (Ptyp)
 and then Is_Interface (Underlying_Type (Ptyp))
 and then Tagged_Type_Expansion
 and then not (Nkind (Pref) in N_Has_Entity
 and then Is_Subprogram (Entity (Pref)))
+and then not Is_Unnested_Component_Init (N)
 then
 Rewrite (N,
 Make_Function_Call (Loc,
 Name => New_Occurrence_Of (RTE (RE_Base_Address), Loc),
 Parameter_Associations => New_List (
 -----------------
 when Attribute_Constrained => Constrained : declare
 Formal_Ent : constant Entity_Id := Param_Entity (Pref);
-function Is_Constrained_Aliased_View (Obj : Node_Id) return Boolean;
---  Ada 2005 (AI-363): Returns True if the object name Obj denotes a
---  view of an aliased object whose subtype is constrained.
----------------------------------
--- Is_Constrained_Aliased_View --
----------------------------------
-function Is_Constrained_Aliased_View (Obj : Node_Id) return Boolean is
-E : Entity_Id;
-begin
-if Is_Entity_Name (Obj) then
-E := Entity (Obj);
-if Present (Renamed_Object (E)) then
-return Is_Constrained_Aliased_View (Renamed_Object (E));
-else
-return Is_Aliased (E) and then Is_Constrained (Etype (E));
-end if;
-else
-return Is_Aliased_View (Obj)
-and then
-(Is_Constrained (Etype (Obj))
-or else
-(Nkind (Obj) = N_Explicit_Dereference
-and then
-not Object_Type_Has_Constrained_Partial_View
-(Typ  => Base_Type (Etype (Obj)),
-Scop => Current_Scope)));
-end if;
-end Is_Constrained_Aliased_View;
 --  Start of processing for Constrained
 begin
 --  Reference to a parameter where the value is passed as an extra
 --  actual, corresponding to the extra formal referenced by the
 then
 Rewrite (N,
 New_Occurrence_Of
 (Extra_Constrained (Entity (Pref)), Sloc (N)));
---  For all other entity names, we can tell at compile time
+--  For all other cases, we can tell at compile time
-elsif Is_Entity_Name (Pref) then
-declare
-Ent : constant Entity_Id   := Entity (Pref);
-Res : Boolean;
-begin
---  (RM J.4) obsolescent cases
-if Is_Type (Ent) then
---  Private type
-if Is_Private_Type (Ent) then
-Res := not Has_Discriminants (Ent)
-or else Is_Constrained (Ent);
---  It not a private type, must be a generic actual type
---  that corresponded to a private type. We know that this
---  correspondence holds, since otherwise the reference
---  within the generic template would have been illegal.
-else
-if Is_Composite_Type (Underlying_Type (Ent)) then
-Res := Is_Constrained (Ent);
-else
-Res := True;
-end if;
-end if;
-else
---  For access type, apply access check as needed
-if Is_Access_Type (Ptyp) then
-Apply_Access_Check (N);
-end if;
---  If the prefix is not a variable or is aliased, then
---  definitely true; if it's a formal parameter without an
---  associated extra formal, then treat it as constrained.
---  Ada 2005 (AI-363): An aliased prefix must be known to be
---  constrained in order to set the attribute to True.
-if not Is_Variable (Pref)
-or else Present (Formal_Ent)
-or else (Ada_Version < Ada_2005
-and then Is_Aliased_View (Pref))
-or else (Ada_Version >= Ada_2005
-and then Is_Constrained_Aliased_View (Pref))
-then
-Res := True;
---  Variable case, look at type to see if it is constrained.
---  Note that the one case where this is not accurate (the
---  procedure formal case), has been handled above.
---  We use the Underlying_Type here (and below) in case the
---  type is private without discriminants, but the full type
---  has discriminants. This case is illegal, but we generate
---  it internally for passing to the Extra_Constrained
---  parameter.
-else
---  In Ada 2012, test for case of a limited tagged type,
---  in which case the attribute is always required to
---  return True. The underlying type is tested, to make
---  sure we also return True for cases where there is an
---  unconstrained object with an untagged limited partial
---  view which has defaulted discriminants (such objects
---  always produce a False in earlier versions of
---  Ada). (Ada 2012: AI05-0214)
-Res :=
-Is_Constrained (Underlying_Type (Etype (Ent)))
-or else
-(Ada_Version >= Ada_2012
-and then Is_Tagged_Type (Underlying_Type (Ptyp))
-and then Is_Limited_Type (Ptyp));
-end if;
-end if;
-Rewrite (N, New_Occurrence_Of (Boolean_Literals (Res), Loc));
-end;
---  Prefix is not an entity name. These are also cases where we can
---  always tell at compile time by looking at the form and type of the
---  prefix. If an explicit dereference of an object with constrained
---  partial view, this is unconstrained (Ada 2005: AI95-0363). If the
---  underlying type is a limited tagged type, then Constrained is
---  required to always return True (Ada 2012: AI05-0214).
 else
+--  For access type, apply access check as needed
+if Is_Entity_Name (Pref)
+and then not Is_Type (Entity (Pref))
+and then Is_Access_Type (Ptyp)
+then
+Apply_Access_Check (N);
+end if;
 Rewrite (N,
-New_Occurrence_Of (
+New_Occurrence_Of
-Boolean_Literals (
+(Boolean_Literals
-not Is_Variable (Pref)
+(Exp_Util.Attribute_Constrained_Static_Value
-or else
+(Pref)), Sloc (N)));
-(Nkind (Pref) = N_Explicit_Dereference
-and then
-not Object_Type_Has_Constrained_Partial_View
-(Typ  => Base_Type (Ptyp),
-Scop => Current_Scope))
-or else Is_Constrained (Underlying_Type (Ptyp))
-or else (Ada_Version >= Ada_2012
-and then Is_Tagged_Type (Underlying_Type (Ptyp))
-and then Is_Limited_Type (Ptyp))),
-Loc));
 end if;
 Analyze_And_Resolve (N, Standard_Boolean);
 end Constrained;
 --    [constraint_error when _rep_to_pos (Y, False) = -1, msg]
 --    X!(Y);
 Expr := Unchecked_Convert_To (Ptyp, First (Exprs));
+--  Ensure that the expression is not truncated since the "bad" bits
+--  are desired.
+if Nkind (Expr) = N_Unchecked_Type_Conversion then
+Set_No_Truncation (Expr);
+end if;
 Insert_Action (N,
 Make_Raise_Constraint_Error (Loc,
 Condition =>
 Make_Op_Eq (Loc,
 --------------------------------
 --  We transform
 --     fixtype'Fixed_Value (integer-value)
---     inttype'Fixed_Value (fixed-value)
+--     inttype'Integer_Value (fixed-value)
 --  into
 --     fixtype (integer-value)
 --     inttype (fixed-value)
 --  respectively.
---  We do all the required analysis of the conversion here, because we do
+--  We set Conversion_OK on the conversion because we do not want it
---  not want this to go through the fixed-point conversion circuits. Note
+--  to go through the fixed-point conversion circuits.
---  that the back end always treats fixed-point as equivalent to the
---  corresponding integer type anyway.
---  However, in order to remove the handling of Do_Range_Check from the
---  backend, we force the generation of a check on the result by
---  setting the result type appropriately. Apply_Conversion_Checks
---  will generate the required expansion.
 when Attribute_Fixed_Value
 | Attribute_Integer_Value
 =>
-Rewrite (N,
+Rewrite (N, OK_Convert_To (Entity (Pref), First (Exprs)));
-Make_Type_Conversion (Loc,
-Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc),
+--  Note that it might appear that a properly analyzed unchecked
-Expression   => Relocate_Node (First (Exprs))));
+--  conversion would be just fine here, but that's not the case,
+--  since the full range checks performed by the following calls
---  Indicate that the result of the conversion may require a
+--  are critical.
---  range check (see below);
+Apply_Type_Conversion_Checks (N);
-Set_Etype (N, Base_Type (Entity (Pref)));
+--  Note that Apply_Type_Conversion_Checks only deals with the
+--  overflow checks on conversions involving fixed-point types
+--  so we must apply range checks manually on them and expand.
+Apply_Scalar_Range_Check
+(Expression (N), Etype (N), Fixed_Int => True);
 Set_Analyzed (N);
+Expand (N);
---  Note: it might appear that a properly analyzed unchecked
---  conversion would be just fine here, but that's not the case,
---  since the full range checks performed by the following code
---  are critical.
---  Given that Fixed-point conversions are not further expanded
---  to prevent the involvement of real type operations we have to
---  construct two checks explicitly: one on the operand, and one
---  on the result. This used to be done in part in the back-end,
---  but for other targets (E.g. LLVM) it is preferable to create
---  the tests in full in the front-end.
-if Is_Fixed_Point_Type (Etype (N)) then
-declare
-Loc     : constant Source_Ptr := Sloc (N);
-Equiv_T : constant Entity_Id  := Make_Temporary (Loc, 'T', N);
-Expr    : constant Node_Id    := Expression (N);
-Fst     : constant Entity_Id  := Root_Type (Etype (N));
-Decl    : Node_Id;
-begin
-Decl :=
-Make_Full_Type_Declaration (Sloc (N),
-Defining_Identifier => Equiv_T,
-Type_Definition     =>
-Make_Signed_Integer_Type_Definition (Loc,
-Low_Bound  =>
-Make_Integer_Literal (Loc,
-Intval =>
-Corresponding_Integer_Value
-(Type_Low_Bound (Fst))),
-High_Bound =>
-Make_Integer_Literal (Loc,
-Intval =>
-Corresponding_Integer_Value
-(Type_High_Bound (Fst)))));
-Insert_Action (N, Decl);
---  Verify that the conversion is possible
-Generate_Range_Check (Expr, Equiv_T, CE_Overflow_Check_Failed);
---  and verify that the result is in range
-Generate_Range_Check (N, Etype (N), CE_Range_Check_Failed);
-end;
-end if;
 -----------
 -- Floor --
 -----------
 --  expands into
 --    Result_Type (System.Fore (Universal_Real (Type'First)),
 --                              Universal_Real (Type'Last))
---  Note that we know that the type is a non-static subtype, or Fore
+--  Note that we know that the type is a nonstatic subtype, or Fore would
---  would have itself been computed dynamically in Eval_Attribute.
+--  have itself been computed dynamically in Eval_Attribute.
 when Attribute_Fore =>
 Rewrite (N,
 Convert_To (Typ,
 Make_Function_Call (Loc,
 return;
 end if;
 declare
 Rtyp : constant Entity_Id := Root_Type (P_Type);
-Expr : Node_Id;
+Expr    : Node_Id; -- call to Descendant_Tag
+Get_Tag : Node_Id; -- expression to read the 'Tag
 begin
 --  Read the internal tag (RM 13.13.2(34)) and use it to
---  initialize a dummy tag value. We used to generate:
+--  initialize a dummy tag value. We used to unconditionally
+--  generate:
 --
 --     Descendant_Tag (String'Input (Strm), P_Type);
 --
 --  which turns into a call to String_Input_Blk_IO. However,
 --  if the input is malformed, that could try to read an
 --  enormous String, causing chaos. So instead we call
 --  String_Input_Tag, which does the same thing as
 --  String_Input_Blk_IO, except that if the String is
 --  absurdly long, it raises an exception.
 --
+--  However, if the No_Stream_Optimizations restriction
+--  is active, we disable this unnecessary attempt at
+--  robustness; we really need to read the string
+--  character-by-character.
+--
 --  This value is used only to provide a controlling
 --  argument for the eventual _Input call. Descendant_Tag is
 --  called rather than Internal_Tag to ensure that we have a
 --  tag for a type that is descended from the prefix type and
 --  declared at the same accessibility level (the exception
 --  Note: we used to generate an explicit declaration of a
 --  constant Ada.Tags.Tag object, and use an occurrence of
 --  this constant in Cntrl, but this caused a secondary stack
 --  leak.
+if Restriction_Active (No_Stream_Optimizations) then
+Get_Tag :=
+Make_Attribute_Reference (Loc,
+Prefix         =>
+New_Occurrence_Of (Standard_String, Loc),
+Attribute_Name => Name_Input,
+Expressions    => New_List (
+Relocate_Node (Duplicate_Subexpr (Strm))));
+else
+Get_Tag :=
+Make_Function_Call (Loc,
+Name                   =>
+New_Occurrence_Of
+(RTE (RE_String_Input_Tag), Loc),
+Parameter_Associations => New_List (
+Relocate_Node (Duplicate_Subexpr (Strm))));
+end if;
 Expr :=
 Make_Function_Call (Loc,
 Name                   =>
 New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc),
 Parameter_Associations => New_List (
-Make_Function_Call (Loc,
+Get_Tag,
-Name                   =>
-New_Occurrence_Of
-(RTE (RE_String_Input_Tag), Loc),
-Parameter_Associations => New_List (
-Relocate_Node (Duplicate_Subexpr (Strm)))),
 Make_Attribute_Reference (Loc,
 Prefix         => New_Occurrence_Of (P_Type, Loc),
 Attribute_Name => Name_Tag)));
 Set_Etype (Expr, RTE (RE_Tag));
 -- Invalid_Value --
 -------------------
 when Attribute_Invalid_Value =>
 Rewrite (N, Get_Simple_Init_Val (Ptyp, N));
+--  The value produced may be a conversion of a literal, which must be
+--  resolved to establish its proper type.
+Analyze_And_Resolve (N);
 ----------
 -- Last --
 ----------
 Right_Opnd =>
 Make_Integer_Literal (Loc, 1))),
 Rep_To_Pos_Flag (Ptyp, Loc))))));
 else
---  Add Boolean parameter True, to request program errror if
+--  Add Boolean parameter True, to request program error if
 --  we have a bad representation on our hands. If checks are
 --  suppressed, then add False instead
 Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
 Rewrite (N,
 else
 Apply_Universal_Integer_Attribute_Checks (N);
 end if;
+------------
+-- Reduce --
+------------
+when Attribute_Reduce =>
+declare
+Loc     : constant Source_Ptr := Sloc (N);
+E1      : constant Node_Id := First (Expressions (N));
+E2      : constant Node_Id := Next (E1);
+Bnn     : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+Typ     : constant Entity_Id := Etype (N);
+New_Loop : Node_Id;
+--  If the prefix is an aggregwte, its unique component is sn
+--  Iterated_Element, and we create a loop out of its itertor.
+begin
+if Nkind (Prefix (N)) = N_Aggregate then
+declare
+Stream  : constant Node_Id :=
+First (Component_Associations (Prefix (N)));
+Id      : constant Node_Id := Defining_Identifier (Stream);
+Expr    : constant Node_Id := Expression (Stream);
+Ch      : constant Node_Id :=
+First (Discrete_Choices (Stream));
+begin
+New_Loop := Make_Loop_Statement (Loc,
+Iteration_Scheme =>
+Make_Iteration_Scheme (Loc,
+Iterator_Specification => Empty,
+Loop_Parameter_Specification =>
+Make_Loop_Parameter_Specification  (Loc,
+Defining_Identifier => New_Copy (Id),
+Discrete_Subtype_Definition =>
+Relocate_Node (Ch))),
+End_Label => Empty,
+Statements => New_List (
+Make_Assignment_Statement (Loc,
+Name => New_Occurrence_Of (Bnn, Loc),
+Expression => Make_Function_Call (Loc,
+Name => New_Occurrence_Of (Entity (E1), Loc),
+Parameter_Associations => New_List (
+New_Occurrence_Of (Bnn, Loc),
+Relocate_Node (Expr))))));
+end;
+else
+--  If the prefix is a name we construct an element iterwtor
+--  over it. Its expansion will verify that it is an array
+--  or a container with the proper aspects.
+declare
+Iter : Node_Id;
+Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N);
+begin
+Iter :=
+Make_Iterator_Specification (Loc,
+Defining_Identifier => Elem,
+Name => Relocate_Node (Prefix (N)),
+Subtype_Indication => Empty);
+Set_Of_Present (Iter);
+New_Loop := Make_Loop_Statement (Loc,
+Iteration_Scheme =>
+Make_Iteration_Scheme (Loc,
+Iterator_Specification => Iter,
+Loop_Parameter_Specification => Empty),
+End_Label => Empty,
+Statements => New_List (
+Make_Assignment_Statement (Loc,
+Name => New_Occurrence_Of (Bnn, Loc),
+Expression => Make_Function_Call (Loc,
+Name => New_Occurrence_Of (Entity (E1), Loc),
+Parameter_Associations => New_List (
+New_Occurrence_Of (Bnn, Loc),
+New_Occurrence_Of (Elem, Loc))))));
+end;
+end if;
+Rewrite (N,
+Make_Expression_With_Actions (Loc,
+Actions    => New_List (
+Make_Object_Declaration (Loc,
+Defining_Identifier => Bnn,
+Object_Definition   =>
+New_Occurrence_Of (Typ, Loc),
+Expression => Relocate_Node (E2)), New_Loop),
+Expression => New_Occurrence_Of (Bnn, Loc)));
+Analyze_And_Resolve (N, Typ);
+end;
 ----------
 -- Read --
 ----------
 when Attribute_Read => Read : declare
 | Attribute_Size
 | Attribute_Value_Size
 | Attribute_VADS_Size
 =>
 Size : declare
-Siz      : Uint;
 New_Node : Node_Id;
 begin
 --  Processing for VADS_Size case. Note that this processing
 --  removes all traces of VADS_Size from the tree, and completes
 end if;
 Rewrite (N, New_Node);
 Analyze_And_Resolve (N, Typ);
 return;
---  Case of known RM_Size of a type
-elsif (Id = Attribute_Size or else Id = Attribute_Value_Size)
-and then Is_Entity_Name (Pref)
-and then Is_Type (Entity (Pref))
-and then Known_Static_RM_Size (Entity (Pref))
-then
-Siz := RM_Size (Entity (Pref));
---  Case of known Esize of a type
-elsif Id = Attribute_Object_Size
-and then Is_Entity_Name (Pref)
-and then Is_Type (Entity (Pref))
-and then Known_Static_Esize (Entity (Pref))
-then
-Siz := Esize (Entity (Pref));
---  Case of known size of object
-elsif Id = Attribute_Size
-and then Is_Entity_Name (Pref)
-and then Is_Object (Entity (Pref))
-and then Known_Esize (Entity (Pref))
-and then Known_Static_Esize (Entity (Pref))
-then
-Siz := Esize (Entity (Pref));
---  For an array component, we can do Size in the front end if the
---  component_size of the array is set.
-elsif Nkind (Pref) = N_Indexed_Component then
-Siz := Component_Size (Etype (Prefix (Pref)));
---  For a record component, we can do Size in the front end if
---  there is a component clause, or if the record is packed and the
---  component's size is known at compile time.
-elsif Nkind (Pref) = N_Selected_Component then
-declare
-Rec  : constant Entity_Id := Etype (Prefix (Pref));
-Comp : constant Entity_Id := Entity (Selector_Name (Pref));
-begin
-if Present (Component_Clause (Comp)) then
-Siz := Esize (Comp);
-elsif Is_Packed (Rec) then
-Siz := RM_Size (Ptyp);
-else
-Apply_Universal_Integer_Attribute_Checks (N);
-return;
-end if;
-end;
---  All other cases are handled by the back end
-else
-Apply_Universal_Integer_Attribute_Checks (N);
---  If Size is applied to a formal parameter that is of a packed
---  array subtype, then apply Size to the actual subtype.
-if Is_Entity_Name (Pref)
-and then Is_Formal (Entity (Pref))
-and then Is_Array_Type (Ptyp)
-and then Is_Packed (Ptyp)
-then
-Rewrite (N,
-Make_Attribute_Reference (Loc,
-Prefix         =>
-New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc),
-Attribute_Name => Name_Size));
-Analyze_And_Resolve (N, Typ);
-end if;
---  If Size applies to a dereference of an access to
---  unconstrained packed array, the back end needs to see its
---  unconstrained nominal type, but also a hint to the actual
---  constrained type.
-if Nkind (Pref) = N_Explicit_Dereference
-and then Is_Array_Type (Ptyp)
-and then not Is_Constrained (Ptyp)
-and then Is_Packed (Ptyp)
-then
-Set_Actual_Designated_Subtype (Pref,
-Get_Actual_Subtype (Pref));
-end if;
-return;
 end if;
---  Common processing for record and array component case
+--  Call Expand_Size_Attribute to do the final part of the
+--  expansion which is shared with GNATprove expansion.
-if Siz /= No_Uint and then Siz /= 0 then
-declare
+Expand_Size_Attribute (N);
-CS : constant Boolean := Comes_From_Source (N);
-begin
-Rewrite (N, Make_Integer_Literal (Loc, Siz));
---  This integer literal is not a static expression. We do
---  not call Analyze_And_Resolve here, because this would
---  activate the circuit for deciding that a static value
---  was out of range, and we don't want that.
---  So just manually set the type, mark the expression as
---  non-static, and then ensure that the result is checked
---  properly if the attribute comes from source (if it was
---  internally generated, we never need a constraint check).
-Set_Etype (N, Typ);
-Set_Is_Static_Expression (N, False);
-if CS then
-Apply_Constraint_Check (N, Typ);
-end if;
-end;
-end if;
 end Size;
 ------------------
 -- Storage_Pool --
 ------------------
 Relocate_Node (First (Exprs))),
 Right_Opnd =>
 Make_Integer_Literal (Loc, 1))),
 Rep_To_Pos_Flag (Ptyp, Loc))))));
 else
---  Add Boolean parameter True, to request program errror if
+--  Add Boolean parameter True, to request program error if
 --  we have a bad representation on our hands. Add False if
 --  checks are suppressed.
 Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
 Rewrite (N,
 ----------------
 -- To_Address --
 ----------------
 --  Transforms System'To_Address (X) and System.Address'Ref (X) into
---  unchecked conversion from (integral) type of X to type address.
+--  unchecked conversion from (integral) type of X to type address. If
+--  the To_Address is a static expression, the transformed expression
+--  also needs to be static, because we do some legality checks (e.g.
+--  for Thread_Local_Storage) after this transformation.
 when Attribute_Ref
 | Attribute_To_Address
 =>
-Rewrite (N,
+To_Address : declare
-Unchecked_Convert_To (RTE (RE_Address),
+Is_Static : constant Boolean := Is_Static_Expression (N);
-Relocate_Node (First (Exprs))));
-Analyze_And_Resolve (N, RTE (RE_Address));
+begin
+Rewrite (N,
+Unchecked_Convert_To (RTE (RE_Address),
+Relocate_Node (First (Exprs))));
+Set_Is_Static_Expression (N, Is_Static);
+Analyze_And_Resolve (N, RTE (RE_Address));
+end To_Address;
 ------------
 -- To_Any --
 ------------
 --  The code for valid is dependent on the particular types involved.
 --  See separate sections below for the generated code in each case.
 when Attribute_Valid => Valid : declare
-Btyp : Entity_Id := Base_Type (Ptyp);
+PBtyp : Entity_Id := Base_Type (Ptyp);
 Save_Validity_Checks_On : constant Boolean := Validity_Checks_On;
 --  Save the validity checking mode. We always turn off validity
 --  checking during process of 'Valid since this is one place
 --  where we do not want the implicit validity checks to interfere
 --  with the explicit validity check that the programmer is doing.
 function Make_Range_Test return Node_Id;
 --  Build the code for a range test of the form
---    Btyp!(Pref) in Btyp!(Ptyp'First) .. Btyp!(Ptyp'Last)
+--    PBtyp!(Pref) in PBtyp!(Ptyp'First) .. PBtyp!(Ptyp'Last)
 ---------------------
 -- Make_Range_Test --
 ---------------------
 Temp := Duplicate_Subexpr (Pref);
 end if;
 return
 Make_In (Loc,
-Left_Opnd  => Unchecked_Convert_To (Btyp, Temp),
+Left_Opnd  => Unchecked_Convert_To (PBtyp, Temp),
 Right_Opnd =>
 Make_Range (Loc,
 Low_Bound  =>
-Unchecked_Convert_To (Btyp,
+Unchecked_Convert_To (PBtyp,
 Make_Attribute_Reference (Loc,
 Prefix         => New_Occurrence_Of (Ptyp, Loc),
 Attribute_Name => Name_First)),
 High_Bound =>
-Unchecked_Convert_To (Btyp,
+Unchecked_Convert_To (PBtyp,
 Make_Attribute_Reference (Loc,
 Prefix         => New_Occurrence_Of (Ptyp, Loc),
 Attribute_Name => Name_Last))));
 end Make_Range_Test;
 Validity_Checks_On := False;
 --  Retrieve the base type. Handle the case where the base type is a
 --  private enumeration type.
-if Is_Private_Type (Btyp) and then Present (Full_View (Btyp)) then
+if Is_Private_Type (PBtyp) and then Present (Full_View (PBtyp)) then
-Btyp := Full_View (Btyp);
+PBtyp := Full_View (PBtyp);
 end if;
 --  Floating-point case. This case is handled by the Valid attribute
 --  code in the floating-point attribute run-time library.
 --  Start of processing for Float_Valid
 begin
 --  The C and AAMP back-ends handle Valid for fpt types
-if Modify_Tree_For_C or else Float_Rep (Btyp) = AAMP then
+if Modify_Tree_For_C or else Float_Rep (PBtyp) = AAMP then
 Analyze_And_Resolve (Pref, Ptyp);
 Set_Etype (N, Standard_Boolean);
 Set_Analyzed (N);
 else
 --  catches infinities properly (infinities are never valid).
 --  The way we do the range check is simply to create the
 --  expression: Valid (N) and then Base_Type(Pref) in Typ.
-if not Subtypes_Statically_Match (Ptyp, Btyp) then
+if not Subtypes_Statically_Match (Ptyp, PBtyp) then
 Rewrite (N,
 Make_And_Then (Loc,
 Left_Opnd  => Relocate_Node (N),
 Right_Opnd =>
 Make_In (Loc,
-Left_Opnd  => Convert_To (Btyp, Pref),
+Left_Opnd  => Convert_To (PBtyp, Pref),
 Right_Opnd => New_Occurrence_Of (Ptyp, Loc))));
 end if;
 end Float_Valid;
 --  Enumeration type with holes
 --    _rep_to_pos (X, False) >= 0
 --      and then
 --       (X >= type(X)'First and then type(X)'Last <= X)
 elsif Is_Enumeration_Type (Ptyp)
-and then Present (Enum_Pos_To_Rep (Btyp))
+and then Present (Enum_Pos_To_Rep (PBtyp))
 then
 Tst :=
 Make_Op_Ge (Loc,
 Left_Opnd =>
 Make_Function_Call (Loc,
 Name =>
-New_Occurrence_Of (TSS (Btyp, TSS_Rep_To_Pos), Loc),
+New_Occurrence_Of (TSS (PBtyp, TSS_Rep_To_Pos), Loc),
 Parameter_Associations => New_List (
 Pref,
 New_Occurrence_Of (Standard_False, Loc))),
 Right_Opnd => Make_Integer_Literal (Loc, 0));
-if Ptyp /= Btyp
+if Ptyp /= PBtyp
 and then
-(Type_Low_Bound (Ptyp) /= Type_Low_Bound (Btyp)
+(Type_Low_Bound (Ptyp) /= Type_Low_Bound (PBtyp)
 or else
-Type_High_Bound (Ptyp) /= Type_High_Bound (Btyp))
+Type_High_Bound (Ptyp) /= Type_High_Bound (PBtyp))
 then
 --  The call to Make_Range_Test will create declarations
 --  that need a proper insertion point, but Pref is now
 --  attached to a node with no ancestor. Attach to tree
 --  even if it is to be rewritten below.
 --  For biased representations, we will be doing an unchecked
 --  conversion without unbiasing the result. That means that the range
 --  test has to take this into account, and the proper form of the
 --  test is:
---    Btyp!(Pref) < Btyp!(Ptyp'Range_Length)
+--    PBtyp!(Pref) < PBtyp!(Ptyp'Range_Length)
 elsif Has_Biased_Representation (Ptyp) then
-Btyp := RTE (RE_Unsigned_32);
+PBtyp := RTE (RE_Unsigned_32);
 Rewrite (N,
 Make_Op_Lt (Loc,
 Left_Opnd =>
-Unchecked_Convert_To (Btyp, Duplicate_Subexpr (Pref)),
+Unchecked_Convert_To (PBtyp, Duplicate_Subexpr (Pref)),
 Right_Opnd =>
-Unchecked_Convert_To (Btyp,
+Unchecked_Convert_To (PBtyp,
 Make_Attribute_Reference (Loc,
 Prefix => New_Occurrence_Of (Ptyp, Loc),
 Attribute_Name => Name_Range_Length))));
 --  For all other scalar types, what we want logically is a
 --  But that's precisely what won't work because of possible
 --  unwanted optimization (and indeed the basic motivation for
 --  the Valid attribute is exactly that this test does not work).
 --  What will work is:
---     Btyp!(X) >= Btyp!(type(X)'First)
+--     PBtyp!(X) >= PBtyp!(type(X)'First)
 --       and then
---     Btyp!(X) <= Btyp!(type(X)'Last)
+--     PBtyp!(X) <= PBtyp!(type(X)'Last)
---  where Btyp is an integer type large enough to cover the full
+--  where PBtyp is an integer type large enough to cover the full
 --  range of possible stored values (i.e. it is chosen on the basis
 --  of the size of the type, not the range of the values). We write
 --  this as two tests, rather than a range check, so that static
 --  evaluation will easily remove either or both of the checks if
 --  they can be -statically determined to be true (this happens
 --  Now the base type is signed, but objects of this type are bits
 --  unsigned, and doing an unsigned test of the range 1 to 200 is
 --  correct, even though a value greater than 127 looks signed to a
 --  signed comparison.
-elsif Is_Unsigned_Type (Ptyp) then
+elsif Is_Unsigned_Type (Ptyp)
+or else (Is_Private_Type (Ptyp) and then Is_Unsigned_Type (Btyp))
+then
 if Esize (Ptyp) <= 32 then
-Btyp := RTE (RE_Unsigned_32);
+PBtyp := RTE (RE_Unsigned_32);
 else
-Btyp := RTE (RE_Unsigned_64);
+PBtyp := RTE (RE_Unsigned_64);
 end if;
 Rewrite (N, Make_Range_Test);
 --  Signed types
 else
 if Esize (Ptyp) <= Esize (Standard_Integer) then
-Btyp := Standard_Integer;
+PBtyp := Standard_Integer;
 else
-Btyp := Universal_Integer;
+PBtyp := Universal_Integer;
 end if;
 Rewrite (N, Make_Range_Test);
 end if;
 Attribute_Name => Cnam)),
 Reason => CE_Overflow_Check_Failed));
 end if;
 end Expand_Pred_Succ_Attribute;
+---------------------------
+-- Expand_Size_Attribute --
+---------------------------
+procedure Expand_Size_Attribute (N : Node_Id) is
+Loc   : constant Source_Ptr   := Sloc (N);
+Typ   : constant Entity_Id    := Etype (N);
+Pref  : constant Node_Id      := Prefix (N);
+Ptyp  : constant Entity_Id    := Etype (Pref);
+Id    : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
+Siz   : Uint;
+begin
+--  Case of known RM_Size of a type
+if (Id = Attribute_Size or else Id = Attribute_Value_Size)
+and then Is_Entity_Name (Pref)
+and then Is_Type (Entity (Pref))
+and then Known_Static_RM_Size (Entity (Pref))
+then
+Siz := RM_Size (Entity (Pref));
+--  Case of known Esize of a type
+elsif Id = Attribute_Object_Size
+and then Is_Entity_Name (Pref)
+and then Is_Type (Entity (Pref))
+and then Known_Static_Esize (Entity (Pref))
+then
+Siz := Esize (Entity (Pref));
+--  Case of known size of object
+elsif Id = Attribute_Size
+and then Is_Entity_Name (Pref)
+and then Is_Object (Entity (Pref))
+and then Known_Esize (Entity (Pref))
+and then Known_Static_Esize (Entity (Pref))
+then
+Siz := Esize (Entity (Pref));
+--  For an array component, we can do Size in the front end if the
+--  component_size of the array is set.
+elsif Nkind (Pref) = N_Indexed_Component then
+Siz := Component_Size (Etype (Prefix (Pref)));
+--  For a record component, we can do Size in the front end if there is a
+--  component clause, or if the record is packed and the component's size
+--  is known at compile time.
+elsif Nkind (Pref) = N_Selected_Component then
+declare
+Rec  : constant Entity_Id := Etype (Prefix (Pref));
+Comp : constant Entity_Id := Entity (Selector_Name (Pref));
+begin
+if Present (Component_Clause (Comp)) then
+Siz := Esize (Comp);
+elsif Is_Packed (Rec) then
+Siz := RM_Size (Ptyp);
+else
+Apply_Universal_Integer_Attribute_Checks (N);
+return;
+end if;
+end;
+--  All other cases are handled by the back end
+else
+--  If Size is applied to a formal parameter that is of a packed
+--  array subtype, then apply Size to the actual subtype.
+if Is_Entity_Name (Pref)
+and then Is_Formal (Entity (Pref))
+and then Is_Array_Type (Ptyp)
+and then Is_Packed (Ptyp)
+then
+Rewrite (N,
+Make_Attribute_Reference (Loc,
+Prefix         =>
+New_Occurrence_Of (Get_Actual_Subtype (Pref), Loc),
+Attribute_Name => Name_Size));
+Analyze_And_Resolve (N, Typ);
+--  If Size is applied to a dereference of an access to unconstrained
+--  packed array, the back end needs to see its unconstrained nominal
+--  type, but also a hint to the actual constrained type.
+elsif Nkind (Pref) = N_Explicit_Dereference
+and then Is_Array_Type (Ptyp)
+and then not Is_Constrained (Ptyp)
+and then Is_Packed (Ptyp)
+then
+Set_Actual_Designated_Subtype (Pref, Get_Actual_Subtype (Pref));
+--  If Size was applied to a slice of a bit-packed array, we rewrite
+--  it into the product of Length and Component_Size. We need to do so
+--  because bit-packed arrays are represented internally as arrays of
+--  System.Unsigned_Types.Packed_Byte for code generation purposes so
+--  the size is always rounded up in the back end.
+elsif Nkind (Pref) = N_Slice and then Is_Bit_Packed_Array (Ptyp) then
+Rewrite (N,
+Make_Op_Multiply (Loc,
+Make_Attribute_Reference (Loc,
+Prefix         => Duplicate_Subexpr (Pref, True),
+Attribute_Name => Name_Length),
+Make_Attribute_Reference (Loc,
+Prefix         => Duplicate_Subexpr (Pref, True),
+Attribute_Name => Name_Component_Size)));
+Analyze_And_Resolve (N, Typ);
+end if;
+--  Apply the required checks last, after rewriting has taken place
+Apply_Universal_Integer_Attribute_Checks (N);
+return;
+end if;
+--  Common processing for record and array component case
+if Siz /= No_Uint and then Siz /= 0 then
+declare
+CS : constant Boolean := Comes_From_Source (N);
+begin
+Rewrite (N, Make_Integer_Literal (Loc, Siz));
+--  This integer literal is not a static expression. We do not
+--  call Analyze_And_Resolve here, because this would activate
+--  the circuit for deciding that a static value was out of range,
+--  and we don't want that.
+--  So just manually set the type, mark the expression as
+--  nonstatic, and then ensure that the result is checked
+--  properly if the attribute comes from source (if it was
+--  internally generated, we never need a constraint check).
+Set_Etype (N, Typ);
+Set_Is_Static_Expression (N, False);
+if CS then
+Apply_Constraint_Check (N, Typ);
+end if;
+end;
+end if;
+end Expand_Size_Attribute;
 -----------------------------
 -- Expand_Update_Attribute --
 -----------------------------
 procedure Expand_Update_Attribute (N : Node_Id) is
 (Typ : Entity_Id;
 Nam : TSS_Name_Type) return Entity_Id
 is
 Base_Typ : constant Entity_Id := Base_Type (Typ);
 Ent      : constant Entity_Id := TSS (Typ, Nam);
-function Is_Available (Entity : RE_Id) return Boolean;
-pragma Inline (Is_Available);
---  Function to check whether the specified run-time call is available
---  in the run time used. In the case of a configurable run time, it
---  is normal that some subprograms are not there.
---
---  I don't understand this routine at all, why is this not just a
---  call to RTE_Available? And if for some reason we need a different
---  routine with different semantics, why is not in Rtsfind ???
-------------------
--- Is_Available --
-------------------
-function Is_Available (Entity : RE_Id) return Boolean is
-begin
---  Assume that the unit will always be available when using a
---  "normal" (not configurable) run time.
-return not Configurable_Run_Time_Mode or else RTE_Available (Entity);
-end Is_Available;
---  Start of processing for Find_Stream_Subprogram
 begin
 if Present (Ent) then
 return Ent;
 end if;
 --  Note: In the case of using a configurable run time, it is very likely
 --  that stream routines for string types are not present (they require
 --  file system support). In this case, the specific stream routines for
 --  strings are not used, relying on the regular stream mechanism
---  instead. That is why we include the test Is_Available when dealing
+--  instead. That is why we include the test RTE_Available when dealing
 --  with these cases.
 if not Is_Predefined_Unit (Current_Sem_Unit) then
 --  Storage_Array as defined in package System.Storage_Elements
 --  Case of No_Stream_Optimizations restriction active
 if Restriction_Active (No_Stream_Optimizations) then
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Storage_Array_Input)
+and then RTE_Available (RE_Storage_Array_Input)
 then
 return RTE (RE_Storage_Array_Input);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Storage_Array_Output)
+and then RTE_Available (RE_Storage_Array_Output)
 then
 return RTE (RE_Storage_Array_Output);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Storage_Array_Read)
+and then RTE_Available (RE_Storage_Array_Read)
 then
 return RTE (RE_Storage_Array_Read);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Storage_Array_Write)
+and then RTE_Available (RE_Storage_Array_Write)
 then
 return RTE (RE_Storage_Array_Write);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Restriction No_Stream_Optimizations is not set, so we can go
 --  ahead and optimize using the block IO forms of the routines.
 else
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Storage_Array_Input_Blk_IO)
+and then RTE_Available (RE_Storage_Array_Input_Blk_IO)
 then
 return RTE (RE_Storage_Array_Input_Blk_IO);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Storage_Array_Output_Blk_IO)
+and then RTE_Available (RE_Storage_Array_Output_Blk_IO)
 then
 return RTE (RE_Storage_Array_Output_Blk_IO);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Storage_Array_Read_Blk_IO)
+and then RTE_Available (RE_Storage_Array_Read_Blk_IO)
 then
 return RTE (RE_Storage_Array_Read_Blk_IO);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Storage_Array_Write_Blk_IO)
+and then RTE_Available (RE_Storage_Array_Write_Blk_IO)
 then
 return RTE (RE_Storage_Array_Write_Blk_IO);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Case of No_Stream_Optimizations restriction active
 if Restriction_Active (No_Stream_Optimizations) then
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Stream_Element_Array_Input)
+and then RTE_Available (RE_Stream_Element_Array_Input)
 then
 return RTE (RE_Stream_Element_Array_Input);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Stream_Element_Array_Output)
+and then RTE_Available (RE_Stream_Element_Array_Output)
 then
 return RTE (RE_Stream_Element_Array_Output);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Stream_Element_Array_Read)
+and then RTE_Available (RE_Stream_Element_Array_Read)
 then
 return RTE (RE_Stream_Element_Array_Read);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Stream_Element_Array_Write)
+and then RTE_Available (RE_Stream_Element_Array_Write)
 then
 return RTE (RE_Stream_Element_Array_Write);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Restriction No_Stream_Optimizations is not set, so we can go
 --  ahead and optimize using the block IO forms of the routines.
 else
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Stream_Element_Array_Input_Blk_IO)
+and then RTE_Available (RE_Stream_Element_Array_Input_Blk_IO)
 then
 return RTE (RE_Stream_Element_Array_Input_Blk_IO);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Stream_Element_Array_Output_Blk_IO)
+and then RTE_Available (RE_Stream_Element_Array_Output_Blk_IO)
 then
 return RTE (RE_Stream_Element_Array_Output_Blk_IO);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Stream_Element_Array_Read_Blk_IO)
+and then RTE_Available (RE_Stream_Element_Array_Read_Blk_IO)
 then
 return RTE (RE_Stream_Element_Array_Read_Blk_IO);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Stream_Element_Array_Write_Blk_IO)
+and then RTE_Available (RE_Stream_Element_Array_Write_Blk_IO)
 then
 return RTE (RE_Stream_Element_Array_Write_Blk_IO);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Case of No_Stream_Optimizations restriction active
 if Restriction_Active (No_Stream_Optimizations) then
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_String_Input)
+and then RTE_Available (RE_String_Input)
 then
 return RTE (RE_String_Input);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_String_Output)
+and then RTE_Available (RE_String_Output)
 then
 return RTE (RE_String_Output);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_String_Read)
+and then RTE_Available (RE_String_Read)
 then
 return RTE (RE_String_Read);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_String_Write)
+and then RTE_Available (RE_String_Write)
 then
 return RTE (RE_String_Write);
 elsif Nam /= TSS_Stream_Input and then
 Nam /= TSS_Stream_Output and then
 --  Restriction No_Stream_Optimizations is not set, so we can go
 --  ahead and optimize using the block IO forms of the routines.
 else
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_String_Input_Blk_IO)
+and then RTE_Available (RE_String_Input_Blk_IO)
 then
 return RTE (RE_String_Input_Blk_IO);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_String_Output_Blk_IO)
+and then RTE_Available (RE_String_Output_Blk_IO)
 then
 return RTE (RE_String_Output_Blk_IO);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_String_Read_Blk_IO)
+and then RTE_Available (RE_String_Read_Blk_IO)
 then
 return RTE (RE_String_Read_Blk_IO);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_String_Write_Blk_IO)
+and then RTE_Available (RE_String_Write_Blk_IO)
 then
 return RTE (RE_String_Write_Blk_IO);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Case of No_Stream_Optimizations restriction active
 if Restriction_Active (No_Stream_Optimizations) then
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Wide_String_Input)
+and then RTE_Available (RE_Wide_String_Input)
 then
 return RTE (RE_Wide_String_Input);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Wide_String_Output)
+and then RTE_Available (RE_Wide_String_Output)
 then
 return RTE (RE_Wide_String_Output);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Wide_String_Read)
+and then RTE_Available (RE_Wide_String_Read)
 then
 return RTE (RE_Wide_String_Read);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Wide_String_Write)
+and then RTE_Available (RE_Wide_String_Write)
 then
 return RTE (RE_Wide_String_Write);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Restriction No_Stream_Optimizations is not set, so we can go
 --  ahead and optimize using the block IO forms of the routines.
 else
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Wide_String_Input_Blk_IO)
+and then RTE_Available (RE_Wide_String_Input_Blk_IO)
 then
 return RTE (RE_Wide_String_Input_Blk_IO);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Wide_String_Output_Blk_IO)
+and then RTE_Available (RE_Wide_String_Output_Blk_IO)
 then
 return RTE (RE_Wide_String_Output_Blk_IO);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Wide_String_Read_Blk_IO)
+and then RTE_Available (RE_Wide_String_Read_Blk_IO)
 then
 return RTE (RE_Wide_String_Read_Blk_IO);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Wide_String_Write_Blk_IO)
+and then RTE_Available (RE_Wide_String_Write_Blk_IO)
 then
 return RTE (RE_Wide_String_Write_Blk_IO);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Case of No_Stream_Optimizations restriction active
 if Restriction_Active (No_Stream_Optimizations) then
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Wide_Wide_String_Input)
+and then RTE_Available (RE_Wide_Wide_String_Input)
 then
 return RTE (RE_Wide_Wide_String_Input);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Wide_Wide_String_Output)
+and then RTE_Available (RE_Wide_Wide_String_Output)
 then
 return RTE (RE_Wide_Wide_String_Output);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Wide_Wide_String_Read)
+and then RTE_Available (RE_Wide_Wide_String_Read)
 then
 return RTE (RE_Wide_Wide_String_Read);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Wide_Wide_String_Write)
+and then RTE_Available (RE_Wide_Wide_String_Write)
 then
 return RTE (RE_Wide_Wide_String_Write);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 --  Restriction No_Stream_Optimizations is not set, so we can go
 --  ahead and optimize using the block IO forms of the routines.
 else
 if Nam = TSS_Stream_Input
-and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO)
+and then RTE_Available (RE_Wide_Wide_String_Input_Blk_IO)
 then
 return RTE (RE_Wide_Wide_String_Input_Blk_IO);
 elsif Nam = TSS_Stream_Output
-and then Is_Available (RE_Wide_Wide_String_Output_Blk_IO)
+and then RTE_Available (RE_Wide_Wide_String_Output_Blk_IO)
 then
 return RTE (RE_Wide_Wide_String_Output_Blk_IO);
 elsif Nam = TSS_Stream_Read
-and then Is_Available (RE_Wide_Wide_String_Read_Blk_IO)
+and then RTE_Available (RE_Wide_Wide_String_Read_Blk_IO)
 then
 return RTE (RE_Wide_Wide_String_Read_Blk_IO);
 elsif Nam = TSS_Stream_Write
-and then Is_Available (RE_Wide_Wide_String_Write_Blk_IO)
+and then RTE_Available (RE_Wide_Wide_String_Write_Blk_IO)
 then
 return RTE (RE_Wide_Wide_String_Write_Blk_IO);
 elsif Nam /= TSS_Stream_Input  and then
 Nam /= TSS_Stream_Output and then
 or else not Is_Integer_Type (Etype (Parent (N)))
 then
 return False;
 end if;
---  Here we are in the integer conversion context
+--  Here we are in the integer conversion context. We reuse Rounding for
+--  Machine_Rounding as System.Fat_Gen, which is a permissible behavior.
---  Very probably we should also recognize the cases of Machine_Rounding
---  and unbiased rounding in this conversion context, but the back end is
+return
---  not yet prepared to handle these cases ???
+Id = Attribute_Rounding
+or else Id = Attribute_Machine_Rounding
-return Id = Attribute_Rounding or else Id = Attribute_Truncation;
+or else Id = Attribute_Truncation;
 end Is_Inline_Floating_Point_Attribute;
 end Exp_Attr;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/exp_attr.adb @ 145:1830386684a0