From: Pierre-Marie de Rodat <derodat@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [Ada] Fix internal error on fixed-point divide, multiply and scaling
Date: Mon, 11 Oct 2021 13:39:30 +0000 [thread overview]
Message-ID: <20211011133930.GA1518923@adacore.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 902 bytes --]
This fixes a couple of long-standing oversights in the fixed-point multiply
implementation that were recently copied into the divide implementation and
thus made more visible: when computing the operand size for compile-time
known values, the negative case must be taken into account and comparisons
with powers of 2 must be strict. The patch also performs some refactoring.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_fixd.adb (Get_Size_For_Value): New function returning a size
suitable for a non-negative integer value.
(Get_Type_For_Size): New function returning a standard type suitable
for a size.
(Build_Divide): Call both functions to compute the result type, but
make sure to pass a non-negative value to the first.
(Build_Multiply): Likewise.
(Do_Multiply_Fixed_Universal): Minor consistency tweak.
(Integer_Literal): Call both functions to compute the type.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8904 bytes --]
diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb
--- a/gcc/ada/exp_fixd.adb
+++ b/gcc/ada/exp_fixd.adb
@@ -190,6 +190,15 @@ package body Exp_Fixd is
-- The expression returned is neither analyzed nor resolved. The Etype
-- of the result is properly set (to Universal_Real).
+ function Get_Size_For_Value (V : Uint) return Pos;
+ -- Given a non-negative universal integer value, return the size of a small
+ -- signed integer type covering -V .. V, or Pos'Max if no such type exists.
+
+ function Get_Type_For_Size (Siz : Pos; Force : Boolean) return Entity_Id;
+ -- Return the smallest signed integer type containing at least Siz bits.
+ -- If no such type exists, return Empty if Force is False or the largest
+ -- signed integer type if Force is True.
+
function Integer_Literal
(N : Node_Id;
V : Uint;
@@ -324,7 +333,6 @@ package body Exp_Fixd is
Right_Type : constant Entity_Id := Base_Type (Etype (R));
Left_Size : Int;
Right_Size : Int;
- Rsize : Int;
Result_Type : Entity_Id;
Rnode : Node_Id;
@@ -354,20 +362,17 @@ package body Exp_Fixd is
-- the effective size of an operand is the RM_Size of the operand.
-- But a special case arises with operands whose size is known at
-- compile time. In this case, we can use the actual value of the
- -- operand to get its size if it would fit in signed 8/16/32 bits.
+ -- operand to get a size if it would fit in a small signed integer.
Left_Size := UI_To_Int (RM_Size (Left_Type));
if Compile_Time_Known_Value (L) then
declare
- Val : constant Uint := Expr_Value (L);
+ Siz : constant Int :=
+ Get_Size_For_Value (UI_Abs (Expr_Value (L)));
begin
- if Val < Uint_2 ** 7 then
- Left_Size := 8;
- elsif Val < Uint_2 ** 15 then
- Left_Size := 16;
- elsif Val < Uint_2 ** 31 then
- Left_Size := 32;
+ if Siz < Left_Size then
+ Left_Size := Siz;
end if;
end;
end if;
@@ -376,35 +381,19 @@ package body Exp_Fixd is
if Compile_Time_Known_Value (R) then
declare
- Val : constant Uint := Expr_Value (R);
+ Siz : constant Int :=
+ Get_Size_For_Value (UI_Abs (Expr_Value (R)));
begin
- if Val <= Int'(2 ** 7) then
- Right_Size := 8;
- elsif Val <= Int'(2 ** 15) then
- Right_Size := 16;
+ if Siz < Right_Size then
+ Right_Size := Siz;
end if;
end;
end if;
-- Do the operation using the longer of the two sizes
- Rsize := Int'Max (Left_Size, Right_Size);
-
- if Rsize <= 8 then
- Result_Type := Standard_Integer_8;
-
- elsif Rsize <= 16 then
- Result_Type := Standard_Integer_16;
-
- elsif Rsize <= 32 then
- Result_Type := Standard_Integer_32;
-
- elsif Rsize <= 64 or else System_Max_Integer_Size < 128 then
- Result_Type := Standard_Integer_64;
-
- else
- Result_Type := Standard_Integer_128;
- end if;
+ Result_Type :=
+ Get_Type_For_Size (Int'Max (Left_Size, Right_Size), Force => True);
Rnode :=
Make_Op_Divide (Loc,
@@ -664,7 +653,6 @@ package body Exp_Fixd is
Right_Type : constant Entity_Id := Etype (R);
Left_Size : Int;
Right_Size : Int;
- Rsize : Int;
Result_Type : Entity_Id;
Rnode : Node_Id;
@@ -697,20 +685,17 @@ package body Exp_Fixd is
-- the effective size of an operand is the RM_Size of the operand.
-- But a special case arises with operands whose size is known at
-- compile time. In this case, we can use the actual value of the
- -- operand to get its size if it would fit in signed 8/16/32 bits.
+ -- operand to get a size if it would fit in a small signed integer.
Left_Size := UI_To_Int (RM_Size (Left_Type));
if Compile_Time_Known_Value (L) then
declare
- Val : constant Uint := Expr_Value (L);
+ Siz : constant Int :=
+ Get_Size_For_Value (UI_Abs (Expr_Value (L)));
begin
- if Val < Uint_2 ** 7 then
- Left_Size := 8;
- elsif Val < Uint_2 ** 15 then
- Left_Size := 16;
- elsif Val < Uint_2 ** 31 then
- Left_Size := 32;
+ if Siz < Left_Size then
+ Left_Size := Siz;
end if;
end;
end if;
@@ -719,12 +704,11 @@ package body Exp_Fixd is
if Compile_Time_Known_Value (R) then
declare
- Val : constant Uint := Expr_Value (R);
+ Siz : constant Int :=
+ Get_Size_For_Value (UI_Abs (Expr_Value (R)));
begin
- if Val <= Int'(2 ** 7) then
- Right_Size := 8;
- elsif Val <= Int'(2 ** 15) then
- Right_Size := 16;
+ if Siz < Right_Size then
+ Right_Size := Siz;
end if;
end;
end if;
@@ -732,23 +716,8 @@ package body Exp_Fixd is
-- Now the result size must be at least the sum of the two sizes,
-- to accommodate all possible results.
- Rsize := Left_Size + Right_Size;
-
- if Rsize <= 8 then
- Result_Type := Standard_Integer_8;
-
- elsif Rsize <= 16 then
- Result_Type := Standard_Integer_16;
-
- elsif Rsize <= 32 then
- Result_Type := Standard_Integer_32;
-
- elsif Rsize <= 64 or else System_Max_Integer_Size < 128 then
- Result_Type := Standard_Integer_64;
-
- else
- Result_Type := Standard_Integer_128;
- end if;
+ Result_Type :=
+ Get_Type_For_Size (Left_Size + Right_Size, Force => True);
Rnode :=
Make_Op_Multiply (Loc,
@@ -1542,7 +1511,7 @@ package body Exp_Fixd is
else
Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
- Lit_K := Integer_Literal (N, Frac_Num);
+ Lit_K := Integer_Literal (N, Frac_Num, False);
if Present (Lit_Int) and then Present (Lit_K) then
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
@@ -2422,6 +2391,64 @@ package body Exp_Fixd is
return Build_Conversion (N, Universal_Real, N);
end Fpt_Value;
+ ------------------------
+ -- Get_Size_For_Value --
+ ------------------------
+
+ function Get_Size_For_Value (V : Uint) return Pos is
+ begin
+ pragma Assert (V >= Uint_0);
+
+ if V < Uint_2 ** 7 then
+ return 8;
+
+ elsif V < Uint_2 ** 15 then
+ return 16;
+
+ elsif V < Uint_2 ** 31 then
+ return 32;
+
+ elsif V < Uint_2 ** 63 then
+ return 64;
+
+ elsif V < Uint_2 ** 127 then
+ return 128;
+
+ else
+ return Pos'Last;
+ end if;
+ end Get_Size_For_Value;
+
+ -----------------------
+ -- Get_Type_For_Size --
+ -----------------------
+
+ function Get_Type_For_Size (Siz : Pos; Force : Boolean) return Entity_Id is
+ begin
+ if Siz <= 8 then
+ return Standard_Integer_8;
+
+ elsif Siz <= 16 then
+ return Standard_Integer_16;
+
+ elsif Siz <= 32 then
+ return Standard_Integer_32;
+
+ elsif Siz <= 64
+ or else (Force and then System_Max_Integer_Size < 128)
+ then
+ return Standard_Integer_64;
+
+ elsif (Siz <= 128 and then System_Max_Integer_Size = 128)
+ or else Force
+ then
+ return Standard_Integer_128;
+
+ else
+ return Empty;
+ end if;
+ end Get_Type_For_Size;
+
---------------------
-- Integer_Literal --
---------------------
@@ -2435,22 +2462,8 @@ package body Exp_Fixd is
L : Node_Id;
begin
- if V < Uint_2 ** 7 then
- T := Standard_Integer_8;
-
- elsif V < Uint_2 ** 15 then
- T := Standard_Integer_16;
-
- elsif V < Uint_2 ** 31 then
- T := Standard_Integer_32;
-
- elsif V < Uint_2 ** 63 then
- T := Standard_Integer_64;
-
- elsif V < Uint_2 ** 127 and then System_Max_Integer_Size = 128 then
- T := Standard_Integer_128;
-
- else
+ T := Get_Type_For_Size (Get_Size_For_Value (V), Force => False);
+ if No (T) then
return Empty;
end if;
reply other threads:[~2021-10-11 13:39 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20211011133930.GA1518923@adacore.com \
--to=derodat@adacore.com \
--cc=ebotcazou@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).