From cad9ff9a8d95ca09f3e498eb9d979408de5719c6 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 28 Jun 2024 18:29:15 +0400 Subject: [PATCH 1/2] Configuration variable to select maximum supported size of integer --- alire.toml | 5 ++++- config/vss_config.gpr | 6 +++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/alire.toml b/alire.toml index c74ebdb8..7f4c0906 100644 --- a/alire.toml +++ b/alire.toml @@ -1,6 +1,6 @@ name = "vss" description = "Advanced string and text manipulation with Unicode support" -version = "22.0.0-20210830" +version = "25.0.0-dev" tags = ["unicode", "json", "text"] authors = ["AdaCore"] @@ -15,5 +15,8 @@ project-files = ["gnat/vss_text.gpr", "gnat/vss_json.gpr"] generate_ada = false generate_c = false +[configuration.variables] +Max_Supported_Integer_Size = {type = "Enum", values = ["128", "64"], default = "128"} + [build-switches] "*".ada_version = "Ada2022" diff --git a/config/vss_config.gpr b/config/vss_config.gpr index befb8a5d..a7b39ec1 100644 --- a/config/vss_config.gpr +++ b/config/vss_config.gpr @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 -- @@ -106,6 +106,10 @@ abstract project Vss_Config is ,"-gnat2012" -- Ada 2012 Mode, see comment. ); + type Max_Supported_Integer_Size_Kind is ("128", "64"); + Max_Supported_Integer_Size : Max_Supported_Integer_Size_Kind := + external ("VSS_MAX_SUPPORTED_INTEGER_SIZE", "128"); + type Build_Profile_Kind is ("release", "validation", "development"); Build_Profile : Build_Profile_Kind := external ("VSS_BUILD_PROFILE", external ("BUILD_PROFILE", "development")); From bf12c1c1d8ac53cfe8e315e5e26e5186c26471f3 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 28 Jun 2024 19:50:50 +0400 Subject: [PATCH 2/2] Provide alternative implementation for 32bit platforms --- gnat/vss_json.gpr | 8 ++- .../vss-json-implementation-arithmetic_64.ads | 34 ++++++++++ ...json-implementation-arithmetic_64__128.adb | 54 +++++++++++++++ ...-json-implementation-arithmetic_64__64.adb | 67 +++++++++++++++++++ .../vss-json-implementation-big_integers.adb | 37 ++-------- ...on-implementation-numbers-eisel_lemire.adb | 38 ++--------- 6 files changed, 173 insertions(+), 65 deletions(-) create mode 100644 source/json/implementation/vss-json-implementation-arithmetic_64.ads create mode 100644 source/json/implementation/vss-json-implementation-arithmetic_64__128.adb create mode 100644 source/json/implementation/vss-json-implementation-arithmetic_64__64.adb diff --git a/gnat/vss_json.gpr b/gnat/vss_json.gpr index 5860d90a..03a11296 100644 --- a/gnat/vss_json.gpr +++ b/gnat/vss_json.gpr @@ -1,11 +1,12 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 -- -- VSS: JSON processing subproject +with "../config/vss_config"; with "vss_common"; with "vss_text"; @@ -33,4 +34,9 @@ project VSS_JSON is package Linker renames VSS_Common.Linker; + package Naming is + for Implementation ("VSS.JSON.Implementation.Arithmetic_64") + use "vss-json-implementation-arithmetic_64__" & Vss_Config.Max_Supported_Integer_Size & ".adb"; + end Naming; + end VSS_JSON; diff --git a/source/json/implementation/vss-json-implementation-arithmetic_64.ads b/source/json/implementation/vss-json-implementation-arithmetic_64.ads new file mode 100644 index 00000000..44b0f2ea --- /dev/null +++ b/source/json/implementation/vss-json-implementation-arithmetic_64.ads @@ -0,0 +1,34 @@ +-- +-- Copyright (C) 2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Multiply and Multiply_Add opertations on Integer_64 that returns +-- unpacked Integer_128 result and can be implemented in hardware. + +with Interfaces; + +package VSS.JSON.Implementation.Arithmetic_64 + with Preelaborate +is + + procedure Multiply + (A : Interfaces.Unsigned_64; + B : Interfaces.Unsigned_64; + L : out Interfaces.Unsigned_64; + H : out Interfaces.Unsigned_64) with Inline; + -- Multiplication of two 64-bit unsigned integers into 128-bit values, + -- splitted into high and low 64-bit unsigned integers. On x86_64 it is + -- optimized into single instruction. + + procedure Multiply_Add + (Left : Interfaces.Unsigned_64; + Right : Interfaces.Unsigned_64; + Result : out Interfaces.Unsigned_64; + Overflow : in out Interfaces.Unsigned_64) with Inline; + -- Multiplication of two 64-bit unsigned integers into 128-bit values, + -- add of carry. Result is splitted into high and low 64-bit unsigned + -- integers. On x86_64 it is optimized into few instructions. + +end VSS.JSON.Implementation.Arithmetic_64; diff --git a/source/json/implementation/vss-json-implementation-arithmetic_64__128.adb b/source/json/implementation/vss-json-implementation-arithmetic_64__128.adb new file mode 100644 index 00000000..d9932e6d --- /dev/null +++ b/source/json/implementation/vss-json-implementation-arithmetic_64__128.adb @@ -0,0 +1,54 @@ +-- +-- Copyright (C) 2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +pragma Ada_2022; + +package body VSS.JSON.Implementation.Arithmetic_64 + with Preelaborate +is + + -------------- + -- Multiply -- + -------------- + + procedure Multiply + (A : Interfaces.Unsigned_64; + B : Interfaces.Unsigned_64; + L : out Interfaces.Unsigned_64; + H : out Interfaces.Unsigned_64) + is + use type Interfaces.Unsigned_128; + + R : constant Interfaces.Unsigned_128 := + Interfaces.Unsigned_128 (A) * Interfaces.Unsigned_128 (B); + + begin + L := Interfaces.Unsigned_64 (R mod 2 ** 64); + H := Interfaces.Unsigned_64 (R / 2 ** 64); + end Multiply; + + ------------------ + -- Multiply_Add -- + ------------------ + + procedure Multiply_Add + (Left : Interfaces.Unsigned_64; + Right : Interfaces.Unsigned_64; + Result : out Interfaces.Unsigned_64; + Overflow : in out Interfaces.Unsigned_64) + is + use type Interfaces.Unsigned_128; + + R : constant Interfaces.Unsigned_128 := + Interfaces.Unsigned_128 (Left) * Interfaces.Unsigned_128 (Right) + + Interfaces.Unsigned_128 (Overflow); + + begin + Result := Interfaces.Unsigned_64 (R mod 2 ** 64); + Overflow := Interfaces.Unsigned_64 (R / 2 ** 64); + end Multiply_Add; + +end VSS.JSON.Implementation.Arithmetic_64; diff --git a/source/json/implementation/vss-json-implementation-arithmetic_64__64.adb b/source/json/implementation/vss-json-implementation-arithmetic_64__64.adb new file mode 100644 index 00000000..967ebda6 --- /dev/null +++ b/source/json/implementation/vss-json-implementation-arithmetic_64__64.adb @@ -0,0 +1,67 @@ +-- +-- Copyright (C) 2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +pragma Ada_2022; + +package body VSS.JSON.Implementation.Arithmetic_64 + with Preelaborate +is + + -------------- + -- Multiply -- + -------------- + + procedure Multiply + (A : Interfaces.Unsigned_64; + B : Interfaces.Unsigned_64; + L : out Interfaces.Unsigned_64; + H : out Interfaces.Unsigned_64) + is + use type Interfaces.Unsigned_64; + + AL : constant Interfaces.Unsigned_64 := A and 16#FFFF_FFFF#; + AH : constant Interfaces.Unsigned_64 := Interfaces.Shift_Right (A, 32); + BL : constant Interfaces.Unsigned_64 := B and 16#FFFF_FFFF#; + BH : constant Interfaces.Unsigned_64 := Interfaces.Shift_Right (B, 32); + + U : constant Interfaces.Unsigned_64 := AL * BL; + T : constant Interfaces.Unsigned_64 := + AH * BL + Interfaces.Shift_Right (U, 32); + TL : constant Interfaces.Unsigned_64 := T and 16#FFFF_FFFF#; + W1 : constant Interfaces.Unsigned_64 := TL + AL * BH; + W2 : constant Interfaces.Unsigned_64 := Interfaces.Shift_Right (T, 32); + + begin + L := A * B; + H := AH * BH + W2 + Interfaces.Shift_Right (W1, 32); + end Multiply; + + ------------------ + -- Multiply_Add -- + ------------------ + + procedure Multiply_Add + (Left : Interfaces.Unsigned_64; + Right : Interfaces.Unsigned_64; + Result : out Interfaces.Unsigned_64; + Overflow : in out Interfaces.Unsigned_64) + is + use type Interfaces.Unsigned_64; + + C : constant Interfaces.Unsigned_64 := Overflow; + L : Interfaces.Unsigned_64; + + begin + Multiply (Left, Right, L, Overflow); + + Result := L + C; + + if Result < L or Result < C then + Overflow := @ + 1; + end if; + end Multiply_Add; + +end VSS.JSON.Implementation.Arithmetic_64; diff --git a/source/json/implementation/vss-json-implementation-big_integers.adb b/source/json/implementation/vss-json-implementation-big_integers.adb index 7191f9d7..7bd9b0ff 100644 --- a/source/json/implementation/vss-json-implementation-big_integers.adb +++ b/source/json/implementation/vss-json-implementation-big_integers.adb @@ -1,11 +1,13 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- pragma Ada_2022; +with VSS.JSON.Implementation.Arithmetic_64; + package body VSS.JSON.Implementation.Big_Integers is use type Interfaces.Unsigned_64; @@ -17,15 +19,6 @@ package body VSS.JSON.Implementation.Big_Integers is Overflow : out Interfaces.Unsigned_64); -- Add of two 64-bit unsigned integers. Return result and overflow. - procedure Scalar_Multiply - (Left : Interfaces.Unsigned_64; - Right : Interfaces.Unsigned_64; - Result : out Interfaces.Unsigned_64; - Overflow : in out Interfaces.Unsigned_64); - -- Multiplication of two 64-bit unsigned integers into 128-bit values, - -- add of carry. Result is splitted into high and low 64-bit unsigned - -- integers. On x86_64 it is optimized into few instructions. - procedure Add (Self : in out Big_Integer; Value : Interfaces.Unsigned_64; @@ -262,7 +255,8 @@ package body VSS.JSON.Implementation.Big_Integers is begin for J in Self.Data'First .. Self.Last loop - Scalar_Multiply (Self.Data (J), Value, Self.Data (J), Carry); + VSS.JSON.Implementation.Arithmetic_64.Multiply_Add + (Self.Data (J), Value, Self.Data (J), Carry); end loop; if Carry /= 0 then @@ -451,27 +445,6 @@ package body VSS.JSON.Implementation.Big_Integers is Overflow := (if Add (Left, Right, Result'Access) then 1 else 0); end Scalar_Add; - --------------------- - -- Scalar_Multiply -- - --------------------- - - procedure Scalar_Multiply - (Left : Interfaces.Unsigned_64; - Right : Interfaces.Unsigned_64; - Result : out Interfaces.Unsigned_64; - Overflow : in out Interfaces.Unsigned_64) - is - use type Interfaces.Unsigned_128; - - R : constant Interfaces.Unsigned_128 := - Interfaces.Unsigned_128 (Left) * Interfaces.Unsigned_128 (Right) - + Interfaces.Unsigned_128 (Overflow); - - begin - Result := Interfaces.Unsigned_64 (R mod 2 ** 64); - Overflow := Interfaces.Unsigned_64 (R / 2 ** 64); - end Scalar_Multiply; - --------- -- Set -- --------- diff --git a/source/json/implementation/vss-json-implementation-numbers-eisel_lemire.adb b/source/json/implementation/vss-json-implementation-numbers-eisel_lemire.adb index b2ffbf83..296b9c6c 100644 --- a/source/json/implementation/vss-json-implementation-numbers-eisel_lemire.adb +++ b/source/json/implementation/vss-json-implementation-numbers-eisel_lemire.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -8,6 +8,7 @@ pragma Ada_2022; with Ada.Unchecked_Conversion; +with VSS.JSON.Implementation.Arithmetic_64; with VSS.JSON.Implementation.Numbers.Tables; package body VSS.JSON.Implementation.Numbers.Eisel_Lemire is @@ -31,15 +32,6 @@ package body VSS.JSON.Implementation.Numbers.Eisel_Lemire is Convention => Intrinsic, External_Name => "__builtin_clzll"; - procedure Multiply - (A : Interfaces.Unsigned_64; - B : Interfaces.Unsigned_64; - L : out Interfaces.Unsigned_64; - H : out Interfaces.Unsigned_64); - -- Multiplication of two 64-bit unsigned integers into 128-bit values, - -- splitted into high and low 64-bit unsigned integers. On x86_64 it is - -- optimized into single instruction. - procedure Compute_Product_Approximation (W : Interfaces.Unsigned_64; Q : Interfaces.Integer_32; @@ -164,7 +156,8 @@ package body VSS.JSON.Implementation.Numbers.Eisel_Lemire is -- For small values of q, e.g., q in [0,27], the answer is always exact -- because the first call of Multiply gives the exact answer. - Multiply (W, Tables.Powers_Of_Five (Q).L, FL, FH); + VSS.JSON.Implementation.Arithmetic_64.Multiply + (W, Tables.Powers_Of_Five (Q).L, FL, FH); if (FH and Precision_Mask) = Precision_Mask then -- could further guard with (lower + w < lower) @@ -173,7 +166,8 @@ package body VSS.JSON.Implementation.Numbers.Eisel_Lemire is -- expectation is that the compiler will optimize this extra -- work away if needed. - Multiply (W, Tables.Powers_Of_Five (Q).H, SL, SH); + VSS.JSON.Implementation.Arithmetic_64.Multiply + (W, Tables.Powers_Of_Five (Q).H, SL, SH); FL := @ + SH; if SH > FL then @@ -560,26 +554,6 @@ package body VSS.JSON.Implementation.Numbers.Eisel_Lemire is Number.Power := @ - 1; end Halfway; - -------------- - -- Multiply -- - -------------- - - procedure Multiply - (A : Interfaces.Unsigned_64; - B : Interfaces.Unsigned_64; - L : out Interfaces.Unsigned_64; - H : out Interfaces.Unsigned_64) - is - use type Interfaces.Unsigned_128; - - R : constant Interfaces.Unsigned_128 := - Interfaces.Unsigned_128 (A) * Interfaces.Unsigned_128 (B); - - begin - L := Interfaces.Unsigned_64 (R mod 2 ** 64); - H := Interfaces.Unsigned_64 (R / 2 ** 64); - end Multiply; - -------------------- -- Scale_Negative -- --------------------