From 4d3a70f2d1fd213ff669bdaf5752615ab871a2c7 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 30 Nov 2020 16:56:38 +0100 Subject: [PATCH] [Ada] Move folding of unchecked conversions from expansion to evaluation gcc/ada/ * exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): Remove folding of discrete values. * exp_intr.adb (Expand_Unc_Conversion): Analyze, resolve and evaluate (if possible) calls to instances of Ada.Unchecked_Conversion after they have been expanded into N_Unchecked_Type_Conversion. * sem_eval.adb (Eval_Unchecked_Conversion): Add folding of discrete values. --- gcc/ada/exp_ch4.adb | 50 --------------------------------------- gcc/ada/exp_intr.adb | 10 ++------ gcc/ada/sem_eval.adb | 56 +++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 57 insertions(+), 59 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 91ae71efd21..e376648a4a5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12815,56 +12815,6 @@ package body Exp_Ch4 is return; end if; - -- If we have a conversion of a compile time known value to a target - -- type and the value is in range of the target type, then we can simply - -- replace the construct by an integer literal of the correct type. We - -- only apply this to discrete types being converted. Possibly it may - -- apply in other cases, but it is too much trouble to worry about. - - -- Note that we do not do this transformation if the Kill_Range_Check - -- flag is set, since then the value may be outside the expected range. - -- This happens in the Normalize_Scalars case. - - -- We also skip this if either the target or operand type is biased - -- because in this case, the unchecked conversion is supposed to - -- preserve the bit pattern, not the integer value. - - if Is_Integer_Type (Target_Type) - and then not Has_Biased_Representation (Target_Type) - and then Is_Discrete_Type (Operand_Type) - and then not Has_Biased_Representation (Operand_Type) - and then Compile_Time_Known_Value (Operand) - and then not Kill_Range_Check (N) - then - declare - Val : constant Uint := Expr_Rep_Value (Operand); - - begin - if Compile_Time_Known_Value (Type_Low_Bound (Target_Type)) - and then - Compile_Time_Known_Value (Type_High_Bound (Target_Type)) - and then - Val >= Expr_Value (Type_Low_Bound (Target_Type)) - and then - Val <= Expr_Value (Type_High_Bound (Target_Type)) - then - Rewrite (N, Make_Integer_Literal (Sloc (N), Val)); - - -- If Address is the target type, just set the type to avoid a - -- spurious type error on the literal when Address is a visible - -- integer type. - - if Is_Descendant_Of_Address (Target_Type) then - Set_Etype (N, Target_Type); - else - Analyze_And_Resolve (N, Target_Type); - end if; - - return; - end if; - end; - end if; - -- Generate an extra temporary for cases unsupported by the C backend if Modify_Tree_For_C then diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 7fc00c706f2..3be039b4be5 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -29,7 +29,6 @@ with Einfo; use Einfo; with Elists; use Elists; with Expander; use Expander; with Exp_Atag; use Exp_Atag; -with Exp_Ch4; use Exp_Ch4; with Exp_Ch7; use Exp_Ch7; with Exp_Ch11; use Exp_Ch11; with Exp_Code; use Exp_Code; @@ -857,7 +856,7 @@ package body Exp_Intr is --------------------------- procedure Expand_Unc_Conversion (N : Node_Id; E : Entity_Id) is - Func : constant Entity_Id := Entity (Name (N)); + Func : constant Entity_Id := Entity (Name (N)); Conv : Node_Id; Ftyp : Entity_Id; Ttyp : Entity_Id; @@ -908,12 +907,7 @@ package body Exp_Intr is end if; Rewrite (N, Unchecked_Convert_To (Ttyp, Conv)); - Set_Etype (N, Ttyp); - Set_Analyzed (N); - - if Nkind (N) = N_Unchecked_Type_Conversion then - Expand_N_Unchecked_Type_Conversion (N); - end if; + Analyze_And_Resolve (N, Ttyp); end Expand_Unc_Conversion; ----------------------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 68498e6caaf..1a832f767cd 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4359,8 +4359,62 @@ package body Sem_Eval is -- processing is to check for a non-static context for the operand. procedure Eval_Unchecked_Conversion (N : Node_Id) is + Target_Type : constant Entity_Id := Etype (N); + Operand : constant Node_Id := Expression (N); + Operand_Type : constant Entity_Id := Etype (Operand); + begin - Check_Non_Static_Context (Expression (N)); + Check_Non_Static_Context (Operand); + + -- If we have a conversion of a compile time known value to a target + -- type and the value is in range of the target type, then we can simply + -- replace the construct by an integer literal of the correct type. We + -- only apply this to discrete types being converted. Possibly it may + -- apply in other cases, but it is too much trouble to worry about. + + -- Note that we do not do this transformation if the Kill_Range_Check + -- flag is set, since then the value may be outside the expected range. + -- This happens in the Normalize_Scalars case. + + -- We also skip this if either the target or operand type is biased + -- because in this case, the unchecked conversion is supposed to + -- preserve the bit pattern, not the integer value. + + if Is_Integer_Type (Target_Type) + and then not Has_Biased_Representation (Target_Type) + and then Is_Discrete_Type (Operand_Type) + and then not Has_Biased_Representation (Operand_Type) + and then Compile_Time_Known_Value (Operand) + and then not Kill_Range_Check (N) + then + declare + Val : constant Uint := Expr_Rep_Value (Operand); + + begin + if Compile_Time_Known_Value (Type_Low_Bound (Target_Type)) + and then + Compile_Time_Known_Value (Type_High_Bound (Target_Type)) + and then + Val >= Expr_Value (Type_Low_Bound (Target_Type)) + and then + Val <= Expr_Value (Type_High_Bound (Target_Type)) + then + Rewrite (N, Make_Integer_Literal (Sloc (N), Val)); + + -- If Address is the target type, just set the type to avoid a + -- spurious type error on the literal when Address is a visible + -- integer type. + + if Is_Descendant_Of_Address (Target_Type) then + Set_Etype (N, Target_Type); + else + Analyze_And_Resolve (N, Target_Type); + end if; + + return; + end if; + end; + end if; end Eval_Unchecked_Conversion; -------------------- -- 2.30.2