diff mbox series

[Ada] Provide new function Uintp.UI_To_Unsigned_64

Message ID 20210617143310.GA9325@adacore.com
State New
Headers show
Series [Ada] Provide new function Uintp.UI_To_Unsigned_64 | expand

Commit Message

Pierre-Marie de Rodat June 17, 2021, 2:33 p.m. UTC 
The function UI_To_Int is sometimes not sufficient, so provide this new
function which can be useful to some GNAT back-ends.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* uintp.ads, uintp.adb (UI_To_Unsigned_64): New.
diff mbox series

Patch

diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb
--- a/gcc/ada/uintp.adb
+++ b/gcc/ada/uintp.adb
@@ -2179,9 +2179,9 @@  package body Uintp is
       end if;
    end UI_To_CC;
 
-   ----------------
+   ---------------
    -- UI_To_Int --
-   ----------------
+   ---------------
 
    function UI_To_Int (Input : Uint) return Int is
       pragma Assert (Input /= No_Uint);
@@ -2230,6 +2230,46 @@  package body Uintp is
       end if;
    end UI_To_Int;
 
+   -----------------
+   -- UI_To_Uns64 --
+   -----------------
+
+   function UI_To_Unsigned_64 (Input : Uint) return Unsigned_64 is
+      pragma Assert (Input /= No_Uint);
+
+   begin
+      if Input < Uint_0 then
+         raise Constraint_Error;
+      end if;
+
+      if Direct (Input) then
+         return Unsigned_64 (Direct_Val (Input));
+
+      --  Case of input is more than one digit
+
+      else
+         if Input >= Uint_2**Int'(64) then
+            raise Constraint_Error;
+         end if;
+
+         declare
+            In_Length : constant Int := N_Digits (Input);
+            In_Vec    : UI_Vector (1 .. In_Length);
+            Ret_Int   : Unsigned_64 := 0;
+
+         begin
+            Init_Operand (Input, In_Vec);
+
+            for Idx in In_Vec'Range loop
+               Ret_Int :=
+                 Ret_Int * Unsigned_64 (Base) + Unsigned_64 (In_Vec (Idx));
+            end loop;
+
+            return Ret_Int;
+         end;
+      end if;
+   end UI_To_Unsigned_64;
+
    --------------
    -- UI_Write --
    --------------


diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads
--- a/gcc/ada/uintp.ads
+++ b/gcc/ada/uintp.ads
@@ -252,6 +252,11 @@  package Uintp is
    --  Converts universal integer value to Int. Constraint_Error if value is
    --  not in appropriate range.
 
+   type Unsigned_64 is mod 2**64;
+   function UI_To_Unsigned_64 (Input : Uint) return Unsigned_64;
+   --  Converts universal integer value to Unsigned_64. Constraint_Error if
+   --  value is not in appropriate range.
+
    function UI_To_CC (Input : Uint) return Char_Code;
    --  Converts universal integer value to Char_Code. Constraint_Error if value
    --  is not in Char_Code range.