Mercurial > hg > CbC > CbC_gcc
diff 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 |
line wrap: on
line diff
--- a/gcc/ada/exp_attr.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/exp_attr.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -39,6 +39,7 @@ 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; @@ -639,7 +640,7 @@ Stmts := No_List; - -- Validate componants + -- Validate components Validate_Component_List (Obj_Id => Obj_Id, @@ -1384,12 +1385,15 @@ 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 - -- wrapping function. + -- that the condition actions must also be relocated into the + -- wrapping function because they may contain itypes, e.g. in + -- the case of a comparison involving slices. -- Generate: -- <condition actions> @@ -1403,7 +1407,9 @@ 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 @@ -1411,7 +1417,6 @@ -- <Stmts> -- end Fnn; - Func_Id := Make_Temporary (Loc, 'F'); Func_Decl := Make_Subprogram_Body (Loc, Specification => @@ -1431,6 +1436,25 @@ 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 @@ -1693,103 +1717,6 @@ -- 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; ---------------------------------- @@ -2389,6 +2316,24 @@ 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. @@ -2452,16 +2397,19 @@ -- "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. - - -- This processing is not needed in the VM case, where dispatching - -- issues are taken care of by the virtual machine. + -- address of the object. This call is not generated in cases where + -- the attribute is being used to initialize a component of an + -- activation record object where the component corresponds to + -- 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, @@ -2843,40 +2791,6 @@ 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 @@ -2917,115 +2831,23 @@ New_Occurrence_Of (Extra_Constrained (Entity (Pref)), Sloc (N))); - -- For all other entity names, 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). + -- For all other cases, we can tell at compile time 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 ( - Boolean_Literals ( - not Is_Variable (Pref) - or else - (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)); + New_Occurrence_Of + (Boolean_Literals + (Exp_Util.Attribute_Constrained_Static_Value + (Pref)), Sloc (N))); end if; Analyze_And_Resolve (N, Standard_Boolean); @@ -3376,6 +3198,13 @@ 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 => @@ -3626,7 +3455,7 @@ -- We transform -- fixtype'Fixed_Value (integer-value) - -- inttype'Fixed_Value (fixed-value) + -- inttype'Integer_Value (fixed-value) -- into @@ -3635,75 +3464,30 @@ -- respectively. - -- We do all the required analysis of the conversion here, because we do - -- not want this to go through the fixed-point conversion circuits. Note - -- 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. + -- We set Conversion_OK on the conversion because we do not want it + -- to go through the fixed-point conversion circuits. when Attribute_Fixed_Value | Attribute_Integer_Value => - Rewrite (N, - Make_Type_Conversion (Loc, - Subtype_Mark => New_Occurrence_Of (Entity (Pref), Loc), - Expression => Relocate_Node (First (Exprs)))); - - -- Indicate that the result of the conversion may require a - -- range check (see below); - - Set_Etype (N, Base_Type (Entity (Pref))); - Set_Analyzed (N); - - -- Note: it might appear that a properly analyzed unchecked + Rewrite (N, OK_Convert_To (Entity (Pref), First (Exprs))); + + -- Note that 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 + -- since the full range checks performed by the following calls -- 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; + + Apply_Type_Conversion_Checks (N); + + -- 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); ----------- -- Floor -- @@ -3728,8 +3512,8 @@ -- 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 - -- would have itself been computed dynamically in Eval_Attribute. + -- Note that we know that the type is a nonstatic subtype, or Fore would + -- have itself been computed dynamically in Eval_Attribute. when Attribute_Fore => Rewrite (N, @@ -4094,11 +3878,14 @@ 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); -- @@ -4109,6 +3896,11 @@ -- 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 @@ -4123,18 +3915,30 @@ -- 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, - Name => - New_Occurrence_Of - (RTE (RE_String_Input_Tag), Loc), - Parameter_Associations => New_List ( - Relocate_Node (Duplicate_Subexpr (Strm)))), - + Get_Tag, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (P_Type, Loc), Attribute_Name => Name_Tag))); @@ -4242,6 +4046,11 @@ 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 -- ---------- @@ -5437,7 +5246,7 @@ 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 @@ -5654,6 +5463,97 @@ 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 -- ---------- @@ -5954,7 +5854,6 @@ | Attribute_VADS_Size => Size : declare - Siz : Uint; New_Node : Node_Id; begin @@ -6066,128 +5965,12 @@ 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 - - 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 - -- 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; + -- Call Expand_Size_Attribute to do the final part of the + -- expansion which is shared with GNATprove expansion. + + Expand_Size_Attribute (N); end Size; ------------------ @@ -6433,7 +6216,7 @@ 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. @@ -6605,15 +6388,25 @@ ---------------- -- 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, - Unchecked_Convert_To (RTE (RE_Address), - Relocate_Node (First (Exprs)))); - Analyze_And_Resolve (N, RTE (RE_Address)); + To_Address : declare + Is_Static : constant Boolean := Is_Static_Expression (N); + + 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 -- @@ -6757,7 +6550,7 @@ -- 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 @@ -6767,7 +6560,7 @@ 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 -- @@ -6806,16 +6599,16 @@ 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)))); @@ -6843,8 +6636,8 @@ -- 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 - Btyp := Full_View (Btyp); + if Is_Private_Type (PBtyp) and then Present (Full_View (PBtyp)) then + PBtyp := Full_View (PBtyp); end if; -- Floating-point case. This case is handled by the Valid attribute @@ -6877,7 +6670,7 @@ 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); @@ -6970,13 +6763,13 @@ -- 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; @@ -7005,24 +6798,24 @@ -- (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 @@ -7055,16 +6848,16 @@ -- 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)))); @@ -7079,11 +6872,11 @@ -- 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) - - -- where Btyp is an integer type large enough to cover the full + -- PBtyp!(X) <= PBtyp!(type(X)'Last) + + -- 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 @@ -7107,11 +6900,13 @@ -- 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); @@ -7120,9 +6915,9 @@ 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); @@ -7703,6 +7498,157 @@ 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 -- ----------------------------- @@ -7987,31 +7933,6 @@ 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; @@ -8028,7 +7949,7 @@ -- 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 @@ -8040,22 +7961,22 @@ 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); @@ -8072,22 +7993,22 @@ 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); @@ -8108,22 +8029,22 @@ 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); @@ -8140,22 +8061,22 @@ 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); @@ -8176,22 +8097,22 @@ 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); @@ -8208,22 +8129,22 @@ 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); @@ -8244,22 +8165,22 @@ 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); @@ -8276,22 +8197,22 @@ 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); @@ -8312,22 +8233,22 @@ 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); @@ -8344,22 +8265,22 @@ 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); @@ -8525,13 +8446,13 @@ return False; end if; - -- Here we are in the integer conversion context - - -- Very probably we should also recognize the cases of Machine_Rounding - -- and unbiased rounding in this conversion context, but the back end is - -- not yet prepared to handle these cases ??? - - return Id = Attribute_Rounding or else Id = Attribute_Truncation; + -- Here we are in the integer conversion context. We reuse Rounding for + -- Machine_Rounding as System.Fat_Gen, which is a permissible behavior. + + return + Id = Attribute_Rounding + or else Id = Attribute_Machine_Rounding + or else Id = Attribute_Truncation; end Is_Inline_Floating_Point_Attribute; end Exp_Attr;