[gcc r12-1579] [Ada] Provide new function Uintp.UI_To_Unsigned_64

[gcc r12-1579] [Ada] Provide new function Uintp.UI_To_Unsigned_64

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:2be63603c6aa1567b4816945c97366500e03792b

commit r12-1579-g2be63603c6aa1567b4816945c97366500e03792b
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Mon Mar 8 07:13:43 2021 -0500

    [Ada] Provide new function Uintp.UI_To_Unsigned_64
    
    gcc/ada/
    
            * uintp.ads, uintp.adb (UI_To_Unsigned_64): New.

Diff:
---
 gcc/ada/uintp.adb | 44 ++++++++++++++++++++++++++++++++++++++++++--
 gcc/ada/uintp.ads |  5 +++++
 2 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb
index 045b8e53d88..8183469ca9b 100644
--- 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
index 04657027fd9..607e7ef95fa 100644
--- 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.