| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- S Y S T E M . E X P _ M O D -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- Preconditions, postconditions, ghost code, loop invariants and assertions |
| -- in this unit are meant for analysis only, not for run-time checking, as it |
| -- would be too costly otherwise. This is enforced by setting the assertion |
| -- policy to Ignore. |
| |
| pragma Assertion_Policy (Pre => Ignore, |
| Post => Ignore, |
| Ghost => Ignore, |
| Loop_Invariant => Ignore, |
| Assert => Ignore); |
| |
| with Ada.Numerics.Big_Numbers.Big_Integers_Ghost; |
| use Ada.Numerics.Big_Numbers.Big_Integers_Ghost; |
| |
| package body System.Exp_Mod |
| with SPARK_Mode |
| is |
| use System.Unsigned_Types; |
| |
| -- Local lemmas |
| |
| procedure Lemma_Add_Mod (X, Y : Big_Natural; B : Big_Positive) |
| with |
| Ghost, |
| Post => (X + Y) mod B = ((X mod B) + (Y mod B)) mod B; |
| |
| procedure Lemma_Exp_Expand (A : Big_Integer; Exp : Natural) |
| with |
| Ghost, |
| Post => |
| (if Exp rem 2 = 0 then |
| A ** Exp = A ** (Exp / 2) * A ** (Exp / 2) |
| else |
| A ** Exp = A ** (Exp / 2) * A ** (Exp / 2) * A); |
| |
| procedure Lemma_Exp_Mod (A : Big_Natural; Exp : Natural; B : Big_Positive) |
| with |
| Ghost, |
| Subprogram_Variant => (Decreases => Exp), |
| Post => ((A mod B) ** Exp) mod B = (A ** Exp) mod B; |
| |
| procedure Lemma_Mod_Ident (A : Big_Natural; B : Big_Positive) |
| with |
| Ghost, |
| Pre => A < B, |
| Post => A mod B = A; |
| |
| procedure Lemma_Mod_Mod (A : Big_Integer; B : Big_Positive) |
| with |
| Ghost, |
| Post => A mod B mod B = A mod B; |
| |
| procedure Lemma_Mult_Div (X : Big_Natural; Y : Big_Positive) |
| with |
| Ghost, |
| Post => X * Y / Y = X; |
| |
| procedure Lemma_Mult_Mod (X, Y : Big_Natural; B : Big_Positive) |
| with |
| Ghost, |
| -- The following subprogram variant can be added as soon as supported |
| -- Subprogram_Variant => (Decreases => Y), |
| Post => (X * Y) mod B = ((X mod B) * (Y mod B)) mod B; |
| |
| ----------------------------- |
| -- Local lemma null bodies -- |
| ----------------------------- |
| |
| procedure Lemma_Mod_Ident (A : Big_Natural; B : Big_Positive) is null; |
| procedure Lemma_Mod_Mod (A : Big_Integer; B : Big_Positive) is null; |
| procedure Lemma_Mult_Div (X : Big_Natural; Y : Big_Positive) is null; |
| |
| ------------------- |
| -- Lemma_Add_Mod -- |
| ------------------- |
| |
| procedure Lemma_Add_Mod (X, Y : Big_Natural; B : Big_Positive) is |
| Left : constant Big_Natural := (X + Y) mod B; |
| Right : constant Big_Natural := ((X mod B) + (Y mod B)) mod B; |
| XQuot : constant Big_Natural := X / B; |
| YQuot : constant Big_Natural := Y / B; |
| AQuot : constant Big_Natural := (X mod B + Y mod B) / B; |
| begin |
| if Y /= 0 and B > 1 then |
| pragma Assert (X = XQuot * B + X mod B); |
| pragma Assert (Y = YQuot * B + Y mod B); |
| pragma Assert |
| (Left = ((XQuot + YQuot) * B + X mod B + Y mod B) mod B); |
| pragma Assert (X mod B + Y mod B = AQuot * B + Right); |
| pragma Assert (Left = ((XQuot + YQuot + AQuot) * B + Right) mod B); |
| pragma Assert (Left = Right); |
| end if; |
| end Lemma_Add_Mod; |
| |
| ---------------------- |
| -- Lemma_Exp_Expand -- |
| ---------------------- |
| |
| procedure Lemma_Exp_Expand (A : Big_Integer; Exp : Natural) is |
| begin |
| if Exp rem 2 = 0 then |
| pragma Assert (Exp = Exp / 2 + Exp / 2); |
| else |
| pragma Assert (Exp = Exp / 2 + Exp / 2 + 1); |
| pragma Assert (A ** Exp = A ** (Exp / 2) * A ** (Exp / 2 + 1)); |
| pragma Assert (A ** (Exp / 2 + 1) = A ** (Exp / 2) * A); |
| pragma Assert (A ** Exp = A ** (Exp / 2) * A ** (Exp / 2) * A); |
| end if; |
| end Lemma_Exp_Expand; |
| |
| ------------------- |
| -- Lemma_Exp_Mod -- |
| ------------------- |
| |
| procedure Lemma_Exp_Mod (A : Big_Natural; Exp : Natural; B : Big_Positive) |
| is |
| begin |
| if Exp /= 0 then |
| declare |
| Left : constant Big_Integer := ((A mod B) ** Exp) mod B; |
| Right : constant Big_Integer := (A ** Exp) mod B; |
| begin |
| Lemma_Mult_Mod (A mod B, (A mod B) ** (Exp - 1), B); |
| Lemma_Mod_Mod (A, B); |
| Lemma_Exp_Mod (A, Exp - 1, B); |
| Lemma_Mult_Mod (A, A ** (Exp - 1), B); |
| pragma Assert (Left = Right); |
| end; |
| end if; |
| end Lemma_Exp_Mod; |
| |
| -------------------- |
| -- Lemma_Mult_Mod -- |
| -------------------- |
| |
| procedure Lemma_Mult_Mod (X, Y : Big_Natural; B : Big_Positive) is |
| Left : constant Big_Natural := (X * Y) mod B; |
| Right : constant Big_Natural := ((X mod B) * (Y mod B)) mod B; |
| begin |
| if Y /= 0 and B > 1 then |
| Lemma_Add_Mod (X * (Y - 1), X, B); |
| Lemma_Mult_Mod (X, Y - 1, B); |
| Lemma_Mod_Mod (X, B); |
| Lemma_Add_Mod ((X mod B) * ((Y - 1) mod B), X mod B, B); |
| Lemma_Add_Mod (Y - 1, 1, B); |
| pragma Assert (((Y - 1) mod B + 1) mod B = Y mod B); |
| if (Y - 1) mod B + 1 < B then |
| Lemma_Mod_Ident ((Y - 1) mod B + 1, B); |
| Lemma_Mod_Mod ((X mod B) * (Y mod B), B); |
| pragma Assert (Left = Right); |
| else |
| pragma Assert (Y mod B = 0); |
| pragma Assert ((X * Y) mod B = (X * Y) - (X * Y) / B * B); |
| pragma Assert |
| ((X * Y) mod B = (X * Y) - (X * (Y / B) * B) / B * B); |
| Lemma_Mult_Div (X * (Y / B), B); |
| pragma Assert (Left = 0); |
| pragma Assert (Left = Right); |
| end if; |
| end if; |
| end Lemma_Mult_Mod; |
| |
| ----------------- |
| -- Exp_Modular -- |
| ----------------- |
| |
| function Exp_Modular |
| (Left : Unsigned; |
| Modulus : Unsigned; |
| Right : Natural) return Unsigned |
| is |
| Result : Unsigned := 1; |
| Factor : Unsigned := Left; |
| Exp : Natural := Right; |
| |
| function Mult (X, Y : Unsigned) return Unsigned is |
| (Unsigned (Long_Long_Unsigned (X) * Long_Long_Unsigned (Y) |
| mod Long_Long_Unsigned (Modulus))) |
| with |
| Pre => Modulus /= 0; |
| -- Modular multiplication. Note that we can't take advantage of the |
| -- compiler's circuit, because the modulus is not known statically. |
| |
| -- Local ghost variables, functions and lemmas |
| |
| M : constant Big_Positive := Big (Modulus) with Ghost; |
| |
| function Equal_Modulo (X, Y : Big_Integer) return Boolean is |
| (X mod M = Y mod M) |
| with |
| Ghost, |
| Pre => Modulus /= 0; |
| |
| procedure Lemma_Mult (X, Y : Unsigned) |
| with |
| Ghost, |
| Post => Big (Mult (X, Y)) = (Big (X) * Big (Y)) mod M |
| and then Big (Mult (X, Y)) < M; |
| |
| procedure Lemma_Mult (X, Y : Unsigned) is null; |
| |
| Rest : Big_Integer with Ghost; |
| -- Ghost variable to hold Factor**Exp between Exp and Factor updates |
| |
| begin |
| pragma Assert (Modulus /= 1); |
| |
| -- We use the standard logarithmic approach, Exp gets shifted right |
| -- testing successive low order bits and Factor is the value of the |
| -- base raised to the next power of 2. |
| |
| -- Note: it is not worth special casing the cases of base values -1,0,+1 |
| -- since the expander does this when the base is a literal, and other |
| -- cases will be extremely rare. |
| |
| if Exp /= 0 then |
| loop |
| pragma Loop_Invariant (Exp > 0); |
| pragma Loop_Invariant (Result < Modulus); |
| pragma Loop_Invariant (Equal_Modulo |
| (Big (Result) * Big (Factor) ** Exp, Big (Left) ** Right)); |
| pragma Loop_Variant (Decreases => Exp); |
| pragma Annotate |
| (CodePeer, False_Positive, |
| "validity check", "confusion on generated code"); |
| |
| if Exp rem 2 /= 0 then |
| pragma Assert |
| (Big (Factor) ** Exp |
| = Big (Factor) * Big (Factor) ** (Exp - 1)); |
| pragma Assert (Equal_Modulo |
| ((Big (Result) * Big (Factor)) * Big (Factor) ** (Exp - 1), |
| Big (Left) ** Right)); |
| Lemma_Mult_Mod (Big (Result) * Big (Factor), |
| Big (Factor) ** (Exp - 1), |
| Big (Modulus)); |
| Lemma_Mult (Result, Factor); |
| |
| Result := Mult (Result, Factor); |
| |
| Lemma_Mod_Ident (Big (Result), Big (Modulus)); |
| Lemma_Mod_Mod (Big (Factor) ** (Exp - 1), Big (Modulus)); |
| Lemma_Mult_Mod (Big (Result), |
| Big (Factor) ** (Exp - 1), |
| Big (Modulus)); |
| pragma Assert (Equal_Modulo |
| (Big (Result) * Big (Factor) ** (Exp - 1), |
| Big (Left) ** Right)); |
| Lemma_Exp_Expand (Big (Factor), Exp - 1); |
| pragma Assert (Exp / 2 = (Exp - 1) / 2); |
| end if; |
| |
| Lemma_Exp_Expand (Big (Factor), Exp); |
| |
| Exp := Exp / 2; |
| exit when Exp = 0; |
| |
| Rest := Big (Factor) ** Exp; |
| pragma Assert (Equal_Modulo |
| (Big (Result) * (Rest * Rest), Big (Left) ** Right)); |
| Lemma_Exp_Mod (Big (Factor) * Big (Factor), Exp, Big (Modulus)); |
| pragma Assert |
| ((Big (Factor) * Big (Factor)) ** Exp = Rest * Rest); |
| pragma Assert (Equal_Modulo |
| ((Big (Factor) * Big (Factor)) ** Exp, |
| Rest * Rest)); |
| Lemma_Mult (Factor, Factor); |
| |
| Factor := Mult (Factor, Factor); |
| |
| Lemma_Mod_Mod (Rest * Rest, Big (Modulus)); |
| Lemma_Mod_Ident (Big (Result), Big (Modulus)); |
| Lemma_Mult_Mod (Big (Result), Rest * Rest, Big (Modulus)); |
| Lemma_Mult_Mod (Big (Result), Big (Factor) ** Exp, |
| Big (Modulus)); |
| pragma Assert (Equal_Modulo |
| (Big (Result) * Big (Factor) ** Exp, Big (Left) ** Right)); |
| end loop; |
| |
| pragma Assert (Big (Result) = Big (Left) ** Right mod Big (Modulus)); |
| end if; |
| |
| return Result; |
| |
| end Exp_Modular; |
| |
| end System.Exp_Mod; |
