From: Eric Botcazou Date: Sun, 26 Apr 2020 10:46:03 +0000 (+0200) Subject: [Ada] Fix small inefficiency in previous change to expander X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2ab42c70a62fe10f40a623adf48002ac8cdb9bf8;p=gcc.git [Ada] Fix small inefficiency in previous change to expander 2020-06-18 Eric Botcazou gcc/ada/ * exp_ch4.adb (Get_Size_For_Range): Only make sure to return a size lower than that of the original type if possible. * libgnat/s-rannum.adb (Random_Discrete): Back out optimization added for 32-bit types. --- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1302009fcdd..2adebb6f54c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -13919,28 +13919,50 @@ package body Exp_Ch4 is Typ : constant Entity_Id := Etype (R); function Get_Size_For_Range (Lo, Hi : Uint) return Nat; - -- Return the size of the smallest signed integer type covering Lo .. Hi + -- Return the size of a small signed integer type covering Lo .. Hi. + -- The important thing is to return a size lower than that of Typ. ------------------------ -- Get_Size_For_Range -- ------------------------ function Get_Size_For_Range (Lo, Hi : Uint) return Nat is - B : Uint; - S : Nat; + + function Is_OK_For_Range (Siz : Nat) return Boolean; + -- Return True if a signed integer with given size can cover Lo .. Hi + + -------------------------- + -- Is_OK_For_Range -- + -------------------------- + + function Is_OK_For_Range (Siz : Nat) return Boolean is + B : constant Uint := Uint_2 ** (Siz - 1); + + begin + -- Test B = 2 ** (size - 1) (can accommodate -B .. +(B - 1)) + + return Lo >= -B and then Hi >= -B and then Lo < B and then Hi < B; + end Is_OK_For_Range; begin - S := 1; - B := Uint_1; + -- This is (almost always) the size of Integer - -- S = size, B = 2 ** (size - 1) (can accommodate -B .. +(B - 1)) + if Is_OK_For_Range (32) then + return 32; - while Lo < -B or else Hi < -B or else Lo >= B or else Hi >= B loop - B := Uint_2 ** S; - S := S + 1; - end loop; + -- If the size of Typ is 64 then check 63 + + elsif RM_Size (Typ) = 64 and then Is_OK_For_Range (63) then + return 63; + + -- This is (almost always) the size of Long_Long_Integer - return S; + elsif Is_OK_For_Range (64) then + return 64; + + else + return 128; + end if; end Get_Size_For_Range; -- Local variables diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb index 8824a724f78..baf5cbe97cb 100644 --- a/gcc/ada/libgnat/s-rannum.adb +++ b/gcc/ada/libgnat/s-rannum.adb @@ -402,10 +402,11 @@ is elsif Max < Min then raise Constraint_Error; + -- In the 64-bit case, we have to be careful since not all 64-bit + -- unsigned values are representable in GNAT's universal integer. + elsif Result_Subtype'Base'Size > 32 then declare - -- In the 64-bit case, we have to be careful since not all 64-bit - -- unsigned values are representable in GNAT's universal integer. -- Ignore unequal-size warnings since GNAT's handling is correct. pragma Warnings ("Z"); @@ -422,8 +423,7 @@ is begin if N = 0 then - X := Random (Gen); - return Conv_To_Result (Conv_To_Unsigned (Min) + X); + return Conv_To_Result (Conv_To_Unsigned (Min) + Random (Gen)); else Slop := Unsigned_64'Last rem N + 1; @@ -437,73 +437,31 @@ is end if; end; - else - declare - -- In the 32-bit case, unlike the above case, we need to handle - -- both integer and enumeration types. If the values of the result - -- subtype are contiguous, then we can still use the above trick. - -- Otherwise we need to rely on 'Pos and 'Val in the computation, - -- which is more costly since it will thus be done in universal - -- integer. And ignore unequal-size warnings in this case too. + -- In the 32-bit case, we need to handle both integer and enumeration + -- types and, therefore, rely on 'Pos and 'Val in the computation. - pragma Warnings ("Z"); - function Conv_To_Unsigned is - new Unchecked_Conversion (Result_Subtype'Base, Unsigned_32); - function Conv_To_Result is - new Unchecked_Conversion (Unsigned_32, Result_Subtype'Base); - pragma Warnings ("z"); - - Contiguous : constant Boolean := - Result_Subtype'Pos (Result_Subtype'Last) - - Result_Subtype'Pos (Result_Subtype'First) - = - Result_Subtype'Enum_Rep (Result_Subtype'Last) - - Result_Subtype'Enum_Rep (Result_Subtype'First); + elsif Result_Subtype'Pos (Max) - Result_Subtype'Pos (Min) = 2 ** 32 - 1 + then + return Result_Subtype'Val + (Result_Subtype'Pos (Min) + Unsigned_32'Pos (Random (Gen))); - N, X, Slop : Unsigned_32; + else + declare + N : constant Unsigned_32 := + Unsigned_32 (Result_Subtype'Pos (Max) - + Result_Subtype'Pos (Min) + 1); + Slop : constant Unsigned_32 := Unsigned_32'Last rem N + 1; + X : Unsigned_32; begin - if Contiguous then - N := Conv_To_Unsigned (Max) - Conv_To_Unsigned (Min) + 1; - - if N = 0 then - X := Random (Gen); - return Conv_To_Result (Conv_To_Unsigned (Min) + X); - - else - Slop := Unsigned_32'Last rem N + 1; - - loop - X := Random (Gen); - exit when Slop = N or else X <= Unsigned_32'Last - Slop; - end loop; - - return Conv_To_Result (Conv_To_Unsigned (Min) + X rem N); - end if; - - else - N := Unsigned_32 (Result_Subtype'Pos (Max) - - Result_Subtype'Pos (Min) + 1); - - if N = 0 then - X := Random (Gen); - return - Result_Subtype'Val - (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X)); - - else - Slop := Unsigned_32'Last rem N + 1; - - loop - X := Random (Gen); - exit when Slop = N or else X <= Unsigned_32'Last - Slop; - end loop; + loop + X := Random (Gen); + exit when Slop = N or else X <= Unsigned_32'Last - Slop; + end loop; - return - Result_Subtype'Val - (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N)); - end if; - end if; + return + Result_Subtype'Val + (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N)); end; end if; end Random_Discrete;