summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-02-13 13:21:17 +1100
committerJed Barber <jjbarber@y7mail.com>2017-02-13 13:21:17 +1100
commitea99441e0da927e5a40cf21311265c7e22974f12 (patch)
treef824f30ab5f475f0f9b5e8a619a36dc81ea83284 /src
parent835c2dffc539e277812925469c82662482e1bbc5 (diff)
Preference dedupe removed, bignum library obtained from internet (will be replaced later)
Diffstat (limited to 'src')
-rw-r--r--src/bundles.adb28
-rw-r--r--src/bundles.ads13
-rw-r--r--src/candidates-containers.ads2
-rw-r--r--src/crypto-asymmetric-prime_tables.ads193
-rw-r--r--src/crypto-asymmetric.ads32
-rw-r--r--src/crypto-types-big_numbers-binfield_utils.adb319
-rw-r--r--src/crypto-types-big_numbers-mod_utils.adb741
-rw-r--r--src/crypto-types-big_numbers-utils.adb704
-rw-r--r--src/crypto-types-big_numbers.adb921
-rw-r--r--src/crypto-types-big_numbers.ads399
-rw-r--r--src/crypto-types-random.adb72
-rw-r--r--src/crypto-types-random.ads41
-rw-r--r--src/crypto-types-random_source-file.adb144
-rw-r--r--src/crypto-types-random_source-file.ads50
-rw-r--r--src/crypto-types-random_source.adb55
-rw-r--r--src/crypto-types-random_source.ads27
-rw-r--r--src/crypto-types.adb944
-rw-r--r--src/crypto-types.ads357
-rw-r--r--src/crypto.ads25
-rw-r--r--src/rationals.adb78
-rw-r--r--src/rationals.ads12
21 files changed, 5084 insertions, 73 deletions
diff --git a/src/bundles.adb b/src/bundles.adb
index 50741ee..39c6cfa 100644
--- a/src/bundles.adb
+++ b/src/bundles.adb
@@ -5,17 +5,9 @@ package body Bundles is
procedure Add
(To : in out Bundle;
- Item : in Given_Prefs.Preference_Array)
- is
- use type Given_Prefs.Preference_Array;
+ Item : in Given_Prefs.Preference_Array) is
begin
- for P of To.Papers loop
- if P.Prefs = Item then
- P.How_Many := P.How_Many + 1;
- return;
- end if;
- end loop;
- To.Papers.Append ( (How_Many => 1, Prefs => Item) );
+ To.Papers.Append (Item);
end Add;
@@ -38,20 +30,21 @@ package body Bundles is
Position := Given_Prefs.Preference_Range'First;
while Position <= Given_Prefs.Preference_Range'Last and then
- P.Prefs (Position) /= From
+ P (Position) /= From
loop
Position := Position + 1;
end loop;
Position := Position + 1;
while Position <= Given_Prefs.Preference_Range'Last and then
- Excluded.Contains (P.Prefs (Position))
+ P (Position) /= Candidates.No_Candidate and then
+ Excluded.Contains (P (Position))
loop
Position := Position + 1;
end loop;
if Position <= Given_Prefs.Preference_Range'Last and then
- P.Prefs (Position) = To
+ P (Position) = To
then
Result.Papers.Append (P);
end if;
@@ -73,14 +66,9 @@ package body Bundles is
function Count_Papers
(This : in Bundle)
- return Natural
- is
- Result : Natural := 0;
+ return Natural is
begin
- for P of This.Papers loop
- Result := Result + P.How_Many;
- end loop;
- return Result;
+ return Integer (This.Papers.Length);
end Count_Papers;
diff --git a/src/bundles.ads b/src/bundles.ads
index 5a0c274..cea046e 100644
--- a/src/bundles.ads
+++ b/src/bundles.ads
@@ -55,19 +55,12 @@ private
use type Rationals.Fraction;
-
-
- type Paper_Lot is record
- How_Many : Positive := 1;
- Prefs : Given_Prefs.Preference_Array;
- end record;
+ use type Given_Prefs.Preference_Array;
package Paper_Vectors is new Ada.Containers.Vectors
- (Index_Type => Positive,
- Element_Type => Paper_Lot);
-
-
+ (Index_Type => Positive,
+ Element_Type => Given_Prefs.Preference_Array);
use type Paper_Vectors.Vector;
diff --git a/src/candidates-containers.ads b/src/candidates-containers.ads
index 142d1ca..60fe4cb 100644
--- a/src/candidates-containers.ads
+++ b/src/candidates-containers.ads
@@ -60,7 +60,7 @@ package Candidates.Containers is
package CandidateID_Sets is new Ada.Containers.Ordered_Sets
- (Element_Type => Extended_CandidateID);
+ (Element_Type => CandidateID);
subtype CandidateID_Set is CandidateID_Sets.Set;
diff --git a/src/crypto-asymmetric-prime_tables.ads b/src/crypto-asymmetric-prime_tables.ads
new file mode 100644
index 0000000..66eba8e
--- /dev/null
+++ b/src/crypto-asymmetric-prime_tables.ads
@@ -0,0 +1,193 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+
+with Crypto.Types;
+use Crypto.Types;
+
+package Crypto.Asymmetric.Prime_Tables is
+
+ One_Digit_Primes : constant array(Natural range <>) of Natural :=
+ (2, 3, 5, 7);
+
+ Two_Digit_Primes : constant array(Natural range <>) of Natural :=
+ (11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47,
+ 53, 59, 61, 67, 71, 73, 79, 83, 89, 97);
+
+ Three_Digit_Primes : constant array(Natural range <>) of Natural :=
+ ( 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163,
+ 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233,
+ 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311,
+ 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389,
+ 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463,
+ 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563,
+ 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641,
+ 643, 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719, 727,
+ 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811, 821,
+ 823, 827, 829, 839, 853, 857, 859, 863, 877, 881, 883, 887, 907,
+ 911, 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997);
+
+
+ Four_Digit_Primes : constant array(Natural range <>) of Natural :=
+ ( 1009, 1013, 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063,
+ 1069, 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151,
+ 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, 1229,
+ 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, 1297, 1301,
+ 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409,
+ 1423, 1427, 1429, 1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481,
+ 1483, 1487, 1489, 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553,
+ 1559, 1567, 1571, 1579, 1583, 1597, 1601, 1607, 1609, 1613, 1619,
+ 1621, 1627, 1637, 1657, 1663, 1667, 1669, 1693, 1697, 1699, 1709,
+ 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789,
+ 1801, 1811, 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879,
+ 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987,
+ 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063,
+ 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, 2131, 2137,
+ 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 2221, 2237, 2239,
+ 2243, 2251, 2267, 2269, 2273, 2281, 2287, 2293, 2297, 2309, 2311,
+ 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381, 2383, 2389,
+ 2393, 2399, 2411, 2417, 2423, 2437, 2441, 2447, 2459, 2467, 2473,
+ 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591,
+ 2593, 2609, 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677,
+ 2683, 2687, 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731,
+ 2741, 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819,
+ 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, 2909,
+ 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001, 3011,
+ 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, 3083, 3089, 3109,
+ 3119, 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209,
+ 3217, 3221, 3229, 3251, 3253, 3257, 3259, 3271, 3299, 3301, 3307,
+ 3313, 3319, 3323, 3329, 3331, 3343, 3347, 3359, 3361, 3371, 3373,
+ 3389, 3391, 3407, 3413, 3433, 3449, 3457, 3461, 3463, 3467, 3469,
+ 3491, 3499, 3511, 3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557,
+ 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637,
+ 3643, 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727,
+ 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, 3823,
+ 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, 3911, 3917,
+ 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, 4001, 4003, 4007,
+ 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073, 4079, 4091, 4093,
+ 4099, 4111, 4127, 4129, 4133, 4139, 4153, 4157, 4159, 4177, 4201,
+ 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261, 4271,
+ 4273, 4283, 4289, 4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373,
+ 4391, 4397, 4409, 4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481,
+ 4483, 4493, 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567,
+ 4583, 4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657,
+ 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, 4759,
+ 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, 4861, 4871,
+ 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, 4943, 4951, 4957,
+ 4967, 4969, 4973, 4987, 4993, 4999, 5003, 5009, 5011, 5021, 5023,
+ 5039, 5051, 5059, 5077, 5081, 5087, 5099, 5101, 5107, 5113, 5119,
+ 5147, 5153, 5167, 5171, 5179, 5189, 5197, 5209, 5227, 5231, 5233,
+ 5237, 5261, 5273, 5279, 5281, 5297, 5303, 5309, 5323, 5333, 5347,
+ 5351, 5381, 5387, 5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437,
+ 5441, 5443, 5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519,
+ 5521, 5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639,
+ 5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, 5701,
+ 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, 5801, 5807,
+ 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, 5861, 5867, 5869,
+ 5879, 5881, 5897, 5903, 5923, 5927, 5939, 5953, 5981, 5987, 6007,
+ 6011, 6029, 6037, 6043, 6047, 6053, 6067, 6073, 6079, 6089, 6091,
+ 6101, 6113, 6121, 6131, 6133, 6143, 6151, 6163, 6173, 6197, 6199,
+ 6203, 6211, 6217, 6221, 6229, 6247, 6257, 6263, 6269, 6271, 6277,
+ 6287, 6299, 6301, 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359,
+ 6361, 6367, 6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469,
+ 6473, 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571,
+ 6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, 6679,
+ 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, 6763, 6779,
+ 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, 6841, 6857, 6863,
+ 6869, 6871, 6883, 6899, 6907, 6911, 6917, 6947, 6949, 6959, 6961,
+ 6967, 6971, 6977, 6983, 6991, 6997, 7001, 7013, 7019, 7027, 7039,
+ 7043, 7057, 7069, 7079, 7103, 7109, 7121, 7127, 7129, 7151, 7159,
+ 7177, 7187, 7193, 7207, 7211, 7213, 7219, 7229, 7237, 7243, 7247,
+ 7253, 7283, 7297, 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369,
+ 7393, 7411, 7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489,
+ 7499, 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561,
+ 7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, 7649,
+ 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, 7727, 7741,
+ 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, 7841, 7853, 7867,
+ 7873, 7877, 7879, 7883, 7901, 7907, 7919, 7927, 7933, 7937, 7949,
+ 7951, 7963, 7993, 8009, 8011, 8017, 8039, 8053, 8059, 8069, 8081,
+ 8087, 8089, 8093, 8101, 8111, 8117, 8123, 8147, 8161, 8167, 8171,
+ 8179, 8191, 8209, 8219, 8221, 8231, 8233, 8237, 8243, 8263, 8269,
+ 8273, 8287, 8291, 8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369,
+ 8377, 8387, 8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467,
+ 8501, 8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597,
+ 8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, 8681,
+ 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, 8747, 8753,
+ 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, 8837, 8839, 8849,
+ 8861, 8863, 8867, 8887, 8893, 8923, 8929, 8933, 8941, 8951, 8963,
+ 8969, 8971, 8999, 9001, 9007, 9011, 9013, 9029, 9041, 9043, 9049,
+ 9059, 9067, 9091, 9103, 9109, 9127, 9133, 9137, 9151, 9157, 9161,
+ 9173, 9181, 9187, 9199, 9203, 9209, 9221, 9227, 9239, 9241, 9257,
+ 9277, 9281, 9283, 9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349,
+ 9371, 9377, 9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437,
+ 9439, 9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533,
+ 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, 9643,
+ 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733, 9739, 9743,
+ 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, 9817, 9829, 9833,
+ 9839, 9851, 9857, 9859, 9871, 9883, 9887, 9901, 9907, 9923, 9929,
+ 9931, 9941, 9949, 9967, 9973);
+
+
+ -- binary field squaring tables
+
+ T8 : constant array (0..15) of Byte :=
+ (0, 1, 4, 5, 16, 17, 20, 21, 64, 65, 68, 69, 80, 81, 84, 85);
+
+ T16 : constant array (Byte) of DByte :=
+ (
+ 0, 1, 4, 5, 16, 17, 20, 21,
+ 64, 65, 68, 69, 80, 81, 84, 85,
+ 256, 257, 260, 261, 272, 273, 276, 277,
+ 320, 321, 324, 325, 336, 337, 340, 341,
+ 1024, 1025, 1028, 1029, 1040, 1041, 1044, 1045,
+ 1088, 1089, 1092, 1093, 1104, 1105, 1108, 1109,
+ 1280, 1281, 1284, 1285, 1296, 1297, 1300, 1301,
+ 1344, 1345, 1348, 1349, 1360, 1361, 1364, 1365,
+ 4096, 4097, 4100, 4101, 4112, 4113, 4116, 4117,
+ 4160, 4161, 4164, 4165, 4176, 4177, 4180, 4181,
+ 4352, 4353, 4356, 4357, 4368, 4369, 4372, 4373,
+ 4416, 4417, 4420, 4421, 4432, 4433, 4436, 4437,
+ 5120, 5121, 5124, 5125, 5136, 5137, 5140, 5141,
+ 5184, 5185, 5188, 5189, 5200, 5201, 5204, 5205,
+ 5376, 5377, 5380, 5381, 5392, 5393, 5396, 5397,
+ 5440, 5441, 5444, 5445, 5456, 5457, 5460, 5461,
+ 16384, 16385, 16388, 16389, 16400, 16401, 16404, 16405,
+ 16448, 16449, 16452, 16453, 16464, 16465, 16468, 16469,
+ 16640, 16641, 16644, 16645, 16656, 16657, 16660, 16661,
+ 16704, 16705, 16708, 16709, 16720, 16721, 16724, 16725,
+ 17408, 17409, 17412, 17413, 17424, 17425, 17428, 17429,
+ 17472, 17473, 17476, 17477, 17488, 17489, 17492, 17493,
+ 17664, 17665, 17668, 17669, 17680, 17681, 17684, 17685,
+ 17728, 17729, 17732, 17733, 17744, 17745, 17748, 17749,
+ 20480, 20481, 20484, 20485, 20496, 20497, 20500, 20501,
+ 20544, 20545, 20548, 20549, 20560, 20561, 20564, 20565,
+ 20736, 20737, 20740, 20741, 20752, 20753, 20756, 20757,
+ 20800, 20801, 20804, 20805, 20816, 20817, 20820, 20821,
+ 21504, 21505, 21508, 21509, 21520, 21521, 21524, 21525,
+ 21568, 21569, 21572, 21573, 21584, 21585, 21588, 21589,
+ 21760, 21761, 21764, 21765, 21776, 21777, 21780, 21781,
+ 21824, 21825, 21828, 21829, 21840, 21841, 21844, 21845
+ );
+
+
+
+ end Crypto.Asymmetric.Prime_Tables;
diff --git a/src/crypto-asymmetric.ads b/src/crypto-asymmetric.ads
new file mode 100644
index 0000000..34fbc30
--- /dev/null
+++ b/src/crypto-asymmetric.ads
@@ -0,0 +1,32 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+--with Crypto;
+
+package Crypto.Asymmetric is
+
+ Invalid_Public_Key_Error : exception;
+ Invalid_Private_Key_Error : exception;
+ Plaintext_Too_Long_Error : exception;
+ Decrypt_Error : exception;
+
+end Crypto.Asymmetric;
diff --git a/src/crypto-types-big_numbers-binfield_utils.adb b/src/crypto-types-big_numbers-binfield_utils.adb
new file mode 100644
index 0000000..5835b6d
--- /dev/null
+++ b/src/crypto-types-big_numbers-binfield_utils.adb
@@ -0,0 +1,319 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+
+-- Most algorithms based on Kankerson, Menezes and Vanstones
+-- "Guide to Elliptic Curve Cryptograpyh" (ISBN: 0-387-95273-x)
+
+
+-- f(z) = 2^m + r(z)
+-- R is the binary representation of r(z)
+
+with Crypto.Asymmetric.Prime_Tables;
+
+
+separate(Crypto.Types.Big_Numbers)
+
+package body Binfield_Utils is
+
+ function B_Mod(Left : D_Big_Unsigned; Right : Big_Unsigned)
+ return Big_Unsigned;
+
+ function "xor"(Left, Right: D_Big_Unsigned) return D_Big_Unsigned;
+
+ procedure Set_Last_Index(X : in out D_Big_Unsigned);
+
+ ---------------------------------------------------------------------------
+
+ pragma Optimize (Time);
+ use Crypto.Asymmetric.Prime_Tables;
+
+ -- compute: a(z) + b(z) mod f(z)
+ function B_Add(Left,Right : Big_Unsigned) return Big_Unsigned is
+ N : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index);
+ C : Big_Unsigned;
+ begin
+ for I in 0..N loop
+ C.Number(I) := Left.Number(i) xor Right.Number(I);
+ end loop;
+
+ for I in reverse 0..N loop
+ if C.Number(I) /= 0 then
+ C.Last_Index :=I;
+ exit;
+ end if;
+ end loop;
+
+ return C;
+ end B_Add;
+
+ ---------------------------------------------------------------------------
+
+
+ -- compute: a(z) - b(z) mod f(z)
+ -- in binary field is -a = a. so a - b = a + (-b) = a + b
+ function B_Sub(Left,Right : Big_Unsigned) return Big_Unsigned is
+ begin
+ return B_Add(Left,Right);
+ end B_Sub;
+
+
+ ---------------------------------------------------------------------------
+
+ -- compute: a(z)* z mod f(Z)
+ function B_Mult(A, F : Big_Unsigned)
+ return Big_Unsigned is
+ C : Big_Unsigned;
+ M : constant Positive := Bit_Length(F)-1;
+ N : Natural:= M/Word'Size;
+ begin
+ C := Shift_Left(A,1);
+
+ if C.Last_Index = N then
+ N:=M mod Word'Size;
+
+ if (Shift_Right(C.Number(C.Last_Index),N)) = 1 then
+ C := B_Add(C,F);
+ end if;
+ end if;
+ return C;
+
+ end B_Mult;
+
+ ---------------------------------------------------------------------------
+
+
+ --Algorithm 2.34: Right to left comb method for polynominal multiplication
+ -- compute: a(z)*b(z) mod f(Z)
+ function B_Mult(Left, Right, F : Big_Unsigned) return Big_Unsigned is
+ C : D_Big_Unsigned;
+ B : Big_Unsigned := Right;
+ -- N : constant Natural := Bit_Length(F);
+ begin
+ for K in 0..Word'Size-1 loop
+ for J in 0..Left.Last_Index loop
+ if (Shift_Right(Left.Number(J),K) and 1) = 1 then
+ -- add B to C{i}
+ for I in J..(J+B.Last_Index) loop
+ C.Number(I) := C.Number(I) xor B.Number(I-J);
+ end loop;
+ end if;
+ end loop;
+ if K /= Word'Size-1 then
+ B:=B_Mult(B,F);
+ end if;
+ end loop;
+
+ Set_Last_Index(C);
+
+ return B_Mod(C,F);
+
+ end B_Mult;
+
+ ---------------------------------------------------------------------------
+
+ -- Algorithm 2.39: Polynominal squaring (with wordlength W=8)
+ -- compute a(z)**2 mod f(z) on a 8 bit processor
+ -- function B_Square8(A, F : Big_Unsigned) return Big_Unsigned is
+ -- C : D_Big_Unsigned;
+ -- L : Natural;
+ -- begin
+ -- for I in 0..A.Last_Index loop
+ -- L := 2*I;
+ -- C.Number(L) := Word(T8(Natural(A.Number(I) and 15)));
+ -- L:= L+1;
+ -- C.Number(L) :=
+ -- Word(T8(Natural(Shift_Right(A.Number(I),4) and 15)));
+ -- end loop;
+
+ -- Set_Last_Index(C);
+
+ -- return B_Mod(C,F);
+ -- end B_Square8;
+
+ -------------------------------------------------------------------------
+
+ -- Algorithm 2.39: Polynominal squaring (with word length W=n*8 for n=>0)
+ -- compute a(z)**2 mod f(z)
+ function B_Square(A, F : Big_Unsigned) return Big_Unsigned is
+ K : constant Natural := Word'Size/8;
+ N : constant Natural := K/2-1;
+ --M : constant Natural := Bit_Length(F);
+ L : Natural;
+ C : D_Big_Unsigned;
+ begin
+ for I in 0..A.Last_Index loop
+ L := 2*I;
+ for J in reverse 0..N loop
+ C.Number(L) := Shift_Left(C.Number(L),16) xor
+ Word(T16(Byte(Shift_Right(A.Number(I),8*J) and 255)));
+ end loop;
+ L:= L+1;
+ for J in reverse K/2..K-1 loop
+ C.Number(L) := Shift_Left(C.Number(L),16) xor
+ Word(T16(Byte(Shift_Right(A.Number(I),8*J) and 255)));
+ end loop;
+ end loop;
+ Set_Last_Index(C);
+
+ return B_Mod(C,F);
+ end B_Square;
+
+--------------------------------------------------------------------------
+
+ -- It' my own secret "blow and cut" technic. ;-)
+ -- compute left(z) mod right(z)
+ function B_Mod(Left, Right : Big_Unsigned) return Big_Unsigned is
+ A : Natural := Bit_Length(Left);
+ B : constant Natural := Bit_Length(Right);
+ Result : Big_Unsigned;
+ begin
+ if A < B or B=0 then
+ Result.Last_Index := Left.Last_Index;
+ Result.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index);
+ else
+ while A >= B loop
+ Result := Shift_Left(Right,A-B) xor Right;
+ A := Bit_Length(Result);
+ end loop;
+ end if;
+ return Result;
+ end B_Mod;
+
+
+
+ --------------------------------------------------------------------------
+
+ -- Algorithm 2.49: Binary algorithm for inversion in F_{2^m}
+ -- computes a(z)^{-1}
+ function B_Inverse(X, F : Big_Unsigned) return Big_Unsigned is
+ U : Big_Unsigned := X;
+ V : Big_Unsigned := F;
+ G1 : Big_Unsigned := Big_Unsigned_One;
+ G2 : Big_Unsigned;
+ begin
+ if X = Big_Unsigned_Zero or F = Big_Unsigned_Zero then
+ return F;
+ end if;
+
+ while U /= Big_Unsigned_One and V /= Big_Unsigned_One loop
+
+ while Is_Even(U) loop
+ U := Shift_Right(U,1);
+ if Is_Even(G1) then
+ G1 := Shift_Right(G1,1);
+ else
+ G1 := Shift_Right(B_Add(G1,F),1);
+ end if;
+ end loop;
+
+ while Is_Even(V) loop
+ V := Shift_Right(V,1);
+ if Is_Even(G2) then
+ G2 := Shift_Right(G2,1);
+ else
+ G2 := Shift_Right(B_Add(G2,F),1);
+ end if;
+ end loop;
+
+ if Bit_Length(U) > Bit_Length(V) then
+ U := B_Add(U,V);
+ G1 := B_Add(G1,G2);
+ else
+ V := B_Add(V,U);
+ G2 := B_Add(G2,G1);
+ end if;
+ end loop;
+ if U = Big_Unsigned_One then
+ return G1;
+ else
+ return G2;
+ end if;
+ end B_Inverse;
+
+ --------------------------------------------------------------------------
+
+ function B_Div(Left, Right, F : Big_Unsigned) return Big_Unsigned is
+ R : constant Big_Unsigned := B_Inverse(Right, F);
+ begin
+ return B_Mult(Left,R,F);
+ end B_Div;
+
+ --------------------------------------------------------------------------
+ --------------------------------------------------------------------------
+
+ function B_Mod(Left : D_Big_Unsigned; Right : Big_Unsigned)
+ return Big_Unsigned is
+ A : Natural := Bit_Length(Left);
+ B : constant Natural := Bit_Length(Right);
+ Result : Big_Unsigned;
+ begin
+ if A < B or B=0 then
+ Result.Last_Index := Left.Last_Index;
+ Result.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index);
+ else
+ declare
+ T : D_Big_Unsigned := Left;
+ Z : D_Big_Unsigned;
+ begin
+ Z.Last_Index := Right.Last_Index;
+ Z.Number(0..Right.Last_Index) := Right.Number(0..Right.Last_Index);
+ while A >= B loop
+ T := Shift_Left(Z,A-B) xor T;
+ A := Bit_Length(T);
+ end loop;
+ Result.Last_Index := T.Last_Index;
+ Result.Number(0..T.Last_Index) := T.Number(0..T.Last_Index);
+ end;
+ end if;
+ return Result;
+ end B_Mod;
+
+
+ --------------------------------------------------------------------------
+
+ function "xor"(Left, Right: D_Big_Unsigned) return D_Big_Unsigned is
+ Result : D_Big_Unsigned;
+ M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index);
+ begin
+ for I in 0..M loop
+ Result.Number(I) := Left.Number(I) xor Right.Number(I);
+ end loop;
+ Set_Last_Index(Result);
+
+ return Result;
+ end "xor";
+
+
+ --------------------------------------------------------------------------
+
+ procedure Set_Last_Index(X : in out D_Big_Unsigned) is
+ begin
+ for I in reverse 0..D_Max_Length loop
+ if X.Number(I) /= 0 then
+ X.Last_Index :=I;
+ exit;
+ end if;
+ end loop;
+ end Set_Last_Index; pragma Inline(Set_Last_Index);
+
+end Binfield_Utils;
diff --git a/src/crypto-types-big_numbers-mod_utils.adb b/src/crypto-types-big_numbers-mod_utils.adb
new file mode 100644
index 0000000..3c02df1
--- /dev/null
+++ b/src/crypto-types-big_numbers-mod_utils.adb
@@ -0,0 +1,741 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+with Crypto.Types.Random;
+with Crypto.Asymmetric.Prime_Tables;
+--with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
+with Ada.Text_IO;
+
+separate(Crypto.Types.Big_Numbers)
+
+package body Mod_Utils is
+
+ pragma Optimize (Time);
+ use Crypto.Asymmetric.Prime_Tables;
+
+
+ ---------------------------------------------------------------------------
+
+ function Patch(Item, N : Big_Unsigned)
+ return Big_Unsigned is
+ Diff : constant Big_Unsigned:=((Big_Unsigned_Last - N) + 1) mod N;
+ begin
+ return Add(Item,Diff,N);
+ end Patch; pragma Inline(Patch);
+
+ ---------------------------------------------------------------------------
+
+ function Add(Left, Right, N : Big_Unsigned) return Big_Unsigned is
+ L : constant Big_Unsigned := Left mod N;
+ R : constant Big_Unsigned := Right mod N;
+ Result : constant Big_Unsigned := L + R;
+ begin
+ if Result < Max(L,R) then
+ return Patch(Result,N);
+ else return
+ Result mod N;
+ end if;
+ end Add;
+
+ ---------------------------------------------------------------------------
+
+ function Sub(Left, Right, N : Big_Unsigned) return Big_Unsigned is
+ L : constant Big_Unsigned := Left mod N;
+ R : constant Big_Unsigned := Right mod N;
+ begin
+ if R > L then
+ return N - R + L;
+ else return L-R;
+ end if;
+ end Sub;
+
+ ---------------------------------------------------------------------------
+
+ function Div(Left, Right, N : Big_Unsigned) return Big_Unsigned is
+ begin
+ return Mult(Left,Inverse(Right,N),N);
+ end Div; pragma Inline(Div);
+
+
+ ---------------------------------------------------------------------------
+
+ --from Erik-Zenners handout "Zahlentheoretische Algorithmen"
+ function Pow(Base, Exponent, N : Big_Unsigned) return Big_Unsigned is
+ L : constant Big_Unsigned := Base mod N;
+ R : constant Big_Unsigned := Exponent;
+ Result : Big_Unsigned := Big_Unsigned_One;
+ begin
+ if L = Big_Unsigned_Zero or L = Big_Unsigned_One then
+ return L;
+ elsif R = Big_Unsigned_Zero then return Big_Unsigned_One;
+ else
+ -- Square_And_Muliply
+ for I in reverse 0..Bit_Length(R)-1 loop
+ Result := Mult(Result,Result,N);
+ if (Shift_Right(R, I) mod 2) = Big_Unsigned_One then
+ Result := Mult(Result,L,N);
+ end if;
+ end loop;
+ return Result mod N;
+ end if;
+ end Pow;
+
+ ---------------------------------------------------------------------------
+
+ --based on Erik-Zenners handout "Zahlentheoretische Algorithmen"
+ -- (ext. Euklid)
+ -- This function returns Big_unsigned_Zero if X have no inverse mod n
+ function Inverse(X, N : Big_Unsigned) return Big_Unsigned is
+ B : Big_Unsigned := X mod N;
+ A : Big_Unsigned := N;
+ begin
+ -- if gcd(A,B) /= 1 then A have no inverse mod B
+ if B = Big_Unsigned_Zero or A = Big_Unsigned_Zero or
+ Gcd(A,B) /= Big_Unsigned_One then
+ return Big_Unsigned_Zero;
+ end if;
+
+ declare
+ T : Big_Unsigned := Big_Unsigned_One;
+ Tstrich, Tempt : Big_Unsigned;
+ Q, R : Big_Unsigned;
+ begin
+ loop
+ Big_Div(A,B,Q,R);
+ if(R = Big_Unsigned_Zero) then
+ return T;
+ end if;
+
+ A:=B;
+ B:=R;
+
+ Tempt:=T;
+
+ T:=Sub(Tstrich,Mult(Q,T,N),N);
+
+ Tstrich:=Tempt;
+ end loop;
+ end;
+ end Inverse;
+
+ ---------------------------------------------------------------------------
+
+ function Get_Random(N : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ Random.Read(Result.Number);
+
+ for I in reverse 0..N.Last_Index loop
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+ return Result mod N ;
+ end Get_Random;
+
+ ---------------------------------------------------------------------------
+
+ -- this function returns true if X is a Mersenne prim number
+ function Lucas_Lehmer_Test(X : Big_Unsigned) return Boolean is
+ Is_Mp : Boolean := false;
+ begin
+
+ if X.Last_Index = 0 then
+ for I in 2..Word'Size-1 loop
+ if X.Number(0) = Shift_Left(2,I)-1 then
+ Is_Mp := True;
+ exit;
+ end if;
+ end loop;
+ if Is_Mp = False then return False;
+ end if;
+ else
+ for I in 0..X.Last_Index loop
+ if X.Number(I) /= Word'Last then return False;
+ end if;
+ end loop;
+ end if;
+
+ declare
+ P : constant Word := Word(Bit_Length(X)-1);
+ S : Big_Unsigned := Big_Unsigned_Two+2; --S(1) = 4;
+ begin
+ for I in 2..P-1 loop
+ S := (Mult(S,S,X) - 2) mod X;
+ end loop;
+
+ if S = Big_Unsigned_Zero then return True;
+ else return False;
+ end if;
+ end;
+ end Lucas_Lehmer_Test;
+
+ ---------------------------------------------------------------------------
+
+ --from Erik-Zenners handout "Zahlentheoretische Algorithmen"
+ function Is_Miller_Rabin_Witness(Wit, X : Big_Unsigned) return Boolean is
+
+ B : constant Big_Unsigned := X-1;
+ Result : Big_Unsigned := Big_Unsigned_One;
+ Root : Big_Unsigned;
+ begin
+ for I in reverse 0..Bit_Length(B)-1 loop
+ Root := Result;
+ Result := Mult(Result, Result, X);
+ if ((Result = Big_Unsigned_One) and
+ (Root /= Big_Unsigned_One and Root /= B)) then return True;
+ elsif (Shift_Right(B,I) mod 2) = Big_Unsigned_One then
+ Result := Mult(Result, Wit, X);
+ end if;
+ end loop;
+ if Result /= Big_Unsigned_One then return True;
+ else return False;
+ end if;
+ end Is_Miller_Rabin_Witness;
+
+ ---------------------------------------------------------------------------
+
+ -- Test if Wit is a witness for N
+ -- If Wit is a wittness then N is no prime
+ function Is_Simple_Witness(Wit, N : Big_Unsigned) return Boolean is
+ begin
+ -- is Wit a "Miller-Rabin"-witness
+ if (Wit /= (N-Big_Unsigned_One)) and (Wit /= Big_Unsigned_One) and
+ Mult(Wit,Wit,N) = Big_Unsigned_One then return True;
+
+ elsif Gcd(Wit,N) /= Big_Unsigned_One then return True;
+
+ -- is Wit a "Fermat-Witness"
+ -- elsif Pow(Wit,N-1,N) /= Big_Unsigned_One then return True;
+ else return False;
+ end if;
+ end Is_Simple_Witness;
+
+ ---------------------------------------------------------------------------
+
+
+ -- Returns true if N passes the specified number of Miller-Rabin tests.
+ function Passed_Miller_Rabin_Test(X : Big_Unsigned; S : Positive)
+ return Boolean is
+ Witness : Big_Unsigned;
+ begin
+ -- Do the tests
+ for I in 1..S loop
+ -- Generate a uniform random on (1, X)
+ loop
+ Witness := Get_Random(X);
+ exit when Witness > Big_Unsigned_One;
+ end loop;
+ if Is_Miller_Rabin_Witness(Witness, X) then
+ return False;
+ end if;
+ end loop;
+ return true;
+ end Passed_Miller_Rabin_Test;
+
+ ---------------------------------------------------------------------------
+
+ function Pass_Prime_Test(X : Big_Unsigned; Status : Hardness)
+ return Boolean is
+ Rounds : Natural;
+ X_Bit_Size : constant Natural := Bit_Length(X);
+ begin
+ if X < Big_Unsigned_Two then return False;
+ elsif Is_Even(X) then
+ if X = Big_Unsigned_Two then return True;
+ else return False;
+ end if;
+ end if;
+
+ --X is odd
+
+ for I in One_Digit_Primes'First+1..One_Digit_Primes'Last loop
+ if X = Word(One_Digit_Primes(I)) then return true;
+ elsif X mod Word(One_Digit_Primes(I)) = Big_Unsigned_Zero then
+ return False;
+ end if;
+ end loop;
+
+ for I in Two_Digit_Primes'Range loop
+ if X = Word(Two_Digit_Primes(I)) then return true;
+ elsif X mod Word(Two_Digit_Primes(I)) = Big_Unsigned_Zero then
+ return False;
+ end if;
+ end loop;
+
+ if Lucas_Lehmer_Test(X) then
+ return True;
+ end if;
+
+ for I in Three_Digit_Primes'Range loop
+ if X = Word(Three_Digit_Primes(I)) then return true;
+ elsif X mod Word(Three_Digit_Primes(I)) = Big_Unsigned_Zero then
+ return False;
+ end if;
+ end loop;
+
+ -- The relationship between the certainty and the number of rounds
+ -- we perform is given in the draft standard ANSI X9.80, "PRIME
+ -- NUMBER GENERATION, PRIMALITY TESTING, AND PRIMALITY CERTIFICATES".
+ -- Comment:
+ -- I don't have a look on this paper. =:) I borrowed this
+ -- "algorithmen" from the j2sdk1.4.1 library (java/math/BigInteger.java)
+ -- If you have the permission to send me the draft standard ANSI X9.80
+ -- then send it, please!
+ -- I'm a student. I have no money for ANSI or IEEE drafts. :-(
+ -- It's right to require money to read a draft?
+ -- This really really sucks! SCNR!
+
+ if (X_Bit_Size < 100) then Rounds := 50;
+ elsif (X_Bit_Size < 256) then Rounds := 27;
+ elsif (X_Bit_Size < 512) then Rounds := 15;
+ elsif (X_Bit_Size < 768) then Rounds := 8;
+ elsif (X_Bit_Size < 1024) then Rounds := 4;
+ else Rounds := 2;
+ end if;
+
+ declare
+ Witness : Big_Unsigned;
+ begin
+ if Status = Weak then
+ for I in 1..Rounds loop
+ loop
+ Witness := Get_Random(X);
+ exit when Witness > Big_Unsigned_Two;
+ end loop;
+ if Is_Simple_Witness(Witness,X) then return False;
+ end if;
+ end loop;
+ else
+ for I in 1..Rounds loop
+ loop
+ Witness := Get_Random(X);
+ exit when Witness > Big_Unsigned_Two;
+ end loop;
+ if Is_Miller_Rabin_Witness(Witness,X) then return False;
+ end if;
+ end loop;
+ end if;
+ end;
+ return True;
+ end Pass_Prime_Test;
+
+ ---------------------------------------------------------------------------
+
+
+ function Is_Prime(X : Big_Unsigned) return Boolean is
+ begin
+ return Pass_Prime_Test(X, Strong);
+ end Is_Prime; pragma Inline (Is_Prime);
+
+ ---------------------------------------------------------------------------
+
+ -- This function is faster then Is_prime but a lot of no strong pseudo
+ -- primes pass this test
+ function Looks_Like_A_Prime(X : Big_Unsigned) return Boolean is
+ begin
+ return Pass_Prime_Test(X, Weak);
+ end Looks_Like_A_Prime; pragma Inline(Looks_Like_A_Prime);
+
+ ---------------------------------------------------------------------------
+
+ function Get_Prime(N : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned := Get_Random(N);
+ begin
+ if N <= Big_Unsigned_Two then
+ raise Constraint_Error;
+ end if;
+
+ -- make sure that Result is odd
+ Result.Number(0) := Result.Number(0) or 1;
+ loop
+ if Is_Prime(Result) then return Result;
+ else Result := (Result+2) mod N ;
+ end if;
+ end loop;
+ end Get_Prime;
+
+
+ ---------------------------------------------------------------------------
+
+
+ function "mod"(Left : D_Big_Unsigned; Right : Big_Unsigned)
+ return Big_Unsigned;
+
+ ---------------------------------------------------------------------------
+
+ -- Result = Left * Right (mod N)
+ function Mult(Left, Right, N : Big_Unsigned) return Big_Unsigned is
+ T : DWord;
+ Carry : Word := 0;
+ R : D_Big_Unsigned;
+ begin
+ for I in 0..Left.Last_Index loop
+ for J in 0..Right.Last_Index loop
+ T := DWord(Left.Number(I)) * DWord(Right.Number(J))
+ + DWord(R.Number(I+J)) + DWord(Carry);
+
+ R.Number(I+J) := Word(T and DWord(Word'Last));
+
+ Carry:= Word(Shift_Right(T,Word'Size));
+ end loop;
+ R.Number(I+Right.Last_Index+1) := Carry +
+ R.Number(I+Right.Last_Index+1);
+ Carry := 0;
+ end loop;
+
+ for I in reverse 0..D_Max_Length loop
+ if R.Number(I) /= 0 then
+ R.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+ return R mod N;
+ end Mult;
+
+ ---------------------------------------------------------------------------
+
+
+ -- Returns a probability N-bit prime (Result).
+ function Get_N_Bit_Prime(N : Positive) return Big_Unsigned is
+ J : Big_Unsigned := Get_Random(Shift_Left(Big_Unsigned_One,N-2));
+ Index : constant Natural := (N-1)/Word'Size;
+ Amount : constant Natural := (N-1) mod Word'Size;
+ Result : Big_Unsigned := Shift_Left(J,1);
+
+ begin
+ if N = 1 or N > Size then
+ raise Constraint_Error;
+ end if;
+
+ loop
+ -- Make sure that Result is an odd
+ Set_Least_Significant_Bit (Result);
+
+ -- Make sure that Result is a N-Bit-Number;
+ Result.Number (Index) := Result.Number (Index) or
+ Shift_Left (Word (1), Amount);
+
+ if Amount = 0 then
+ Result.Last_Index := Index;
+ end if;
+
+ if Is_Prime(Result) then
+ return Result;
+ else
+ Result:=Result-2;
+ if Is_Prime(Result) then
+ return Result;
+ end if;
+ end if;
+
+ J := Get_Random (Shift_Left (Big_Unsigned_One, N - 2));
+ Result := Shift_Left (J, 1);
+ end loop;
+
+ end Get_N_Bit_Prime;
+
+ ---------------------------------------------------------------------------
+
+ -- computes the jacobi-symbol
+ -- return value:
+ -- 0 : if X mod N = 0
+ -- 1 : if X is a quadratic resuide mod N
+ -- -1 : if X is a quadratic non-resuide mod N
+
+ function Jacobi(X, N : Big_Unsigned) return Integer is
+ A : Big_Unsigned := X mod N;
+ begin
+
+ if Is_Even(N) then
+ raise Constraint_Error;
+ end if;
+
+ if N = Big_Unsigned_One then return 1;
+ elsif A = Big_Unsigned_Zero then return 0;
+ elsif A = Big_Unsigned_One then return 1;
+ end if;
+
+ while (A mod 4) = Big_Unsigned_Zero loop
+ exit when (A mod 4) = Big_Unsigned_Zero;
+ A := Shift_Right(A,2);
+ end loop;
+
+ if Is_Even(A) then
+ if (N mod 8 = 1) or (N mod 8 = 7) then
+ return Jacobi(Shift_Right(A,1),N);
+ else return -1*Jacobi(Shift_Right(A,1),N);
+ end if;
+ else
+ if (A mod 4 = 1) or (N mod 4 = 1) then
+ return Jacobi(N mod A, A);
+ else return -1*Jacobi(N mod A, A);
+ end if;
+ end if;
+ end Jacobi;
+
+ ----------------------------------------------------------------------------
+ -----------------------------DOUBLE_SIZE------------------------------------
+ ----------------------------------------------------------------------------
+
+ --only needed for multiplication mod N
+ --here we need 2*Size-bit numbers to avoid an overflow because
+ --if one of our provisional result t > BIG_Unsigned_Last
+ --then there ist no well known algortihm to compute the
+ -- result of an multiplication mod m
+
+ -- same algorithm for D_Big_Unsigned as for Big_Unsigned
+
+ function "="(Left, Right : D_Big_Unsigned) return Boolean is
+ begin
+ if Left.Last_Index = Right.Last_Index then
+ for I in 0..Left.Last_Index loop
+ if Left.Number(I) /= Right.Number(I) then return False;
+ end if;
+ end loop;
+ else return False;
+ end if;
+ return True;
+ end"=";
+
+ ----------------------------------------------------------------------------
+
+ function Shift_Left(Value : D_Big_Unsigned; Amount : Natural)
+ return D_Big_Unsigned is
+ begin
+ if Amount >= (D_Max_Length+1)*Word'Size or
+ Value = D_Big_Unsigned_Zero
+ then return D_Big_Unsigned_Zero;
+ elsif Amount = 0 then return Value;
+ end if;
+
+ declare
+ Result : D_Big_Unsigned;
+ Temp : DLimbs :=(others => 0);
+ L : constant Natural := Amount mod Word'Size;
+ R : constant Natural := Word'Size-L;
+ M : constant Natural := Amount/Word'Size;
+ begin
+ Temp(0) := Shift_Left(Value.Number(0), L);
+
+ for I in 1..Value.Last_Index loop
+ Temp(I) := Shift_Right(Value.Number(I-1), R) +
+ Shift_Left(Value.Number(I), L);
+ end loop;
+
+ if Value.Last_Index /= D_Max_Length then
+ Temp(Value.Last_Index+1):=
+ Shift_Right(Value.Number(Value.Last_Index), R);
+ end if;
+
+ for I in Temp'Range loop
+ if (I+M) > D_Max_Length then
+ exit;
+ end if;
+ Result.Number(I+M):= Temp(I);
+ end loop;
+
+ for I in reverse 0..D_Max_Length loop
+ if Result.Number(I) /=0 then
+ Result.Last_Index:=I;
+ exit;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end Shift_Left; pragma Inline (Shift_Left);
+
+ ---------------------------------------------------------------------------
+
+
+ function Bit_Length(X : D_Big_Unsigned) return Natural is
+ begin
+ if X = D_Big_Unsigned_Zero then
+ return 0;
+ end if;
+
+ for I in reverse 0..Word'Size-1 loop
+ if Shift_Left(1,I) <= X.Number(X.Last_Index) then
+ return Word'Size * X.Last_Index + I + 1 ;
+ end if;
+ end loop;
+ return X.Last_Index * Word'Size;
+ end Bit_Length; pragma Inline (Bit_Length);
+
+
+ ---------------------------------------------------------------------------
+
+ function "<"(Left, Right : D_Big_Unsigned) return Boolean is
+ begin
+ if Left.Last_Index < Right.Last_Index then return True;
+ elsif Left.Last_Index > Right.Last_Index then return False;
+ else
+ for I in reverse 0..Left.Last_Index loop
+ if Left.Number(I) < Right.Number(I) then return True;
+ elsif Left.Number(I) > Right.Number(I) then return False;
+ end if;
+ end loop;
+ end if;
+ return False;
+ end "<"; pragma Inline ("<");
+
+ ---------------------------------------------------------------------------
+
+ function ">"(Left, Right : D_Big_Unsigned) return Boolean is
+ begin
+ return Right < Left;
+ end ">"; pragma Inline (">");
+
+
+
+ ---------------------------------------------------------------------------
+
+ function ">="(Left, Right : D_Big_Unsigned) return Boolean is
+ begin
+ return not(Left < Right);
+ end ">="; pragma Inline (">=");
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned;
+
+ function "-"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned is
+ begin
+ if Left = Right then return D_Big_Unsigned_Zero;
+ elsif Left = Right+D_Big_Unsigned_One then return D_Big_Unsigned_One;
+ elsif Left+D_Big_Unsigned_One = Right then return D_Big_Unsigned_Last;
+
+ -- add the modulus if Right > Left
+ elsif Right > Left then
+ return D_Big_Unsigned_Last - Right + Left + D_Big_Unsigned_One;
+ else
+ declare
+ Result : D_Big_Unsigned;
+ Carry : Word:=0;
+ begin
+ -- Remember Left > Right
+ for I in 0..Left.Last_Index loop
+ Result.Number(I) := Left.Number(I) - Right.Number(I) - Carry;
+ if (Right.Number(I) > Left.Number(I)) or
+ (Carry= 1 and Right.Number(I) = Left.Number(I))
+ then Carry :=1;
+ else Carry :=0;
+ end if;
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end if;
+ end "-";
+
+
+ ---------------------------------------------------------------------------
+
+ function "mod"(Left : D_Big_Unsigned; Right : Big_Unsigned)
+ return Big_Unsigned is
+ begin
+ if Left.Last_Index <= Max_Length then
+ declare
+ L : Big_Unsigned;
+ begin
+ L.Last_Index := Left.Last_Index;
+ L.Number(0..Left.Last_Index) := Left.Number(0..Left.Last_Index);
+ return L mod Right;
+ end;
+ end if;
+
+ if Right = Big_Unsigned_Zero then raise Division_By_Zero;
+ --elsif Right = Big_Unsigned_One then return Big_Unsigned_Zero;
+ end if;
+
+ -- Now, there is only the case where (Left > Right), (Right /= 0)
+ -- and |Left|>|Right|.
+
+ declare
+ Remainder : D_Big_Unsigned:=Left;
+ Temp_Right, R : D_Big_Unsigned;
+ Result : Big_Unsigned;
+ Diff: Natural;
+
+ begin
+ Temp_Right.Last_Index := Right.Last_Index;
+ Temp_Right.Number(0..Right.Last_Index) :=
+ Right.Number(0..Right.Last_Index);
+ R:=Temp_Right;
+
+ while(Remainder >= R) loop
+ Diff := Bit_Length(Remainder) - Bit_Length(R);
+ if Diff = 0 then
+ Remainder := Remainder-R;
+ exit;
+ else Diff:=Diff-1;
+ end if;
+ Temp_Right := Shift_Left(R, Diff);
+ Remainder := Remainder-Temp_Right;
+ end loop;
+
+ Result.Last_Index := Remainder.Last_Index;
+ Result.Number(0..Result.Last_Index) :=
+ Remainder.Number(0..Result.Last_Index);
+ return Result;
+ end;
+ end "mod";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left, Right : D_Big_Unsigned) return D_Big_Unsigned is
+ Result : D_Big_Unsigned;
+ M : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index);
+ Temp : Word;
+ Carry : Word :=0;
+ begin
+
+ for I in 0..M loop
+ Temp :=Carry;
+ Result.Number(I) := Left.Number(I) + Right.Number(I) +Temp;
+ if Result.Number(I) < Word'Max(Left.Number(I), Right.Number(I))
+ then Carry := 1;
+ else Carry := 0;
+ end if;
+ end loop;
+
+ if Carry =1 and M < Max_Length then
+ Result.Number(M+1) := 1;
+ Result.Last_Index := M+1;
+ else
+ -- Set Result.Last_Index
+ for I in reverse 0..M loop
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ return Result;
+ end if;
+ end loop;
+ end if;
+ return Result;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+end Mod_Utils;
diff --git a/src/crypto-types-big_numbers-utils.adb b/src/crypto-types-big_numbers-utils.adb
new file mode 100644
index 0000000..313ce9b
--- /dev/null
+++ b/src/crypto-types-big_numbers-utils.adb
@@ -0,0 +1,704 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+--with Ada.Integer_Text_IO;
+--with Ada.Strings.Unbounded.Text_IO;
+with Crypto.Types.Random;
+
+SEPARATE(Crypto.Types.Big_Numbers)
+
+package body Utils is
+
+ pragma Optimize (Time);
+
+ ---------------------------------------------------------------------------
+
+ procedure Swap(X, Y : in out Big_Unsigned) is
+ Temp : constant Big_Unsigned := X;
+ begin
+ X := Y;
+ Y := Temp;
+ end Swap; pragma Inline (Swap);
+
+ ---------------------------------------------------------------------------
+
+ procedure Set_Least_Significant_Bit(X : in out Big_Unsigned) is
+ begin
+ X.Number(0) := X.Number(0) or 1;
+ end Set_Least_Significant_Bit; pragma Inline(Set_Least_Significant_Bit);
+
+ ---------------------------------------------------------------------------
+
+ function Is_Odd(X : Big_Unsigned) return Boolean is
+ begin
+ if (X.Number(0) and 1) = 1 then return True;
+ else return False;
+ end if;
+ end Is_Odd; pragma Inline(Is_Odd);
+
+ ---------------------------------------------------------------------------
+
+ function Is_Even(X : Big_Unsigned) return Boolean is
+ begin
+ if (X.Number(0) and 1) = 0 then return True;
+ else return False;
+ end if;
+ end Is_Even; pragma Inline(Is_Even);
+
+ ---------------------------------------------------------------------------
+
+ procedure Set_Most_Significant_Bit(X : in out Big_Unsigned) is
+ begin
+ X.Last_Index := Max_Length;
+ X.Number(Max_Length) := X.Number(Max_Length) or
+ Shift_Left(Word(1), Word'Size-1);
+ end Set_Most_Significant_Bit; pragma Inline(Set_Most_Significant_Bit);
+
+
+ ---------------------------------------------------------------------------
+
+ function Bit_Length(X : Big_Unsigned) return Natural is
+ begin
+ if X = Big_Unsigned_Zero then
+ return 0;
+ end if;
+
+ for I in reverse 0..Word'Size-1 loop
+ if Shift_Left(1,I) <= X.Number(X.Last_Index) then
+ return Word'Size * X.Last_Index + I + 1 ;
+ end if;
+ end loop;
+ return X.Last_Index * Word'Size;
+ end Bit_Length; pragma Inline(Bit_Length);
+
+ ---------------------------------------------------------------------------
+
+ function Lowest_Set_Bit(X : Big_Unsigned) return Natural is
+ begin
+ if X = Big_Unsigned_Zero then
+ raise Is_Zero_Error;
+ end if;
+
+ for I in 0..X.Last_Index loop
+ if X.Number(I) /= 0 then
+ for J in 0..Word'Size-1 loop
+ if (Shift_Right(X.Number(I),J) and 1) = 1 then
+ return I*Word'Size+J+1;
+ end if;
+ end loop;
+ end if;
+ end loop;
+ return Size+1; --X = Big_unsgned_Zero = 2**(Size+1)
+ end Lowest_Set_Bit; pragma Inline (Lowest_Set_Bit);
+
+
+ ---------------------------------------------------------------------------
+
+
+ procedure Inc(X : in out Big_Unsigned) is
+ begin
+ if X = Big_Unsigned_Last then
+ X := Big_Unsigned_Zero;
+ else
+ X.Number(0) := X.Number(0) + 1;
+ for I in 0..X.Last_Index loop
+ if X.Number(I) /= 0 then
+ exit;
+ else X.Number(I+1) := X. Number(I+1) + 1;
+ end if;
+ end loop;
+
+ -- if an mod_type overflow occure then we have some extra work do
+ if X.Number(X.Last_Index) = 0 then
+ X.Last_Index := X.Last_Index + 1;
+ end if;
+ end if;
+ end Inc; pragma Inline(Inc);
+
+ ---------------------------------------------------------------------------
+
+ procedure Dec(X : in out Big_Unsigned) is
+ begin
+ if X = Big_Unsigned_Zero then
+ X := Big_Unsigned_Last;
+ else
+ X.Number(0) := X.Number(0) - 1;
+ for I in 0..X.Last_Index loop
+ if X.Number(I) /= Word'Last then
+ exit;
+ else X.Number(I+1) := X.Number(I+1) - 1;
+ end if;
+ end loop;
+
+
+ -- check if we must dec the Last_index too
+ if X.Number(X.Last_Index) = 0 and X.Last_Index /= 0 then
+ X.Last_Index := X.Last_Index - 1;
+ end if;
+ end if;
+ end Dec; pragma Inline(Dec);
+
+ ---------------------------------------------------------------------------
+
+ function Shift_Left(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned is
+ begin
+ if Amount >= (Max_Length+1)*Word'Size or Value = Big_Unsigned_Zero
+ then return Big_Unsigned_Zero;
+ elsif Amount = 0 then return Value;
+ end if;
+
+ declare
+ Result : Big_Unsigned;
+ Temp : Limbs:=(others => 0);
+ L : constant Natural := Amount mod Word'Size;
+ R : constant Natural := Word'Size-L;
+ M : constant Natural := Amount/Word'Size;
+ begin
+ Temp(0) := Shift_Left(Value.Number(0), L);
+
+-- for I in 1..Value.Last_Index loop
+-- Temp(I) := Shift_Right(Value.Number(I-1), R) +
+-- Shift_Left(Value.Number(I), L);
+-- end loop;
+ for I in 1..Value.Last_Index loop
+ Temp(I) := Shift_Right(Value.Number(I-1), R) xor
+ Shift_Left(Value.Number(I), L);
+ end loop;
+
+ if Value.Last_Index /= Max_Length then
+ Temp(Value.Last_Index+1):=
+ Shift_Right(Value.Number(Value.Last_Index), R);
+ end if;
+
+ for I in Temp'Range loop
+ if (I+M) > Max_Length then
+ exit;
+ end if;
+ Result.Number(I+M):= Temp(I);
+ end loop;
+ for I in reverse 0..Max_Length loop
+ if Result.Number(I) /=0 then
+ Result.Last_Index:=I;
+ exit;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end Shift_Left; -- pragma Inline (Shift_Left);
+
+ ---------------------------------------------------------------------------
+
+ function Shift_Right(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned is
+ begin
+ if Amount >= (Max_Length+1)*Word'Size or Value = Big_Unsigned_Zero
+ then return Big_Unsigned_Zero;
+ elsif Amount = 0 then return Value;
+ end if;
+
+ declare
+ Result : Big_Unsigned:=Big_Unsigned_Zero;
+ Temp : Limbs :=(others => 0);
+ R : constant Natural := Amount mod Word'Size;
+ L : constant Natural := Word'Size-R;
+ M : constant Natural := Amount/Word'Size;
+ begin
+ Temp(Value.Last_Index) :=
+ Shift_Right(Value.Number(Value.Last_Index), R);
+
+-- for I in reverse 0..Value.Last_Index-1 loop
+-- Temp(I) := Shift_Left(Value.Number(I+1), L) +
+-- Shift_Right(Value.Number(I), R);
+-- end loop;
+ for I in reverse 0..Value.Last_Index-1 loop
+ Temp(I) := Shift_Left(Value.Number(I+1), L) xor
+ Shift_Right(Value.Number(I), R);
+ end loop;
+
+ for I in reverse Temp'Range loop
+ if (I-M) < 0 then
+ exit;
+ end if;
+ Result.Number(I-M):= Temp(I);
+ end loop;
+
+ for I in reverse 0..Value.Last_Index loop
+ if Result.Number(I) /= 0 or I = 0 then
+ Result.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end Shift_Right; --pragma Inline (Shift_Right);
+
+
+ ---------------------------------------------------------------------------
+
+ function Rotate_Left(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned is
+ L : constant Natural := Amount mod Size;
+ begin
+ if Value = Big_Unsigned_Last then
+ return Big_Unsigned_Last;
+ end if;
+ return Shift_Left(Value,L) xor Shift_Right(Value, Size-L);
+ end Rotate_Left; pragma Inline (Rotate_Left);
+
+ ---------------------------------------------------------------------------
+
+ function Rotate_Right(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned is
+ R : constant Natural := Amount mod Size;
+ begin
+ if Value = Big_Unsigned_Last then
+ return Big_Unsigned_Last;
+ end if;
+ return Shift_Right(Value,R) xor Shift_Left(Value, Size-R);
+ end Rotate_Right; pragma Inline (Rotate_Right);
+
+ ---------------------------------------------------------------------------
+
+ function Gcd(Left, Right : Big_Unsigned) return Big_Unsigned is
+ A : Big_Unsigned := Max(Left,Right);
+ B : Big_Unsigned := Min(Left,Right);
+ R : Big_Unsigned;
+ begin
+ while B /= Big_Unsigned_Zero loop
+ R := A mod B;
+ A := B;
+ B := R;
+ end loop;
+ return A;
+ end Gcd; pragma Inline (Gcd);
+
+ ---------------------------------------------------------------------------
+
+ function Get_Random return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ Random.Read(Result.Number);
+ return Result;
+ end Get_Random; pragma Inline (Get_Random);
+
+ ---------------------------------------------------------------------------
+
+ function Length_In_Bytes(X : Big_Unsigned) return Natural is
+ Len : constant Natural := Bit_Length(X);
+ begin
+ if Len mod Byte'Size = 0 then return (Len / Byte'Size);
+ else return (Len / Byte'Size) + 1;
+ end if;
+ end Length_In_Bytes; pragma Inline (Length_In_Bytes);
+
+ ---------------------------------------------------------------------------
+
+ function To_Big_Unsigned(X : Word) return Big_Unsigned is
+ Result : constant Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => X, OTHERS => 0));
+ begin
+ return Result;
+ end To_Big_Unsigned; pragma Inline (To_Big_Unsigned);
+
+
+ function To_Words(X : Big_Unsigned) return Words is
+ begin
+ return X.Number(0..X.Last_Index);
+ end To_Words; pragma Inline (To_Words);
+
+
+ ---------------------------------------------------------------------------
+
+ function Max(Left, Right : Integer) return Integer is
+ begin
+ if Left < Right then
+ return Right;
+ else
+ return Left;
+ end if;
+ end Max;
+
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(X : Big_Unsigned) return Bytes is
+ L : constant Natural := Max(Length_In_Bytes(X)-1,0);
+ M : constant Natural := 3; --(Word'Size / Byte'Size) - 1;
+ E : constant Integer := ((L+1) mod 4) - 1;
+ B : Bytes(0..L);
+ begin
+ for I in 0..X.Last_Index-1 loop
+ for J in 0..M loop
+ B(L-I*(M+1)-J) := Byte(Shift_Right(X.Number(I), J*Byte'Size) and
+ Word(Byte'Last));
+ end loop;
+ end loop;
+
+ if E >= 0 then
+ for I in 0..E loop
+ B(I) := Byte(Shift_Right(X.Number(X.Last_Index), (E-I)*Byte'Size)
+ and Word(Byte'Last));
+ end loop;
+ else
+ for J in 0..M loop
+ B(M-J) := Byte(Shift_Right(X.Number(X.Last_Index), J*Byte'Size)
+ and Word(Byte'Last));
+ end loop;
+ end if;
+
+ return B;
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Big_Unsigned(X : Words) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ if X'Length > Max_Length then
+ raise Constraint_Error;
+ else
+ Result.Number(0..X'Last-X'First) := X;
+ end if;
+
+ for I in reverse 0..Max_Length loop
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+
+ return Result;
+ end To_Big_Unsigned;
+
+ ---------------------------------------------------------------------------
+
+ function To_Big_Unsigned(X : Bytes) return Big_Unsigned is
+ Result : Big_Unsigned;
+ M : constant Natural := Word'Size / Byte'Size; -- Bytes per Word
+ Shift_Amount, counter : Natural:=0;
+ begin
+ if X'Length*Byte'Size > Size then
+ raise Constraint_Error;
+ end if;
+
+ for I in reverse X'Range loop
+ Result.Number(Counter/M) := Result.Number(Counter/M) or
+ Shift_Left(Word(X(I)), Shift_Amount*Byte'Size);
+ Shift_Amount := (Shift_Amount + 1) mod M;
+ Counter:=Counter+1;
+ end loop;
+
+ for I in reverse 0..Max_Length loop
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+
+ return Result;
+
+ end To_Big_Unsigned;
+
+ ---------------------------------------------------------------------------
+
+ procedure Big_Div(Dividend, Divisor : in Big_Unsigned;
+ Quotient, Remainder : out Big_Unsigned) is
+ Last_Divisor : constant Natural := Divisor.Last_Index;
+ begin
+ if (Last_Divisor = 0) then
+ case Divisor.Number(0) is
+ when 0 => raise Division_By_Zero;
+ when 1 => Quotient := Dividend;
+ Remainder := Big_Unsigned_Zero;
+ return;
+ when others => declare
+ Temp_Remainder : Word;
+ Temp_Divisor : constant Word := Divisor.Number(0);
+ begin
+ -- We use the function Short_Div, which is faster.
+ -- See below for the implementation of Short_Div.
+ Short_Div(Dividend, Temp_Divisor, Quotient, Temp_Remainder);
+ Remainder := (Last_Index => 0,
+ Number => (Temp_Remainder, others => 0));
+ return;
+ end;
+ end case;
+
+ elsif (Dividend < Divisor) then
+ Quotient := Big_Unsigned_Zero;
+ Remainder := Dividend;
+ return;
+
+ elsif Dividend = Big_Unsigned_Zero then
+ Quotient := Big_Unsigned_Zero;
+ Remainder := Big_Unsigned_Zero;
+ return;
+
+ elsif (Bit_Length(Dividend) = Bit_Length(Divisor)) then
+ -- Dividend > Divisor and Divisor /= 0 and
+ -- |Dividend|=|Divisor| => Dividend/Divisor=1
+ Quotient:=Big_Unsigned_One;
+ Remainder:=Dividend-Divisor;
+ return;
+ end if;
+
+ -- Now, there is only the case where (Dividend > Divisor), (Divisor /= 0)
+ -- and |Dividend|>|Divisor|.
+
+ declare
+ Temp_Divisor: Big_Unsigned :=Divisor;
+ Diff: Natural;
+ begin
+ Remainder:= Dividend;
+ Quotient:=Big_Unsigned_Zero;
+
+ while(Remainder >= Divisor) loop
+ Diff := Bit_Length(Remainder) - Bit_Length(Divisor);
+ if Diff = 0 then
+ Quotient:=Quotient+1;
+ Remainder:=Remainder-Divisor;
+ return;
+ else Diff:=Diff-1;
+ end if;
+ Temp_Divisor := Shift_Left(Divisor, Diff);
+ Remainder := Remainder-Temp_Divisor;
+ Quotient := Quotient + Shift_Left(Big_Unsigned_One, Diff);
+ end loop;
+ end;
+ end Big_Div;
+
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+ procedure Short_Div(Dividend : in Big_Unsigned;
+ Divisor : in Word;
+ Quotient : out Big_Unsigned;
+ Remainder : out Word) is
+ begin
+
+ -- simple cases
+ if (Dividend < Divisor) then
+ Remainder := Dividend.Number(0);
+ Quotient := Big_Unsigned_Zero;
+ return;
+ elsif (Divisor = 0) then
+ raise Division_By_Zero;
+ elsif (Divisor = 1) then
+ Quotient := Dividend;
+ Remainder := 0;
+ return;
+ elsif (Dividend = Divisor) then
+ Quotient := Big_Unsigned_One;
+ Remainder := 0;
+ return;
+ end if;
+
+ declare
+ Last_Dividend : constant Natural := Dividend.Last_Index;
+ Temp_Quotient : Big_Unsigned;
+ Carry : Largest_Unsigned := 0;
+ Temp : Largest_Unsigned;
+ Temp_Divisor : constant Largest_Unsigned :=
+ Largest_Unsigned(Divisor);
+
+ begin
+ for I in reverse 0..Last_Dividend loop
+ Temp := Largest_Unsigned(Dividend.Number(I))
+ + Shift_Left(Carry, Word'Size);
+ Temp_Quotient.Number(I) := Word(Temp / Temp_Divisor);
+ Carry := Temp mod Temp_Divisor;
+ end loop;
+
+ if (Last_Dividend > 0) and then
+ (Temp_Quotient.Number(Last_Dividend) = 0) then
+ Temp_Quotient.Last_Index := Last_Dividend - 1;
+ else
+ Temp_Quotient.Last_Index := Last_Dividend;
+ end if;
+ Quotient := Temp_Quotient;
+ Remainder := Word(Carry);
+ end;
+ end Short_Div;
+
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+-- package IIO renames Ada.Integer_Text_IO;
+-- package UIO renames Ada.Strings.Unbounded.Text_IO;
+
+ ---------------------------------------------------------------------------
+
+ function To_String(Item : Big_Unsigned;
+ Base : Number_Base := 10) return String is
+ S : Unbounded_String := Null_Unbounded_String;
+ Remainder : Word:=0;
+ Temp_Item : Big_Unsigned := Item;
+ Trans : constant array(Word range 0..15) of Character :=
+ ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
+ Base_Img : constant String := Base'Img;
+ begin
+ if Item = Big_Unsigned_Zero then
+ if Base = 10 then return "0";
+ else
+ S := "#0#" & S;
+ S := Base_Img & S;
+ return Slice(S,2,Length(S));
+ end if;
+ else
+ if Base /= 10 then
+ S := "#" & S;
+ end if;
+ while (Temp_Item /= Big_Unsigned_Zero) loop
+ Short_Div(Temp_Item, Word(Base), Temp_Item, Remainder);
+ S := Trans(Remainder) & S;
+ end loop;
+ if Base /= 10 then
+ S := "#" & S;
+ S := Base_Img & S;
+ return Slice(S,2,Length(S));
+ end if;
+ end if;
+ return To_String(S);
+ end To_String;
+
+ ---------------------------------------------------------------------------
+
+ procedure Put(Item : in Big_Unsigned; Base : in Number_Base := 10) is
+ begin
+ Put(To_String(Item, Base));
+ end Put; --pragma Inline(Put);
+
+ ---------------------------------------------------------------------------
+
+ procedure Put_Line(Item : in Big_Unsigned; Base : in Number_Base := 10) is
+ begin
+ Put(To_String(Item, Base)); New_Line;
+ end Put_Line; --pragma Inline(Put_Line);
+
+ ---------------------------------------------------------------------------
+
+ function Get_Digit(C : Character) return Word is
+ begin
+ case C is
+ when '0'..'9' => return Character'Pos(C) - Character'Pos('0');
+ when 'A'..'F' => return Character'Pos(C) - Character'Pos('A') + 10;
+ when others => raise Conversion_Error;
+ end case;
+ end Get_Digit; pragma Inline(Get_Digit);
+
+ ---------------------------------------------------------------------------
+
+ function To_Big_Unsigned(S : String) return Big_Unsigned is
+ Fence_Count: Natural := 0;
+ Temp : Unbounded_String := Null_Unbounded_String;
+ M_B : Natural:=0;
+ begin
+ if S'Length = 0 then
+ raise Conversion_Error;
+ else
+ for I in reverse S'Range loop
+ case S(I) is
+ when '0' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,0);
+ when '1' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,1);
+ when '2' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,2);
+ when '3' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,3);
+ when '4' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,4);
+ when '5' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,5);
+ when '6' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,6);
+ when '7' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,7);
+ when '8' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,8);
+ when '9' => Temp:= S(I) & Temp; M_B:=Natural'Max(M_B,9);
+ when 'a' | 'A' => Temp:= 'A' & Temp; M_B:=Natural'Max(M_B,11);
+ when 'b' | 'B' => Temp:= 'B' & Temp; M_B:=Natural'Max(M_B,12);
+ when 'c' | 'C' => Temp:= 'C' & Temp; M_B:=Natural'Max(M_B,13);
+ when 'd' | 'D' => Temp:= 'D' & Temp; M_B:=Natural'Max(M_B,14);
+ when 'e' | 'E' => Temp:= 'E' & Temp; M_B:=Natural'Max(M_B,15);
+ when 'f' | 'F' => Temp:= 'F' & Temp; M_B:=Natural'Max(M_B,16);
+ when '_' | ' ' => null;
+ when '#' => Fence_Count := Fence_Count+1; Temp:= S(I) & Temp;
+ when others => raise Conversion_Error;
+ end case;
+ end loop;
+ end if;
+
+ declare
+ Result : Big_Unsigned;
+ S2 : constant String := To_String(Temp);
+ begin
+
+ -- Base = 10
+ if Fence_Count = 0 then
+ if M_B > 10 then
+ raise Conversion_Error;
+ end if;
+ for I in S2'Range loop
+ Result := Result * 10 + Get_Digit(S2(I));
+ end loop;
+ return Result;
+
+ -- Base /= 10
+ -- check fences and size (Min_Size=|2#0#|=4)
+ elsif Fence_Count /= 2 or S2(S2'Last) /= '#' or S2(S2'First) = '#'
+ or S2'Length < 4 then
+ raise Conversion_Error;
+ end if;
+
+ declare
+ Base : Number_Base;
+ begin
+ --Compute and check Base
+ if S2(S2'First+1) /= '#' then
+ if S2(S2'First+2) /= '#' then
+ raise Conversion_Error;
+ end if;
+ Base := Number_Base(Get_Digit(S2(S2'First)) * 10
+ + Get_Digit(S2(S2'First+1)));
+ else Base := Number_Base(Get_Digit(S2(S2'First)));
+ end if;
+
+ -- Check if all Characters are valid to the base
+ if M_B > Base then
+ raise Conversion_Error;
+ end if;
+
+ --Time to compute the Big_Unsigned
+ if Base > 10 then
+ for I in S2'First+3..S2'Last-1 loop
+ Result := Result * Word(Base) + Get_Digit(S2(I));
+ end loop;
+ else
+ for I in S2'First+2..S2'Last-1 loop
+ Result := Result * Word(Base) + Get_Digit(S2(I));
+ end loop;
+ end if;
+ return Result;
+ end;
+ end;
+ end To_Big_Unsigned;
+
+ ---------------------------------------------------------------------------
+
+ end Utils;
+
diff --git a/src/crypto-types-big_numbers.adb b/src/crypto-types-big_numbers.adb
new file mode 100644
index 0000000..b69e55b
--- /dev/null
+++ b/src/crypto-types-big_numbers.adb
@@ -0,0 +1,921 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package body Crypto.Types.Big_Numbers is
+
+ -- package MIO is new Ada.Text_Io.Modular_IO (Word);
+
+ ---------------------------------------------------------------------------
+ -----------------------SEPARATED_BODYS-------------------------------------
+ ---------------------------------------------------------------------------
+
+ package body Utils is separate;
+ use Utils;
+
+ package body Mod_Utils is separate;
+ use Mod_Utils;
+
+ package body Binfield_Utils is separate;
+ use Binfield_Utils;
+
+ ---------------------------------------------------------------------------
+ ---------------------------COMPARE_FUNCTIONS--------------------------------
+ ---------------------------------------------------------------------------
+
+
+ ---------------------------------------------------------------------------
+ -- compare: Big_Unsigned with Big_Unsigned --
+ ---------------------------------------------------------------------------
+
+
+ function "="(Left, Right : Big_Unsigned) return Boolean is
+ begin
+ if Left.Last_Index = Right.Last_Index then
+ for I in 0..Left.Last_Index loop
+ if Left.Number(I) /= Right.Number(I) then return False;
+ end if;
+ end loop;
+ else return False;
+ end if;
+ return True;
+ end "=";
+
+ ---------------------------------------------------------------------------
+
+ function "<"(Left, Right : Big_Unsigned) return Boolean is
+ begin
+ if Left.Last_Index < Right.Last_Index then return True;
+ elsif Left.Last_Index > Right.Last_Index then return False;
+ else
+ for I in reverse 0..Left.Last_Index loop
+ if Left.Number(I) < Right.Number(I) then return True;
+ elsif Left.Number(I) > Right.Number(I) then return False;
+ end if;
+ end loop;
+ end if;
+ return False;
+ end "<";
+
+ ---------------------------------------------------------------------------
+
+ function ">"(Left, Right : Big_Unsigned) return Boolean is
+ begin
+ return Right < Left;
+ end ">";
+
+ ---------------------------------------------------------------------------
+
+ function "<="(Left, Right : Big_Unsigned) return Boolean is
+ begin
+ return not (Right < Left);
+ end "<=";
+
+
+ ---------------------------------------------------------------------------
+
+
+ function ">="(Left, Right : Big_Unsigned) return Boolean is
+ begin
+ return not (Left < Right);
+ end ">=";
+
+ ---------------------------------------------------------------------------
+
+ function Min(X, Y : in Big_Unsigned) return Big_Unsigned is
+ begin
+ if (X < Y) then return X;
+ else return Y;
+ end if;
+ end Min;
+
+ ---------------------------------------------------------------------------
+
+ function Max(X, Y : in Big_Unsigned) return Big_Unsigned is
+ begin
+ if (X < Y) then return Y;
+ else return X;
+ end if;
+ end Max;
+
+
+ ---------------------------------------------------------------------------
+ -- compare: Big_Unsigned with Word --
+ ---------------------------------------------------------------------------
+
+
+ function "="(Left : Big_Unsigned; Right : Word) return Boolean is
+ begin
+ if Left.Last_Index=0 and Left.Number(0) = Right then return True;
+ else return False;
+ end if;
+ end "=";
+
+ ---------------------------------------------------------------------------
+
+ function "="(Left : Word; Right : Big_Unsigned) return Boolean is
+ begin
+ return Right = Left;
+ end "=";
+
+ ---------------------------------------------------------------------------
+
+ function "<"(Left : Big_Unsigned; Right : Word) return Boolean is
+ begin
+ if Left.Last_Index > 0 then return False;
+ else return Left.Number(Left.Last_Index) < Right;
+ end if;
+ end "<";
+
+ ---------------------------------------------------------------------------
+
+ function "<"(Left : Word; Right : Big_Unsigned) return Boolean is
+ begin
+ if Right.Last_Index > 0 then return True;
+ else return Left < Right.Number(Right.Last_Index);
+ end if;
+ end "<";
+
+ ---------------------------------------------------------------------------
+
+ function ">"(Left : Big_Unsigned; Right : Word) return Boolean is
+ begin
+ return Right < Left;
+ end ">";
+
+ ---------------------------------------------------------------------------
+
+ function ">"(Left : Word; Right : Big_Unsigned) return Boolean is
+ begin
+ return Right < Left;
+ end ">";
+
+ ---------------------------------------------------------------------------
+
+ function "<="(Left : Big_Unsigned; Right : Word) return Boolean is
+ begin
+ return not (Right < Left);
+ end "<=";
+
+ ---------------------------------------------------------------------------
+
+ function "<="(Left : Word; Right : Big_Unsigned) return Boolean is
+ begin
+ return not (Right < Left);
+ end "<=";
+
+ ---------------------------------------------------------------------------
+
+ function ">="(Left : Big_Unsigned; Right : Word) return Boolean is
+ begin
+ return not (Left < Right);
+ end ">=";
+
+ ---------------------------------------------------------------------------
+
+ function ">="(Left : Word; Right : Big_Unsigned) return Boolean is
+ begin
+ return not (Left < Right);
+ end ">=";
+
+
+ ---------------------------------------------------------------------------
+ ----------------------------BASE_FUNCTIONS---------------------------------
+ ---------------------------------------------------------------------------
+--============================================================================--
+
+ function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ L : constant Natural := Natural'Max( Bit_Length(Left), Bit_Length(Right));
+ begin
+ if L + 1 <= Word'Size then
+ Result.Number(0) := Left.Number(0) + Right.Number(0);
+ else
+
+ declare
+ Carry : Big_Unsigned;
+ Temp : Big_Unsigned;
+ begin
+ Carry := Left and Right;
+ Result := Left xor Right;
+ Carry := Shift_Left(Carry,1);
+ loop
+ Temp := Result and Carry;
+ Result := Result xor Carry;
+ Carry := Temp;
+ Carry := Shift_Left(Carry,1);
+ exit when Carry = Big_Unsigned_Zero;
+ end loop;
+ end;
+ end if;
+
+ return Result;
+ end "+";
+
+-- function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is
+-- Result: Big_Unsigned;
+-- Carry : Big_Unsigned;
+-- Temp : Big_Unsigned;
+-- begin
+-- Carry := Left and Right;
+-- Result := Left xor Right;
+-- Carry := Shift_Left(Carry,1);
+-- --ADA Do_While
+-- loop
+-- Temp := Result and Carry;
+-- Result := Result xor Carry;
+-- Carry := Temp;
+-- Carry := Shift_Left(Carry,1);
+-- exit when Carry = Big_Unsigned_Zero;
+-- end loop;
+-- return Result;
+-- end "+";
+--------------------------------------------------------------------------------
+-- function "+"(Left, Right : Big_Unsigned) return Big_Unsigned is
+-- Result : Big_Unsigned;
+-- M : constant Natural := Natural'Max(Left.Last_Index, Right.Last_Index);
+-- Temp : Word;
+-- Carry : Word :=0;
+-- begin
+-- for I in 0..M loop
+-- Temp :=Carry;
+-- Result.Number(I) := Left.Number(I) + Right.Number(I) +Temp;
+-- if Result.Number(I) < Word'Max(Left.Number(I), Right.Number(I))
+-- then Carry := 1;
+-- else Carry := 0;
+-- end if;
+-- end loop;
+
+-- if Carry =1 and M < Max_Length then
+-- Result.Number(M+1) := 1;
+-- Result.Last_Index := M+1;
+-- else
+-- -- Set Result.Last_Index
+-- for I in reverse 0..M loop
+-- if Result.Number(I) /= 0 then
+-- Result.Last_Index := I;
+-- return Result;
+-- end if;
+-- end loop;
+-- end if;
+-- return Result;
+-- end "+";
+--============================================================================--
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is
+ Big_Right : Constant Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => Right, OTHERS => 0));
+ begin
+ return Left + Big_Right;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is
+ Big_Left : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Left, OTHERS => 0));
+ begin
+ return Big_Left + Right;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "-"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ begin
+ -- Add the modulus if Right > Left
+ if Right > Left then
+ return Big_Unsigned_Last - Right + Left + 1;
+-- raise Big_Unsigned_Negative; -- RSA does not run
+ else
+ declare
+ Result : Big_Unsigned;
+ Carry : Word:=0;
+ begin
+ -- Remember: Left => Right
+ for I in 0..Left.Last_Index loop
+ Result.Number(I) := Left.Number(I) - Right.Number(I) - Carry;
+ if (Right.Number(I) > Left.Number(I)) or
+ (Carry= 1 and Right.Number(I) = Left.Number(I))
+ then Carry :=1;
+ else Carry :=0;
+ end if;
+ if Result.Number(I) /= 0 then
+ Result.Last_Index := I;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end if;
+ end "-";
+
+ ---------------------------------------------------------------------------
+
+ function "-"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is
+ Big_Right : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Right, OTHERS => 0));
+ begin
+ return Left - Big_Right;
+ end "-";
+
+ ---------------------------------------------------------------------------
+
+ function "-"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is
+ Big_Left : constant Big_Unsigned := (Last_Index => 0, Number => (0 => Left, OTHERS => 0));
+ begin
+ return Big_Left - Right;
+ end "-";
+
+ ---------------------------------------------------------------------------
+
+ function "-"(X : Big_Unsigned) return Big_Unsigned is
+ begin
+ if X /= Big_Unsigned_Zero then
+ return Big_Unsigned_Last-X-1;
+ else
+ return X;
+ end if;
+ end "-";
+
+ ---------------------------------------------------------------------------
+--============================================================================--
+
+ function "*"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned ;
+ L : constant Natural := Bit_Length(Left)+Bit_Length(Right);
+ begin
+ if L <= Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ elsif L > 2800 and L <= 3600 then
+ Result := Karatsuba_P(Left, Right);
+ elsif L > 3600 then
+ Result := Toom_Cook_P(Left, Right);
+ else
+ declare
+ Temp : Big_Unsigned;
+ begin
+ for I in reverse 0..Left.Last_Index loop
+ Temp := Left.Number(I) * Right;
+ Temp := Shift_Left(Temp, (I*Word'Size));
+ Result := Result + Temp;
+ end loop;
+ end;
+ end if;
+ return Result;
+ end "*";
+--------------------------------------------------------------------------------
+
+ function Russ (Left,Right : Big_Unsigned)return Big_Unsigned is
+ Result : Big_Unsigned ;
+ begin
+ if Bit_Length(Left)+Bit_Length(Right) <= Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ else
+ declare
+ AA : Big_Unsigned := Left;
+ BB : Big_Unsigned := Right;
+ begin
+ while AA > Big_Unsigned_Zero loop
+ if (AA and Big_Unsigned_One) = 1 then
+ Result := Result + BB;
+ AA := AA - 1;
+ end if;
+ AA := Shift_Right(AA, 1);
+ BB := Shift_Left(BB, 1);
+ end loop;
+ end;
+ end if;
+ return Result;
+ end Russ;
+
+--------------------------------------------------------------------------------
+
+ function Karatsuba (Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ if Bit_Length(Left)+Bit_Length(Right) < Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ else
+ declare
+ Left_1, Left_2 : Big_Unsigned;
+ Right_1, Right_2 : Big_Unsigned;
+ P_1, P_2 : Big_Unsigned;
+ N : constant Natural := Natural'Max( Bit_Length(Left)
+ , Bit_Length(Right))/2;
+ begin
+ Left_1 := Shift_Right(Left, N);
+ Left_2 := Left - Shift_Left( Left_1, N );
+ Right_1 := Shift_Right(Right, N);
+ Right_2 := Right - Shift_Left( Right_1, N );
+
+ P_1 := Left_1 * Right_1;
+ P_2 := Left_2 * Right_2;
+ Result := Shift_Left(P_1, 2*N)
+ + Shift_Left(((Left_1 + Left_2)*(Right_1 + Right_2)) - P_1 - P_2, N)
+ + P_2;
+ end;
+ end if;
+ return Result;
+ end Karatsuba;
+
+
+--------------------------------------------------------------------------------
+
+ function Karatsuba_P (Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ if Bit_Length(Left)+Bit_Length(Right) < Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ else
+ declare
+ Left_1, Left_2 : Big_Unsigned:= Big_Unsigned_Zero;
+ Right_1, Right_2 : Big_Unsigned:= Big_Unsigned_Zero;
+ P_1, P_2, P_3 : Big_Unsigned:= Big_Unsigned_Zero;
+ N : constant Natural := Natural'Max( Bit_Length(Left),
+ Bit_Length(Right))/2;
+ -----------------------------------------------------------------------
+ task type Karatsuba_Task_Type is
+ entry Input (Left, Right : in Big_Unsigned);
+ entry Output(Result : out Big_Unsigned);
+ end Karatsuba_Task_Type;
+ task body Karatsuba_Task_Type is
+ X : Big_Unsigned;
+ Left_Local : Big_Unsigned;
+ Right_Local : Big_Unsigned;
+ begin
+ accept Input (Left, Right : Big_Unsigned) do
+ Left_Local := Left;
+ Right_Local := Right;
+ end Input;
+
+-- X := Karatsuba(Left_Local, Right_Local);
+ X := Left_Local * Right_Local;
+
+ accept Output(Result : out Big_Unsigned) do
+ Result := X;
+ end Output;
+ end Karatsuba_Task_Type;
+ Task_1 : Karatsuba_Task_Type;
+ Task_2 : Karatsuba_Task_Type;
+ Task_3 : Karatsuba_Task_Type;
+ -----------------------------------------------------------------------
+ begin
+ Left_1 := Shift_Right(Left, N);
+ Left_2 := Left - Shift_Left( Left_1, N );
+ Right_1 := Shift_Right(Right, N);
+ Right_2 := Right - Shift_Left( Right_1, N );
+
+ Task_1.Input(Left_1, Right_1);
+ Task_2.Input(Left_2, Right_2);
+ Task_3.Input((Left_1 + Left_2), (Right_1 + Right_2));
+
+ Task_1.Output(Result => P_1);
+ Task_2.Output(Result => P_2);
+ Task_3.Output(Result => P_3);
+
+ Result := Shift_Left(P_1, 2*N)
+ + Shift_Left((P_3 - P_1 - P_2), N)
+ + P_2;
+ end;
+ end if;
+ return Result;
+ end Karatsuba_P;
+
+ -----------------------------------------------------------------------
+
+ function Toom_Cook(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ if Bit_Length(Left)+Bit_Length(Right) < Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ else
+
+ declare
+ knuth_1 : Array (1..5) of Big_Unsigned;
+ knuth_2 : Array (1..4) of Big_Unsigned;
+ knuth_3 : Array (1..3) of Big_Unsigned;
+ knuth_4 : Array (1..2) of Big_Unsigned;
+ knuth_5_1 : Big_Unsigned;
+ L, R : Array (0..3) of Big_Unsigned;
+ F_Left, F_Right : Array (2..4) of Big_Unsigned;
+ Z : Array (0..4) of Big_Unsigned;
+ Length : constant Natural := Natural'Max( Bit_Length(Left) ,
+ Bit_Length(Right) );
+ N : constant Natural := Length / 3;
+ DN : constant Natural := 2 * N;
+
+ begin
+
+ -- SPLITTING .............................................................
+
+ L(0) := Shift_Right( Left, DN);
+ L(1) := Shift_Right( Left, N ) - Shift_Left( L(0), N );
+ L(2) := Left - Shift_Left( L(0), DN ) - Shift_Left( L(1), N );
+ R(0) := Shift_Right( Right, DN);
+ R(1) := Shift_Right( Right, N ) - Shift_Left( R(0), N );
+ R(2) := Right - Shift_Left( R(0), DN ) - Shift_Left( R(1), N );
+
+ F_Left(2) := Shift_Left(L(0),2) + Shift_Left(L(1),1) + L(2);
+ F_Right(2) := Shift_Left(R(0),2) + Shift_Left(R(1),1) + R(2);
+ F_Left(3) := (Shift_Left(L(0),3) + L(0)) + (Shift_Left(L(1),1)+L(1)) + L(2);
+ F_Right(3) := (Shift_Left(R(0),3) + R(0)) + (Shift_Left(R(1),1)+R(1)) + R(2);
+ F_Left(4) := Shift_Left(L(0),4) + Shift_Left(L(1),2) + L(2);
+ F_Right(4) := Shift_Left(R(0),4) + Shift_Left(R(1),2) + R(2);
+
+ -- INTERPOLATION with POINTWISE MULT .....................................
+
+ knuth_1(1) := L(2)* R(2);
+ knuth_1(2) := (L(0) + L(1) + L(2)) * (R(0) + R(1) + R(2));
+ knuth_1(3) := F_Left(2) * F_Right(2);
+ knuth_1(4) := F_Left(3) * F_Right(3);
+ knuth_1(5) := F_Left(4) * F_Right(4);
+
+ knuth_2(1) := knuth_1(2) - knuth_1(1);
+ knuth_2(2) := knuth_1(3) - knuth_1(2);
+ knuth_2(3) := knuth_1(4) - knuth_1(3);
+ knuth_2(4) := knuth_1(5) - knuth_1(4);
+ knuth_3(1) := Shift_Right((knuth_2(2) - knuth_2(1)),1);
+ knuth_3(2) := Shift_Right((knuth_2(3) - knuth_2(2)),1);
+ knuth_3(3) := Shift_Right((knuth_2(4) - knuth_2(3)),1);
+ knuth_4(1) := (knuth_3(2) - knuth_3(1)) / 3;
+ knuth_4(2) := (knuth_3(3) - knuth_3(2)) / 3;
+ knuth_5_1 := Shift_Right(knuth_4(2) - knuth_4(1),2);
+
+ Z(0) := knuth_5_1;
+ Z(1) := knuth_4(1);
+ Z(2) := knuth_3(1);
+ Z(3) := knuth_2(1);
+ Z(4) := knuth_1(1);
+
+ -- RECOMPOSITION ............................................................
+
+ knuth_1(1) := Z(1) - (Z(0) + Shift_Left(Z(0),1));
+ knuth_1(2) := knuth_1(1) - (Shift_Left(Z(0),1));
+ knuth_1(3) := knuth_1(2) - Z(0);
+ knuth_2(1) := Z(2) - (Shift_Left(knuth_1(1),1));
+ knuth_2(2) := knuth_2(1) - knuth_1(2);
+ knuth_3(1) := Z(3) - knuth_2(1);
+
+ Result := Shift_Left( Z(0), DN*2)
+ + Shift_Left(knuth_1(3), DN+N)
+ + Shift_Left(knuth_2(2), DN)
+ + Shift_Left(knuth_3(1), N)
+ + Z(4);
+ end;
+ end if;
+ return Result;
+ end Toom_Cook;
+
+--------------------------------------------------------------------------------
+
+ function Toom_Cook_P(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ begin
+ if Bit_Length(Left)+Bit_Length(Right) < Word'Size then
+ Result.Number(0) := Left.Number(0) * Right.Number(0);
+ else
+ declare
+ knuth_1 : Array (1..5) of Big_Unsigned;
+ knuth_2 : Array (1..4) of Big_Unsigned;
+ knuth_3 : Array (1..3) of Big_Unsigned;
+ knuth_4 : Array (1..2) of Big_Unsigned;
+ knuth_5_1 : Big_Unsigned;
+ L, R : Array (0..3) of Big_Unsigned;
+ F_Left, F_Right : Array (2..4) of Big_Unsigned;
+ Z : Array (0..4) of Big_Unsigned;
+
+ Length : constant Natural := Natural'Max(Bit_Length(Left) ,
+ Bit_Length(Right) );
+ N : constant Natural := Length / 3;
+ DN : constant Natural := 2 * N;
+
+ task type Toom_Cook_Task_Type is
+ entry Input (Left, Right : in Big_Unsigned);
+ entry Output(Result : out Big_Unsigned);
+ end Toom_Cook_Task_Type;
+ task body Toom_Cook_Task_Type is
+ X : Big_Unsigned;
+ Left_Local : Big_Unsigned;
+ Right_Local : Big_Unsigned;
+ begin
+ accept Input (Left, Right : Big_Unsigned) do
+ Left_Local := Left;
+ Right_Local := Right;
+ end Input;
+
+ X := Left_Local * Right_Local;
+
+ accept Output(Result : out Big_Unsigned) do
+ Result := X;
+ end Output;
+ end Toom_Cook_Task_Type;
+
+ Task_1 : Toom_Cook_Task_Type;
+ Task_2 : Toom_Cook_Task_Type;
+ Task_3 : Toom_Cook_Task_Type;
+ Task_4 : Toom_Cook_Task_Type;
+ Task_5 : Toom_Cook_Task_Type;
+
+ begin
+ -- SPLITTING .............................................................
+ L(0) := Shift_Right( Left, DN);
+ L(1) := Shift_Right( Left, N ) - Shift_Left( L(0), N );
+ L(2) := Left - Shift_Left( L(0), DN ) - Shift_Left( L(1), N );
+ R(0) := Shift_Right( Right, DN);
+ R(1) := Shift_Right( Right, N ) - Shift_Left( R(0), N );
+ R(2) := Right - Shift_Left( R(0), DN ) - Shift_Left( R(1), N );
+ -- EVALUATION ............................................................
+ F_Left(2) := Shift_Left(L(0),2) + Shift_Left(L(1),1) + L(2);
+ F_Right(2) := Shift_Left(R(0),2) + Shift_Left(R(1),1) + R(2);
+ F_Left(3) := (Shift_Left(L(0),3) + L(0))
+ + (Shift_Left(L(1),1)+L(1)) + L(2);
+ F_Right(3) := (Shift_Left(R(0),3) + R(0))
+ + (Shift_Left(R(1),1)+R(1)) + R(2);
+ F_Left(4) := Shift_Left(L(0),4) + Shift_Left(L(1),2) + L(2);
+ F_Right(4) := Shift_Left(R(0),4) + Shift_Left(R(1),2) + R(2);
+ -- INTERPOLATION with POINTWISE MULT .....................................
+ Task_1.Input( L(2), R(2) );
+ Task_2.Input(L(0) + L(1) + L(2), R(0) + R(1) + R(2));
+ Task_3.Input(F_Left(2), F_Right(2));
+ Task_4.Input(F_Left(3), F_Right(3));
+ Task_5.Input(F_Left(4), F_Right(4));
+ Task_1.Output(Result => knuth_1(1));
+ Task_2.Output(Result => knuth_1(2));
+ Task_3.Output(Result => knuth_1(3));
+ Task_4.Output(Result => knuth_1(4));
+ Task_5.Output(Result => knuth_1(5));
+
+ knuth_2(1) := knuth_1(2) - knuth_1(1);
+ knuth_2(2) := knuth_1(3) - knuth_1(2);
+ knuth_2(3) := knuth_1(4) - knuth_1(3);
+ knuth_2(4) := knuth_1(5) - knuth_1(4);
+ knuth_3(1) := Shift_Right((knuth_2(2) - knuth_2(1)),1);
+ knuth_3(2) := Shift_Right((knuth_2(3) - knuth_2(2)),1);
+ knuth_3(3) := Shift_Right((knuth_2(4) - knuth_2(3)),1);
+ knuth_4(1) := (knuth_3(2) - knuth_3(1)) / 3;
+ knuth_4(2) := (knuth_3(3) - knuth_3(2)) / 3;
+ knuth_5_1 := Shift_Right(knuth_4(2) - knuth_4(1),2);
+
+ Z(0) := knuth_5_1;
+ Z(1) := knuth_4(1);
+ Z(2) := knuth_3(1);
+ Z(3) := knuth_2(1);
+ Z(4) := knuth_1(1);
+ -- RECOMPOSITION .........................................................
+ knuth_1(1) := Z(1) - (Z(0) + Shift_Left(Z(0),1));
+ knuth_1(2) := knuth_1(1) - (Shift_Left(Z(0),1));
+ knuth_1(3) := knuth_1(2) - Z(0);
+ knuth_2(1) := Z(2) - (Shift_Left(knuth_1(1),1));
+ knuth_2(2) := knuth_2(1) - knuth_1(2);
+ knuth_3(1) := Z(3) - knuth_2(1);
+
+ Result := Shift_Left( Z(0), DN*2)
+ + Shift_Left(knuth_1(3), DN+N)
+ + Shift_Left(knuth_2(2), DN)
+ + Shift_Left(knuth_3(1), N)
+ + Z(4);
+ end;
+ end if;
+ return Result;
+ end Toom_Cook_P;
+
+--============================================================================--
+ ---------------------------------------------------------------------------
+
+ function "*"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is
+ begin
+ if Right = 0 or Left = Big_Unsigned_Zero then return Big_Unsigned_Zero;
+ elsif Right = 1 then return Left;
+ end if;
+
+ declare
+ Result : Big_Unsigned;
+ begin
+ for I in 0..Word'Size loop
+ if (Shift_Right(Right,I) mod 2) = 1 then
+ Result:= Result + Shift_Left(Left,I);
+ end if;
+ end loop;
+ return Result;
+ end;
+ end "*";
+
+ ---------------------------------------------------------------------------
+
+ function "*"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is
+ begin
+ return Right * Left;
+ end "*";
+
+ ---------------------------------------------------------------------------
+
+ function "**"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ begin
+ if Left = Big_Unsigned_Zero or Left = Big_Unsigned_One then
+ return Left;
+ end if;
+
+ -- Square_And_Multiply
+ declare
+ Result : Big_Unsigned := Big_Unsigned_One;
+ begin
+ for I in reverse 0..Bit_Length(Right)-1 loop
+ Result := Result * Result;
+ if (Shift_Right(Right, I) mod 2) = Big_Unsigned_One then
+ Result := Result * Left;
+ end if;
+ end loop;
+ return Result;
+ end;
+ end "**";
+
+ ---------------------------------------------------------------------------
+
+
+ function "/"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Q : Big_Unsigned;
+ R : Big_Unsigned;
+ begin
+ Big_Div(Left,Right,Q,R);
+ return Q;
+ end "/";
+
+ ---------------------------------------------------------------------------
+
+ function "/"(Left : Word; Right : Big_Unsigned) return Big_Unsigned is
+ Big_Left: constant Big_Unsigned :=
+ (Last_Index => 0, Number => (0=> Left, others => 0));
+ Q : Big_Unsigned;
+ R : Big_Unsigned;
+ begin
+ Big_Div(Big_Left,Right,Q,R);
+ return Q;
+ end "/";
+
+ ---------------------------------------------------------------------------
+
+ function "/"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is
+ Q : Big_Unsigned;
+ R : Word;
+ begin
+ Short_Div(Left,Right,Q,R);
+ return Q;
+ end "/";
+
+
+ ---------------------------------------------------------------------------
+
+ function "mod"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Q : Big_Unsigned;
+ R : Big_Unsigned;
+ begin
+ Big_Div(Left,Right,Q,R);
+ return R;
+ end "mod";
+
+
+
+ ---------------------------------------------------------------------------
+
+ function "mod"(Left : Big_Unsigned; Right : Word) return Big_Unsigned is
+ Q : Big_Unsigned;
+ R : Word;
+ begin
+ Short_Div(Left,Right,Q,R);
+ declare
+ Result: constant Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => R, others => 0));
+ begin
+ return Result;
+ end;
+ end "mod";
+
+ ---------------------------------------------------------------------------
+
+ -- This is a helper function
+ -- This procedure computes/adjust the Last_Index of B
+ procedure Last_Index(B : in out Big_Unsigned; M : in M_Len:=Max_Length) is
+ begin
+ for I in reverse 0..M loop
+ if B.Number(I) /= 0 then
+ B.Last_Index := I;
+ exit;
+ end if;
+ end loop;
+ end Last_Index; pragma Inline (Last_Index);
+
+ ---------------------------------------------------------------------------
+
+
+ function "xor"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index);
+ begin
+ -- xor
+ for I in 0..M loop
+ Result.Number(I) := Left.Number(I) xor Right.Number(I);
+ end loop;
+
+ -- compute the Last_Index
+ Last_Index(Result,M);
+
+ return Result;
+
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "and"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ M : constant Natural:= Natural'Min(Left.Last_Index, Right.Last_Index);
+ begin
+
+ --and
+ for I in 0..M loop
+ Result.Number(I) := Left.Number(I) and Right.Number(I);
+ end loop;
+
+ -- compute last index
+ Last_Index(Result, M);
+
+ return Result;
+ end "and";
+
+ ---------------------------------------------------------------------------
+
+
+ function "and"(Left : Big_Unsigned; Right : Word) return Big_Unsigned
+ is
+ Result : Big_Unsigned;
+ begin
+
+ Result.Number(0) := Left.Number(0) and Right;
+
+ -- compute last index
+ Last_Index(Result, 0);
+
+ return Result;
+ end "and";
+
+ ---------------------------------------------------------------------------
+
+ function "and"(Left : Word; Right : Big_Unsigned) return Big_Unsigned
+ is
+ Result : Big_Unsigned;
+ begin
+
+ Result.Number(0) := Left and Right.Number(0);
+
+ -- compute last index
+ Last_Index(Result, 0);
+
+ return Result;
+ end "and";
+
+ ---------------------------------------------------------------------------
+
+
+ function "or"(Left, Right : Big_Unsigned) return Big_Unsigned is
+ Result : Big_Unsigned;
+ M : constant Natural:= Natural'Max(Left.Last_Index, Right.Last_Index);
+ begin
+ -- or
+ for I in 0..M loop
+ Result.Number(I) := Left.Number(I) or Right.Number(I);
+ end loop;
+
+ -- compute last index
+ Last_Index(Result, M);
+
+ return Result;
+ end "or";
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+begin
+ if Size mod Word'Size /= 0 then
+ Put("Size must be a multiple of " & Word'Image(Word'Size));
+ raise Constraint_Size_Error;
+ end if;
+end Crypto.Types.Big_Numbers;
diff --git a/src/crypto-types-big_numbers.ads b/src/crypto-types-big_numbers.ads
new file mode 100644
index 0000000..f75ad6b
--- /dev/null
+++ b/src/crypto-types-big_numbers.ads
@@ -0,0 +1,399 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+-- With this packet you can generate (unsigned) n-Bit Numbers (Big_Unsigned).
+-- You can only create k*m Bit-Numbers where 1 < k < 2**32 and m is the
+-- size of a CPU-Word. For further informations read the ACL documentation.
+
+-- The look and feel is "borrowed" from J. Delcourt BIG_NUMBER package.
+-- First I want to use Delcourts package directly, but then I decided to
+-- rewrite it completly form scratch. ;-)
+
+with System;
+
+with Crypto.Types;
+use Crypto.Types;
+
+generic
+ Size : Positive;
+
+package Crypto.Types.Big_Numbers is
+
+ type Big_Unsigned is private;
+ subtype Number_Base is Integer range 2 .. 16;
+
+ -- Do not use this type. This one is only needed for internal purpose.
+ type D_Big_Unsigned is private;
+
+ ---------------------------------------------------------------------------
+ ---------------------------Constants---------------------------------------
+ ---------------------------------------------------------------------------
+
+ -- A few constants
+ Big_Unsigned_Zero : constant Big_Unsigned; -- 0
+ Big_Unsigned_One : constant Big_Unsigned; -- 1
+ Big_Unsigned_Two : constant Big_Unsigned; -- 2
+ Big_Unsigned_Three : constant Big_Unsigned; -- 3
+ Big_Unsigned_Four : constant Big_Unsigned; -- 4
+ Big_Unsigned_Ten : constant Big_Unsigned; -- 10
+ Big_Unsigned_Sixteen : constant Big_Unsigned; -- 16
+ Big_Unsigned_First : constant Big_Unsigned; -- 0
+ Big_Unsigned_Last : constant Big_Unsigned; -- "Big_Unsigned'Last"
+
+ ---------------------------------------------------------------------------
+ ----------------------------Compare----------------------------------------
+ ---------------------------------------------------------------------------
+
+ -- compare: Big Unsigned with Big_Unsigned
+ function "="(Left, Right : Big_Unsigned) return Boolean;
+ function "<"(Left, Right : Big_Unsigned) return Boolean;
+ function ">"(Left, Right : Big_Unsigned) return Boolean;
+
+ function "<="(Left, Right : Big_Unsigned) return Boolean;
+ function ">="(Left, Right : Big_Unsigned) return Boolean;
+
+ function Min(X, Y : in Big_Unsigned) return Big_Unsigned;
+ function Max(X, Y : in Big_Unsigned) return Big_Unsigned;
+
+ -- compare: Big Unsigned with Word
+ function "="(Left : Big_Unsigned; Right : Word) return Boolean;
+ function "="(Left : Word; Right : Big_Unsigned) return Boolean;
+
+ function "<"(Left : Big_Unsigned; Right : Word) return Boolean;
+ function "<"(Left : Word; Right : Big_Unsigned) return Boolean;
+
+ function ">"(Left : Big_Unsigned; Right : Word) return Boolean;
+ function ">"(Left : Word; Right : Big_Unsigned) return Boolean;
+
+ function "<="(Left : Big_Unsigned; Right : Word) return Boolean;
+ function "<="(Left : Word; Right : Big_Unsigned) return Boolean;
+
+ function ">="(Left : Big_Unsigned; Right : Word) return Boolean;
+ function ">="(Left : Word; Right : Big_Unsigned) return Boolean;
+
+
+ ---------------------------------------------------------------------------
+ -----------------------------Basic-----------------------------------------
+ ---------------------------------------------------------------------------
+
+ function "+"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "+"(Left : Big_Unsigned; Right : Word) return Big_Unsigned;
+ function "+"(Left : Word; Right : Big_Unsigned) return Big_Unsigned;
+
+ function "-"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "-"(Left : Big_Unsigned; Right : Word) return Big_Unsigned;
+ function "-"(Left : Word; Right : Big_Unsigned) return Big_Unsigned;
+
+ function "-"(X : Big_Unsigned) return Big_Unsigned;
+
+ function "*"(Left, Right : Big_Unsigned) return Big_Unsigned;
+--============================================================================--
+ function Russ (Left, Right : Big_Unsigned) return Big_Unsigned;
+ function Karatsuba (Left, Right : Big_Unsigned) return Big_Unsigned;
+ function Karatsuba_P (Left, Right : Big_Unsigned) return Big_Unsigned;
+-- function Karatsuba_Prot (Left, Right : Big_Unsigned) return Big_Unsigned;
+ function Toom_Cook (Left, Right : Big_Unsigned) return Big_Unsigned;
+ function Toom_Cook_P (Left, Right : Big_Unsigned) return Big_Unsigned;
+--============================================================================--
+ function "*"(Left : Big_Unsigned; Right : Word) return Big_Unsigned;
+ function "*"(Left : Word; Right : Big_Unsigned) return Big_Unsigned;
+
+ function "/"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "/"(Left : Big_Unsigned; Right : Word) return Big_Unsigned;
+ function "/"(Left : Word; Right : Big_Unsigned) return Big_Unsigned;
+
+ function "xor"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "or" (Left, Right : Big_Unsigned) return Big_Unsigned;
+
+ function "and"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "and"(Left: Big_Unsigned; Right: Word) return Big_Unsigned;
+ function "and"(Left: Word; Right: Big_Unsigned) return Big_Unsigned;
+
+ function "**"(Left, Right : Big_Unsigned) return Big_Unsigned;
+
+ function "mod"(Left, Right : Big_Unsigned) return Big_Unsigned;
+ function "mod"(Left : Big_Unsigned; Right : Word) return Big_Unsigned;
+
+ ---------------------------------------------------------------------------
+ ----------------------------Utils------------------------------------------
+ ---------------------------------------------------------------------------
+
+ package Utils is
+
+ procedure Swap(X, Y : in out Big_Unsigned);
+
+ procedure Set_Least_Significant_Bit(X : in out Big_Unsigned);
+ procedure Set_Most_Significant_Bit(X : in out Big_Unsigned);
+
+ -- Returns true if X is odd .
+ function Is_Odd(X : Big_Unsigned) return Boolean;
+
+ -- Returns true if X is even.
+ function Is_Even(X : Big_Unsigned) return Boolean;
+
+
+ -- Caution: All operations are mod Big_unsigned_Last+1.
+ -- X = Big_unsigned_Zero
+ -- Inc(X)
+ -- X = Big_Unsigned_Last
+ -- Dec(X)
+ -- X = Big_unsigned_Zero
+ procedure Inc(X : in out Big_Unsigned);
+ procedure Dec(X : in out Big_Unsigned);
+
+ function To_Big_Unsigned(X : Word) return Big_Unsigned;
+
+
+ function Shift_Left(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned;
+
+ function Shift_Right(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned;
+
+ function Rotate_Left(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned;
+
+ function Rotate_Right(Value : Big_Unsigned; Amount : Natural)
+ return Big_Unsigned;
+
+ function Get_Random return Big_Unsigned;
+
+ function Bit_Length(X : Big_Unsigned) return Natural;
+
+ function Lowest_Set_Bit(X : Big_Unsigned) return Natural;
+
+ function Length_In_Bytes(X : Big_Unsigned) return Natural;
+
+ function Gcd(Left, Right : Big_Unsigned) return Big_Unsigned;
+
+ function To_Bytes(X : Big_Unsigned) return Bytes;
+
+ function To_Big_Unsigned(X : Bytes) return Big_Unsigned;
+
+ function To_Words(X : Big_Unsigned) return Words;
+
+ function To_Big_Unsigned(X : Words) return Big_Unsigned;
+
+ function To_String(Item : Big_Unsigned;
+ Base : Number_Base := 10) return String;
+
+ function To_Big_Unsigned(S : String) return Big_Unsigned;
+
+ procedure Put(Item : in Big_Unsigned; Base : in Number_Base := 10);
+
+ procedure Put_Line(Item : in Big_Unsigned; Base : in Number_Base := 10);
+
+
+ procedure Big_Div(Dividend, Divisor : in Big_Unsigned;
+ Quotient, Remainder : out Big_Unsigned);
+
+ procedure Short_Div(Dividend : in Big_Unsigned;
+ Divisor : in Word;
+ Quotient : out Big_Unsigned;
+ Remainder : out Word);
+ end Utils;
+
+ ---------------------------------------------------------------------------
+ --------------------------Mod_Utils----------------------------------------
+ ---------------------------------------------------------------------------
+
+ package Mod_Utils is
+ -- All operations in this package are mod N
+
+ function Add (Left, Right, N : Big_Unsigned) return Big_Unsigned;
+ function Sub (Left, Right, N : Big_Unsigned) return Big_Unsigned;
+ function Div (Left, Right, N : Big_Unsigned) return Big_Unsigned;
+ function Mult(Left, Right, N : Big_Unsigned) return Big_Unsigned;
+-- function Barrett(Left, Right, M : Big_Unsigned) return Big_Unsigned;
+-- function Mult_School(Left, Right, N : Big_Unsigned) return Big_Unsigned;
+
+ function Pow (Base, Exponent, N : Big_Unsigned) return Big_Unsigned;
+
+ -- Returns a random Big_Unsigned mod N
+ function Get_Random (N : Big_Unsigned) return Big_Unsigned;
+
+ function Inverse (X, N : Big_Unsigned) return Big_Unsigned;
+
+
+ -- This function returns with an overwhelming probability a prim
+ function Get_Prime(N : Big_Unsigned) return Big_Unsigned;
+
+ -- This function returns with an overwhelming probability a n-bit prim
+ function Get_N_Bit_Prime(N : Positive) return Big_Unsigned;
+
+ -- This function returns true if X is a prim and
+ -- with an overwhelming probability false if X is not prime
+ -- The change that a snowball survive one day in hell are greater that
+ -- this function returns true if X is no prim.
+ -- functionality:
+ -- 1. Test if a one digit prime (2,3,5,7) divides X
+ -- 2. Test if a two digit prime number divides X
+ -- 3. Test if X is a "Lucas-Lehmer" prime
+ -- 4. Test if a three digit prime number divides X
+ -- 5. compute N random Big_Unsigneds and test if one
+ -- of those is an Miller-Rabin wittness ( 1 < N < 51)
+ -- (N depends on the Bit_Length of X).
+ function Is_Prime(X : Big_Unsigned) return Boolean;
+
+
+ -- a weaker but faster prime test
+ function Looks_Like_A_Prime(X : Big_Unsigned) return Boolean;
+
+
+ -- Returns only true if X passed n iterations of the
+ -- Miller-Rabin tests. This test is taken from the DSA spec (NIST FIPS
+ -- 186-2).The execution time of this function is proportional
+ -- to the value of this parameter.
+ -- The probability that a pseudoprim pass this test is < (1/(2**(2*S)))
+ function Passed_Miller_Rabin_Test(X : Big_Unsigned;
+ S : Positive) return Boolean;
+
+ function Jacobi(X, N : Big_Unsigned) return Integer;
+
+
+ -- internal functions for Binfield_Utils. Please, DON'T use them.
+ function Shift_Left(Value : D_Big_Unsigned; Amount : Natural)
+ return D_Big_Unsigned;
+ function Bit_Length(X : D_Big_Unsigned) return Natural;
+ end Mod_Utils;
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+ package Binfield_Utils is
+
+ -- binary field operations
+ -- F is the irreducible polynom with f(z)=2^m + r(z)
+ -- Remember all operations are in GF(2^m)
+
+ function B_Add(Left,Right : Big_Unsigned) return Big_Unsigned;
+ function B_Sub(Left,Right : Big_Unsigned) return Big_Unsigned;
+
+ function B_Mult(Left, Right, F : Big_Unsigned) return Big_Unsigned;
+ function B_Div (Left, Right, F : Big_Unsigned) return Big_Unsigned;
+
+ function B_Square(A, F : Big_Unsigned) return Big_Unsigned;
+
+ function B_Mod(Left, Right : Big_Unsigned) return Big_Unsigned;
+
+ function B_Inverse(X, F : Big_Unsigned) return Big_Unsigned;
+
+ end Binfield_Utils;
+
+ ---------------------------------------------------------------------------
+ -----------------------------Exceptions------------------------------------
+ ---------------------------------------------------------------------------
+
+ Constraint_Size_Error : exception;
+ Division_By_Zero : exception;
+ Conversion_Error : exception;
+ Is_Zero_Error : exception;
+
+-- Big_Unsigned_Overflow : exception;
+-- Big_Unsigned_Negative : exception;
+
+ ---------------------------------------------------------------------------
+ --------------------------------PRIVATE------------------------------------
+ ---------------------------------------------------------------------------
+
+private
+ type Largest_Unsigned is mod System.Max_Binary_Modulus;
+
+ Max_Length : Natural := (Size/Word'Size)-1;
+ D_Max_Length : Positive := 2*Max_Length+1;
+
+ subtype Limbs is Words(0..Max_Length);
+ subtype DLimbs is Words(0..D_Max_Length);
+
+ subtype M_Len is Natural range Limbs'Range;
+
+ -- This is our Big_Unsigned
+ -- It represents a Size*Word'Size-bit number
+ -- Last_Index is the Number of the last slice who
+ -- contains the most significant bit of the current number.
+ -- Ex.:
+ -- Word'Size = 24
+ -- Our Big_Unsigned A is equal to 2**100-7
+ -- Big_Unsignesd_Last = 2**240-1
+ -- So only Slice 0-4 contains a part of the current 99-Bit number (2**100-7)
+ -- In this case A.Last_Index = 4 because A.X(5)=...=A.X(9)=0
+
+ type Big_Unsigned is record
+ Last_Index : Natural:=0;
+ Number : Limbs:=(others => 0);
+ end record;
+
+ type D_Big_Unsigned is record
+ Last_Index : Natural:=0;
+ Number : DLimbs:=(others => 0);
+ end record;
+
+ -- prime test
+ type Hardness is (Weak, Strong);
+
+
+ -- Constants definitions
+ Big_Unsigned_Zero : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (OTHERS => 0));
+ Big_Unsigned_One : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 1, OTHERS => 0));
+ Big_Unsigned_Two : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 2, OTHERS => 0));
+ Big_Unsigned_Three : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 3, OTHERS => 0));
+ Big_Unsigned_Four : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 4, OTHERS => 0));
+ Big_Unsigned_Ten : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 10, OTHERS => 0));
+ Big_Unsigned_Sixteen : CONSTANT Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 16, OTHERS => 0));
+ Big_Unsigned_First : CONSTANT Big_Unsigned :=
+ Big_Unsigned_Zero;
+ Big_Unsigned_Last : CONSTANT Big_Unsigned :=
+ (Last_Index => Max_Length, Number => (OTHERS => Word'Last));
+
+
+ D_Big_Unsigned_Zero : CONSTANT D_Big_Unsigned :=
+ (Last_Index => 0, Number => (OTHERS => 0));
+ D_Big_Unsigned_One : CONSTANT D_Big_Unsigned :=
+ (Last_Index => 0, Number => (0 => 1, OTHERS => 0));
+ D_Big_Unsigned_Last : CONSTANT D_Big_Unsigned :=
+ (Last_Index => D_Max_Length, Number => (OTHERS => Word'Last));
+
+ -- Shifting
+
+ function Shift_Left (Value : Largest_Unsigned; Amount : Natural)
+ return Largest_Unsigned;
+ function Shift_Right (Value : Largest_Unsigned; Amount : Natural)
+ return Largest_Unsigned;
+
+
+
+ --pragma Inline("-", "/", "**", "mod", "xor", "and", "or");
+ pragma Inline("=", "<", ">", "<=", ">=", Min, Max);
+ pragma Import (Intrinsic, Shift_Left);
+ pragma Import (Intrinsic, Shift_Right);
+
+ pragma Optimize (Time);
+
+end Crypto.Types.Big_Numbers;
diff --git a/src/crypto-types-random.adb b/src/crypto-types-random.adb
new file mode 100644
index 0000000..4eb6aca
--- /dev/null
+++ b/src/crypto-types-random.adb
@@ -0,0 +1,72 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+--with Ada.Numerics.Discrete_Random;
+
+with Crypto;
+with Crypto.Types.Random_Source.File;
+
+package body Crypto.Types.Random is
+ Dev_Random : Crypto.Types.Random_Source.File.Random_Source_File;
+
+ Rnd_Src : aliased Crypto.Types.Random_Source.Random_Source'Class
+ := Crypto.Types.Random_Source.Random_Source'Class(Dev_Random);
+
+ procedure Set(Source : in Crypto.Types.Random_Source.Random_Source'Class) is
+ begin
+ Rnd_Src := Source;
+ end Set;
+
+ procedure Read(B : out Byte) is
+ begin
+ Rnd_Src.Read(B);
+ end Read;
+
+ procedure Read(Byte_Array : out Bytes) is
+ begin
+ Rnd_Src.Read(Byte_Array);
+ end Read;
+
+ procedure Read(B : out B_Block128) is
+ begin
+ Rnd_Src.Read(B);
+ end Read;
+
+ procedure Read(W : out Word) is
+ begin
+ Rnd_Src.Read(W);
+ end Read;
+
+ procedure Read(Word_Array : out Words) is
+ begin
+ Rnd_Src.Read(Word_Array);
+ end Read;
+
+ procedure Read(D : out DWord) is
+ begin
+ Rnd_Src.Read(D);
+ end Read;
+
+ procedure Read(DWord_Array : out DWords) is
+ begin
+ Rnd_Src.Read(DWord_Array);
+ end Read;
+end Crypto.Types.Random;
diff --git a/src/crypto-types-random.ads b/src/crypto-types-random.ads
new file mode 100644
index 0000000..a3e0b37
--- /dev/null
+++ b/src/crypto-types-random.ads
@@ -0,0 +1,41 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+with Crypto.Types.Random_Source;
+use Crypto.Types;
+
+package Crypto.Types.Random is
+ procedure Set(Source : in Crypto.Types.Random_Source.Random_Source'Class);
+
+ procedure Read(B : out Byte);
+ procedure Read(Byte_Array : out Bytes);
+ procedure Read(B : out B_Block128);
+
+ procedure Read(W : out Word);
+ procedure Read(Word_Array : out Words);
+
+ procedure Read(D : out DWord);
+ procedure Read(DWord_Array : out DWords);
+
+ pragma Inline (Read);
+ pragma Optimize (Time);
+end Crypto.Types.Random;
diff --git a/src/crypto-types-random_source-file.adb b/src/crypto-types-random_source-file.adb
new file mode 100644
index 0000000..e665990
--- /dev/null
+++ b/src/crypto-types-random_source-file.adb
@@ -0,0 +1,144 @@
+package body Crypto.Types.Random_Source.File is
+ use Ada.Strings.Unbounded;
+ use Ada.Streams.Stream_IO;
+
+ ---------------------------------------------------------------------------
+ ------------------------ Initialization -----------------------------------
+ ---------------------------------------------------------------------------
+
+
+ procedure Initialize(This : in out Random_Source_File) is
+ Path : constant String := "/dev/random";
+ Mode : constant File_Mode := In_File;
+ begin
+ if This.Source_File = null then
+ This.Source_File := new Ada.Streams.Stream_IO.File_Type;
+ end if;
+ if not Is_Open(This.Source_File.all) then
+ Open(This.Source_File.all, Mode, Path, "shared=yes");
+ This.Source_Path := To_Unbounded_String(Path);
+ end if;
+ end Initialize;
+
+ ---------------------------------------------------------------------------
+
+ procedure Initialize(This : in out Random_Source_File;
+ File_Path : in String) is
+ Mode : constant File_Mode := In_File;
+ begin
+ if Is_Open(This.Source_File.all) then
+ Close(This.Source_File.all);
+ end if;
+ if not Is_Open(This.Source_File.all) then
+ Open(This.Source_File.all, Mode, File_Path, "shared=yes");
+ This.Source_Path := To_Unbounded_String(File_Path);
+ end if;
+ end Initialize;
+
+ ---------------------------------------------------------------------------
+ ------------------------------- Read Byte ---------------------------------
+ ---------------------------------------------------------------------------
+
+
+ procedure Read(This : in out Random_Source_File; B : out Byte) is
+
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ Byte'Read(Stream(This.Source_File.all), B);
+ end if;
+ end Read;
+
+ ---------------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source_File; Byte_Array : out Bytes) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ Bytes'Read(Stream(This.Source_File.all), Byte_Array);
+ end if;
+ end Read;
+
+ ---------------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source_File; B : out B_Block128) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ B_Block128'Read(Stream(This.Source_File.all), B);
+ end if;
+ end Read;
+
+ ---------------------------------------------------------------------------
+ ------------------------------- Read Word ---------------------------------
+ ---------------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source_File; W : out Word) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ Word'Read(Stream(This.Source_File.all), W);
+ end if;
+ end Read;
+
+ ---------------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source_File; Word_Array : out Words) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ Words'Read(Stream(This.Source_File.all), Word_Array);
+ end if;
+ end Read;
+
+ ---------------------------------------------------------------------------
+ ------------------------------- Read DWord --------------------------------
+ ---------------------------------------------------------------------------
+
+
+ procedure Read(This : in out Random_Source_File; D : out DWord) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ DWord'Read(Stream(This.Source_File.all), D);
+ end if;
+ end Read;
+
+ procedure Read(This : in out Random_Source_File; DWord_Array : out DWords) is
+ begin
+ if not Path_Starts_With(This, "/dev/") and then End_Of_File(This.Source_File.all) then
+ raise RANDOM_SOURCE_READ_ERROR with To_String(This.Source_Path);
+ else
+ DWords'Read(Stream(This.Source_File.all), DWord_Array);
+ end if;
+ end Read;
+
+
+ ---------------------------------------------------------------------------
+ ------------------------------- Finalize ----------------------------------
+ ---------------------------------------------------------------------------
+
+ procedure Finalize(This : in out Random_Source_File) is
+ begin
+ if Is_Open(This.Source_File.all) then
+ Close(This.Source_File.all);
+ end if;
+ end Finalize;
+
+ ---------------------------------------------------------------------------
+ --------------------------- Path_Starts_With ------------------------------
+ ---------------------------------------------------------------------------
+
+ function Path_Starts_With(This : Random_Source_File; S : String) return Boolean is
+ Path : constant String := To_String(This.Source_Path);
+ begin
+ return Path(Path'First..S'Last) = S;
+ end;
+
+end Crypto.Types.Random_Source.File;
diff --git a/src/crypto-types-random_source-file.ads b/src/crypto-types-random_source-file.ads
new file mode 100644
index 0000000..8a3e960
--- /dev/null
+++ b/src/crypto-types-random_source-file.ads
@@ -0,0 +1,50 @@
+with Ada.Streams.Stream_IO;
+with Ada.Strings.Unbounded;
+
+package Crypto.Types.Random_Source.File is
+ package Rnd renames Crypto.Types.Random_Source;
+
+ type Random_Source_File is new Rnd.Random_Source with private;
+ type Random_Source_File_Access is access Random_Source_File;
+
+ Overriding
+ procedure Finalize(This : in out Random_Source_File);
+
+ Overriding
+ procedure Initialize(This : in out Random_Source_File);
+
+ procedure Initialize(This : in out Random_Source_File;
+ File_Path : in String);
+ Overriding
+ procedure Read(This : in out Random_Source_File; B : out Byte);
+
+ Overriding
+ procedure Read(This : in out Random_Source_File; Byte_Array : out Bytes);
+
+ Overriding
+ procedure Read(This : in out Random_Source_File; B : out B_Block128);
+
+ Overriding
+ procedure Read(This : in out Random_Source_File; W : out Word);
+
+ Overriding
+ Procedure Read(This : in out Random_Source_File; Word_Array : out Words);
+
+ Overriding
+ procedure Read(This : in out Random_Source_File; D : out DWord);
+
+ Overriding
+ procedure Read(This : in out Random_Source_File; DWord_Array : out DWords);
+private
+ type File_Access is access Ada.Streams.Stream_IO.File_Type;
+
+ type Random_Source_File is new Rnd.Random_Source with
+ record
+ Source_Path : Ada.Strings.Unbounded.Unbounded_String;
+ Source_File : File_Access;
+ end record;
+
+ function Path_Starts_With(This : Random_Source_File; S : String)
+ return Boolean;
+
+end Crypto.Types.Random_Source.File;
diff --git a/src/crypto-types-random_source.adb b/src/crypto-types-random_source.adb
new file mode 100644
index 0000000..5fd4dbb
--- /dev/null
+++ b/src/crypto-types-random_source.adb
@@ -0,0 +1,55 @@
+package body Crypto.Types.Random_Source is
+
+ procedure Read(This : in out Random_Source; Byte_Array : out Bytes) is
+ begin
+ for I in Byte_Array'Range loop
+ Read(Random_Source'class(This),Byte_Array(I));
+ end loop;
+ end Read;
+
+ ----------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source; B : out B_Block128) is
+ begin
+ for I in B'Range loop
+ Read(Random_Source'class(This),B(I));
+ end loop;
+ end Read;
+
+ ----------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source; W : out Word) is
+ B : Byte_Word;
+ begin
+ This.Read(Bytes(B));
+ W := To_Word(B);
+ end Read;
+
+ ----------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source; Word_Array : out Words) is
+ begin
+ for I in Word_Array'Range loop
+ This.Read(Word_Array(I));
+ end loop;
+ end Read;
+
+ ----------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source; D : out DWord) is
+ B : Byte_DWord;
+ begin
+ This.Read(Bytes(B));
+ D := To_DWord(B);
+ end Read;
+
+ ----------------------------------------------------------------------
+
+ procedure Read(This : in out Random_Source; DWord_Array : out DWords) is
+ begin
+ for I in DWord_Array'Range loop
+ This.Read(DWord_Array(I));
+ end loop;
+ end Read;
+
+end Crypto.Types.Random_Source;
diff --git a/src/crypto-types-random_source.ads b/src/crypto-types-random_source.ads
new file mode 100644
index 0000000..9ad55f6
--- /dev/null
+++ b/src/crypto-types-random_source.ads
@@ -0,0 +1,27 @@
+with Ada.Finalization;
+
+package Crypto.Types.Random_Source is
+ use Crypto.Types;
+ package Fin renames Ada.Finalization;
+
+ type Random_Source is abstract new Fin.Controlled with null record;
+ type Random_Source_Access is access Random_Source;
+
+ Random_Source_Read_Error : exception;
+
+ procedure Initialize (This: in out Random_Source) is abstract;
+
+ procedure Read(This : in out Random_Source; B : out Byte) is abstract;
+
+ procedure Read(This : in out Random_Source; Byte_Array : out Bytes);
+
+ procedure Read(This : in out Random_Source; B : out B_Block128);
+
+ procedure Read(This : in out Random_Source; W : out Word);
+ procedure Read(This : in out Random_Source; Word_Array : out Words);
+
+ procedure Read(This : in out Random_Source; D : out DWord);
+ procedure Read(This : in out Random_Source; DWord_Array : out DWords);
+
+ pragma Inline(Read);
+end Crypto.Types.Random_Source;
diff --git a/src/crypto-types.adb b/src/crypto-types.adb
new file mode 100644
index 0000000..ac9afc2
--- /dev/null
+++ b/src/crypto-types.adb
@@ -0,0 +1,944 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+with Ada.Unchecked_Conversion;
+
+--pragma Elaborate_All(Generic_Mod_Aux);
+
+package body Crypto.Types is
+
+ package body Generic_Mod_Aux is
+ function "xor"(Left, Right : T_A) return T_A is
+ Result : T_A(0..Left'Length-1);
+ begin
+ if Left'Length /= Right'Length then
+ raise Constraint_Error;
+ end if;
+ for I in 0..Left'Length-1 loop
+ Result(I) := Left(Left'First+I) xor Right(Right'First+I);
+ end loop;
+ return Result;
+ end "xor";
+
+ ------------------------------------------------------------------------
+
+ function "xor"(Left : T_A; Right : T) return T_A is
+ Result : T_A := Left;
+ begin
+ Result(Result'Last) := Left(Result'Last) xor Right;
+ return Result;
+ end "xor";
+
+ ------------------------------------------------------------------------
+
+ function "xor"(Left : T; Right : T_A) return T_A is
+ begin
+ return Right xor Left;
+ end "xor";
+
+
+ ------------------------------------------------------------------------
+
+ function "and"(Left, Right : T_A) return T_A is
+ Result : T_A(0..Left'Length-1);
+ begin
+
+ if Left'Length /= Right'Length then
+ raise Constraint_Error;
+ end if;
+ for I in 0..Left'Length-1 loop
+ Result(I) := Left(Left'First+I) and Right(Right'First+I);
+ end loop;
+ return Result;
+ end "and";
+
+ ------------------------------------------------------------------------
+ function "+"(Left : T_A; Right : T) return T_A is
+ Result: T_A(Left'Range) := Left;
+ begin
+ Result(Left'Last) := Left(Left'Last) + Right;
+
+ -- overflow?
+ if Result(Left'Last) < Left(Left'Last) then
+ for I in reverse Left'First..Left'Last-1 loop
+ Result(I):=Result(I)+1;
+ if Result(I) /= 0 then
+ return Result;
+ end if;
+ end loop;
+ end if;
+ return Result;
+ end "+";
+
+
+ ------------------------------------------------------------------------
+ function "+"(Left : T; Right : T_A) return T_A is
+ begin
+ return Right + Left;
+ end "+";
+ ------------------------------------------------------------------------
+
+ function Is_Zero(Item : T_A) return Boolean is
+ begin
+ for I in Item'Range loop
+ if Item(I) /= 0 then return False;
+ end if;
+ end loop;
+ return True;
+ end Is_Zero;
+
+------------------------------------------------------------------------
+
+ function Left_Part(Block : in T_A) return T_A is
+ Len : constant Natural := ((Block'Length+1)/2)-1;
+ Left : constant T_A(0..Len) := Block(Block'First..(Block'First+Len));
+ begin
+ return Left;
+ end Left_Part;
+
+ ------------------------------------------------------------------------
+
+ function Right_Part(Block : in T_A) return T_A is
+ Len : constant Natural := Block'Length/2;
+ Right : constant T_A(0..Len-1) := Block(Block'Last-Len+1..Block'Last);
+ begin
+ return Right;
+ end Right_Part;
+
+ ------------------------------------------------------------------------
+
+ function Shift_Left(Value : T_A; Amount : Natural) return T_A is
+ Result : T_A(Value'Range) := (others => 0);
+ L : constant Natural := Amount mod T'Size;
+ M : constant Natural := Value'First+(Amount/T'Size);
+ begin
+ if Amount >= Value'Size then
+ return Result;
+ elsif Amount = 0 then
+ return Value;
+ end if;
+ Result(Value'Last-M) := Shift_Left(Value(Value'Last),L);
+
+ for I in reverse Value'First..Value'Last-(M+1) loop
+ Result(I) := Shift_Left(Value(I),L)
+ xor Shift_Right(Value(I+1),T'Size-L);
+ end loop;
+ return Result;
+ end Shift_Left;
+ -------------------------------------------------------------------------
+ function Shift_Right(Value : T_A; Amount : Natural) return T_A is
+ Result : T_A(Value'Range) := (others => 0);
+ L : constant Natural := Amount mod T'Size;
+ M : constant Natural := Value'First+(Amount/T'Size);
+ begin
+ if Amount >= Value'Size then
+ return Result;
+ elsif Amount = 0 then
+ return Value;
+ end if;
+ Result(Value'Last-M) := Shift_Right(Value(Value'Last),L);
+
+ for I in reverse Value'First..Value'Last-(M+1) loop
+ Result(I) := Shift_Right(Value(I),L)
+ xor Shift_Left(Value(I+1),T'Size-L);
+ end loop;
+ return Result;
+ end Shift_Right;
+
+ end Generic_Mod_Aux;
+
+
+ function Cast is new Ada.Unchecked_Conversion (Byte_Word, Word);
+ function Cast is new Ada.Unchecked_Conversion (Word, Byte_Word);
+ function DCast is new Ada.Unchecked_Conversion (Byte_DWord, DWord);
+ function DCast is new Ada.Unchecked_Conversion (DWord, Byte_DWord);
+ pragma Inline (Cast, DCast);
+
+
+ package Aux_Byte is new Generic_Mod_Aux(Byte,Bytes);
+ package Aux_Word is new Generic_Mod_Aux(Word,Words);
+ package Aux_DWord is new Generic_Mod_Aux(Dword,DWords);
+
+ ---------------------------------------------------------------------------
+
+ function To_Word(A,B,C,D : Character) return Word is
+ begin
+ return Cast((Byte(Character'Pos(D)), Byte(Character'Pos(C)),
+ Byte(Character'Pos(B)), Byte(Character'Pos(A))));
+ end To_Word;
+
+ ---------------------------------------------------------------------------
+
+ function To_Word(A,B,C,D : Byte) return Word is
+ begin
+ return Cast((D, C, B, A));
+ end To_Word;
+
+ ---------------------------------------------------------------------------
+
+ function To_Word (X : Byte_Word) return Word is
+ begin
+ return Cast((X(3), X(2), X(1), X(0)));
+ end To_Word;
+
+ ---------------------------------------------------------------------------
+
+ function R_To_Word (X : Byte_Word) return Word is
+ begin
+ return Cast(X);
+ end R_To_Word;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes (X : Word) return Byte_Word is
+ begin
+ return (Cast(X)(3), Cast(X)(2), Cast(X)(1), Cast(X)(0));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function R_To_Bytes (X : Word) return Byte_Word is
+ begin
+ return Cast(X);
+ end R_To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function Byte0 (W : Word) return Byte is
+ begin
+ return Cast(W)(3);
+ end Byte0;
+
+ ---------------------------------------------------------------------------
+
+ function Byte1 (W : Word) return Byte is
+ begin
+ return Cast(W)(2);
+ end Byte1;
+
+ ---------------------------------------------------------------------------
+
+ function Byte2 (W : Word) return Byte is
+ begin
+ return Cast(W)(1);
+ end Byte2;
+
+ ---------------------------------------------------------------------------
+
+ function Byte3 (W : Word) return Byte is
+ begin
+ return Cast(W)(0);
+ end Byte3;
+
+ ---------------------------------------------------------------------------
+
+ function To_DWord (X : Byte_DWord) return DWord is
+ begin
+ return DCast((X(7), X(6), X(5), X(4), X(3), X(2), X(1), X(0)));
+ end To_DWord;
+
+ ---------------------------------------------------------------------------
+
+ function R_To_DWord (X : Byte_DWord) return DWord is
+ begin
+ return DCast(X);
+ end R_To_DWord;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes (X : DWord) return Byte_DWord is
+ begin
+ return (DCast(X)(7), DCast(X)(6), DCast(X)(5), DCast(X)(4),
+ DCast(X)(3), DCast(X)(2), DCast(X)(1), DCast(X)(0));
+
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function R_To_Bytes (X : DWord) return Byte_DWord is
+ begin
+ return DCast(X);
+ end R_To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function Byte0 (D : DWord) return Byte is
+ begin
+ return DCast(D)(7);
+ end Byte0;
+
+ ---------------------------------------------------------------------------
+ function Byte1 (D : DWord) return Byte is
+ begin
+ return DCast(D)(6);
+ end Byte1;
+
+ ---------------------------------------------------------------------------
+
+ function Byte2 (D : DWord) return Byte is
+ begin
+ return DCast(D)(5);
+ end Byte2;
+
+ ---------------------------------------------------------------------------
+
+ function Byte3 (D : DWord) return Byte is
+ begin
+ return DCast(D)(4);
+ end Byte3;
+
+ ---------------------------------------------------------------------------
+
+ function Byte4 (D : DWord) return Byte is
+ begin
+ return DCast(D)(3);
+ end Byte4;
+
+ ---------------------------------------------------------------------------
+
+ function Byte5 (D : DWord) return Byte is
+ begin
+ return DCast(D)(2);
+ end Byte5;
+
+ ---------------------------------------------------------------------------
+
+ function Byte6 (D : DWord) return Byte is
+ begin
+ return DCast(D)(1);
+ end Byte6;
+
+ ---------------------------------------------------------------------------
+
+ function Byte7 (D : DWord) return Byte is
+ begin
+ return DCast(D)(0);
+ end Byte7;
+
+ ---------------------------------------------------------------------------
+
+
+ function "xor"(Left, Right : Bytes) return Bytes is
+ begin
+ return Aux_Byte."xor"(Left,Right);
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left : Bytes; Right : Byte) return Bytes is
+ begin
+ return Aux_Byte."xor"(Left,Right);
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Bytes; Right : Byte) return Bytes is
+ begin
+ return Aux_Byte."+"(Left,Right);
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Byte; Right : Bytes) return Bytes is
+ begin
+ return Right + Left;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "and"(Left, Right : Bytes) return Bytes is
+ begin
+ return Aux_Byte."and"(Left,Right);
+ end "and";
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : Words) return Words is
+ begin
+ return Aux_Word."xor"(Left,Right);
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Words; Right : Word) return Words is
+
+ begin
+ return Aux_Word."+"(Left,Right);
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Word; Right : Words) return Words is
+ begin
+ return Right + Left;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : Words; Right : Byte) return Words is
+ Result: Words(Left'Range) := Left;
+ begin
+ Result(Left'Last) := Left(Left'Last) + Word(Right);
+
+ -- overflow?
+ if Result(Left'Last) < Left(Left'Last) then
+ for I in reverse Left'First..Left'Last-1 loop
+ Result(I):=Result(I)+1;
+ if Result(I) /= 0 then
+ return Result;
+ end if;
+ end loop;
+ end if;
+ return Result;
+ end "+";
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : DWords) return DWords is
+ begin
+ return Aux_DWord."xor"(Left,Right);
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : DWords; Right : DWord) return DWords is
+ begin
+ return Aux_DWord."+"(Left,Right);
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : DWord; Right : DWords) return DWords is
+ begin
+ return Right + Left;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : DWords; Right : Byte) return DWords is
+ Result: DWords(Left'Range) := Left;
+ begin
+ Result(Left'Last) := Left(Left'Last) + DWord(Right);
+
+ -- overflow?
+ if Result(Left'Last) < Left(Left'Last) then
+ for I in reverse Left'First..Left'Last-1 loop
+ Result(I):=Result(I)+1;
+ if Result(I) /= 0 then
+ return Result;
+ end if;
+ end loop;
+ end if;
+ return Result;
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function To_Words(Byte_Array : Bytes) return Words is
+ L : constant Natural :=
+ Natural(Float'Ceiling(Float(Byte_Array'Length)/4.0))-1;
+ W : Words(0..L) := (others => 0);
+ N : Integer := Byte_Array'First;
+ S : Natural :=24;
+ begin
+
+ for I in 0..(Byte_Array'Length/4)-1 loop
+ W(I) := To_Word(Byte_Array(N..N+3));
+ N := N+4;
+ end loop;
+
+ for I in 1..(Byte_Array'Length mod 4) loop
+ W(L):= W(L) or Shift_Left(Word(Byte_Array(N)),S);
+ N := N+1;
+ S := S-8;
+ end loop;
+
+ return W;
+ end To_Words;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(Word_Array : Words) return Bytes is
+ B : Bytes(1..Word_Array'Length*4);
+ C : Natural := 1;
+ begin
+ for I in Word_Array'Range loop
+ B(C..C+3) := To_Bytes(Word_Array(I));
+ C:=C+4;
+ end loop;
+ return B;
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_DWords(Byte_Array : Bytes) return DWords is
+ L : constant Natural :=
+ Natural(Float'Ceiling(Float(Byte_Array'Length)/8.0))-1;
+ W : DWords(0..L):=(others => 0);
+ N : Natural := Byte_Array'First;
+ S : Natural := 56;
+ begin
+
+ for I in 0..(Byte_Array'Length/8)-1 loop
+ W(I) := To_DWord(Byte_Array(N..N+7));
+ N := N+8;
+ end loop;
+
+ for I in 1..(Byte_Array'Length mod 8) loop
+ W(L):= W(L) or Shift_Left(DWord(Byte_Array(N)),S);
+ N := N+1;
+ S := S-8;
+ end loop;
+
+ return W;
+ end To_DWords;
+
+ ---------------------------------------------------------------------------
+
+
+ function To_Bytes(DWord_Array : DWords) return Bytes is
+ B : Bytes(1..DWord_Array'Length*8);
+ C : Natural := 1;
+ begin
+ for I in DWord_Array'Range loop
+ B(C..C+7) := To_Bytes(DWord_Array(I));
+ C:=C+8;
+ end loop;
+ return B;
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Hex(B : Byte) return Hex_Byte is
+ S : constant String := "0123456789ABCDEF";
+ H : Hex_Byte;
+ begin
+ H(2) := S(Natural(B and 15)+1);
+ H(1) := S(Natural(Shift_Right(B,4)+1));
+ return H;
+ end To_Hex;
+
+ ---------------------------------------------------------------------------
+
+ function To_Hex(W : Word) return Hex_Word is
+ S : constant String := "0123456789ABCDEF";
+ H : Hex_Word;
+ T : Word := W;
+ begin
+ for I in reverse H'Range loop
+ H(I) := S(Natural(T and 15)+1);
+ T := Shift_Right(T,4);
+ end loop;
+ return H;
+ end To_Hex;
+
+ ---------------------------------------------------------------------------
+
+
+ function To_Hex(D : DWord) return Hex_DWord is
+ S : constant String := "0123456789ABCDEF";
+ H : Hex_DWord;
+ T : DWord := D;
+ begin
+ for I in reverse H'Range loop
+ H(I) := S(Natural(T and 15)+1);
+ T := Shift_Right(T,4);
+ end loop;
+
+ return H;
+ end To_Hex;
+
+
+ function Hex_To_Bytes(Hex : String) return Bytes is
+ Return_Bytes : Bytes(0..Hex'Length/2 -1);
+ begin
+ for I in Return_Bytes'Range loop
+ case Hex(Hex'First + 2*i) is
+ when '0' => Return_Bytes(i):=16#00#;
+ when '1' => Return_Bytes(i):=16#01#;
+ when '2' => Return_Bytes(i):=16#02#;
+ when '3' => Return_Bytes(i):=16#03#;
+ when '4' => Return_Bytes(i):=16#04#;
+ when '5' => Return_Bytes(i):=16#05#;
+ when '6' => Return_Bytes(i):=16#06#;
+ when '7' => Return_Bytes(i):=16#07#;
+ when '8' => Return_Bytes(i):=16#08#;
+ when '9' => Return_Bytes(i):=16#09#;
+ when 'A' => Return_Bytes(i):=16#0A#;
+ when 'B' => Return_Bytes(i):=16#0B#;
+ when 'C' => Return_Bytes(i):=16#0C#;
+ when 'D' => Return_Bytes(i):=16#0D#;
+ when 'E' => Return_Bytes(i):=16#0E#;
+ when 'F' => Return_Bytes(i):=16#0F#;
+ when others => null;
+ end case;
+
+ case Hex(Hex'First + 2*i + 1) is
+ when '0' => Return_Bytes(i):= Return_Bytes(i) + 16#00#;
+ when '1' => Return_Bytes(i):= Return_Bytes(i) + 16#10#;
+ when '2' => Return_Bytes(i):= Return_Bytes(i) + 16#20#;
+ when '3' => Return_Bytes(i):= Return_Bytes(i) + 16#30#;
+ when '4' => Return_Bytes(i):= Return_Bytes(i) + 16#40#;
+ when '5' => Return_Bytes(i):= Return_Bytes(i) + 16#50#;
+ when '6' => Return_Bytes(i):= Return_Bytes(i) + 16#60#;
+ when '7' => Return_Bytes(i):= Return_Bytes(i) + 16#70#;
+ when '8' => Return_Bytes(i):= Return_Bytes(i) + 16#80#;
+ when '9' => Return_Bytes(i):= Return_Bytes(i) + 16#90#;
+ when 'A' => Return_Bytes(i):= Return_Bytes(i) + 16#A0#;
+ when 'B' => Return_Bytes(i):= Return_Bytes(i) + 16#B0#;
+ when 'C' => Return_Bytes(i):= Return_Bytes(i) + 16#C0#;
+ when 'D' => Return_Bytes(i):= Return_Bytes(i) + 16#D0#;
+ when 'E' => Return_Bytes(i):= Return_Bytes(i) + 16#E0#;
+ when 'F' => Return_Bytes(i):= Return_Bytes(i) + 16#F0#;
+ when others => null;
+ end case;
+
+ end loop;
+ return Return_Bytes;
+ end Hex_To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function Is_Zero(Byte_Array : Bytes) return Boolean is
+ begin
+ return Aux_Byte.Is_Zero(Byte_Array);
+ end Is_Zero;
+
+ ---------------------------------------------------------------------------
+
+
+ function Is_Zero(Word_Array : Words) return Boolean is
+ begin
+ return Aux_Word.Is_Zero(Word_Array);
+ end Is_Zero;
+
+ ---------------------------------------------------------------------------
+
+ function Is_Zero(DWord_Array : Dwords) return Boolean is
+ begin
+ return Aux_DWord.Is_Zero(DWord_Array);
+ end Is_Zero;
+
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(Message : String) return Bytes is
+ B : Bytes(Message'Range);
+ begin
+ for I in Message'Range loop
+ B(I) := Character'Pos(Message(I));
+ end loop;
+ return B;
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_String(ASCII : Bytes) return String is
+ S : String(1..ASCII'Length);
+ J : Integer:=1;
+ begin
+ for I in ASCII'Range loop
+ S(J) := Character'Val(ASCII(I));
+ J:=J+1;
+ end loop;
+ return S;
+ end To_String;
+
+ ---------------------------------------------------------------------------
+
+ function Left_Part(Block : in Bytes) return Bytes is
+ begin
+ return Aux_Byte.Left_Part(Block);
+ end Left_Part;
+
+ ---------------------------------------------------------------------------
+
+ function Right_Part(Block : in Bytes) return Bytes is
+ begin
+ return Aux_Byte.Right_Part(Block);
+ end Right_Part;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(B : B_Block64) return Bytes is
+ begin
+ return Bytes(B);
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(B : B_Block128) return Bytes is
+ begin
+ return Bytes(B);
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(B : B_Block192) return Bytes is
+
+ begin
+ return Bytes(B);
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(B : B_Block256) return Bytes is
+ begin
+ return Bytes(B);
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(W : W_Block160) return Bytes is
+ begin
+ return To_Bytes(Words(W));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(W : W_Block256) return Bytes is
+ begin
+ return To_Bytes(Words(W));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(W : W_Block512) return Bytes is
+ begin
+ return To_Bytes(Words(W));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(D : DW_Block256) return Bytes is
+ begin
+ return To_Bytes(DWords(D));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(D : DW_Block384) return Bytes is
+ begin
+ return To_Bytes(DWords(D));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(D : DW_Block512) return Bytes is
+ begin
+ return To_Bytes(DWords(D));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(D : DW_Block1024) return Bytes is
+ begin
+ return To_Bytes(DWords(D));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_Bytes(D : DW_Block8192) return Bytes is
+ begin
+ return To_Bytes(DWords(D));
+ end To_Bytes;
+
+ ---------------------------------------------------------------------------
+
+ function To_B_Block64(B : Bytes) return B_Block64 is
+ begin
+ return B_Block64(B);
+ end To_B_Block64;
+
+ ---------------------------------------------------------------------------
+
+ function To_B_Block128(B : Bytes) return B_Block128 is
+ begin
+ return B_Block128(B);
+ end To_B_Block128;
+
+ ---------------------------------------------------------------------------
+
+ function To_B_Block192(B : Bytes) return B_Block192 is
+ begin
+ return B_Block192(B);
+ end To_B_Block192;
+
+ ---------------------------------------------------------------------------
+
+ function To_B_Block256(B : Bytes) return B_Block256 is
+ begin
+ return B_Block256(B);
+ end To_B_Block256;
+
+ ---------------------------------------------------------------------------
+
+ function To_W_Block160(B : Bytes) return W_Block160 is
+ begin
+ return W_Block160(To_Words(B));
+ end To_W_Block160;
+
+ ---------------------------------------------------------------------------
+
+ function To_W_Block256(B : Bytes) return W_Block256 is
+ begin
+ return W_Block256(To_Words(B));
+ end To_W_Block256;
+
+ ---------------------------------------------------------------------------
+
+ function To_W_Block512(B : Bytes) return W_Block512 is
+ begin
+ return W_Block512(To_Words(B));
+ end To_W_Block512;
+
+ ---------------------------------------------------------------------------
+
+ function To_DW_Block256(B : Bytes) return DW_Block256 is
+ begin
+ return DW_Block256(To_DWords(B));
+ end To_DW_Block256;
+
+ ---------------------------------------------------------------------------
+
+ function To_DW_Block384(B : Bytes) return DW_Block384 is
+ begin
+ return DW_Block384(To_DWords(B));
+ end To_DW_Block384;
+
+ ---------------------------------------------------------------------------
+
+ function To_DW_Block512(B : Bytes) return DW_Block512 is
+ begin
+ return DW_Block512(To_DWords(B));
+ end To_DW_Block512;
+
+ ---------------------------------------------------------------------------
+
+ function To_DW_Block1024(B : Bytes) return DW_Block1024 is
+ begin
+ return DW_Block1024(To_DWords(B));
+ end To_DW_Block1024;
+
+ ---------------------------------------------------------------------------
+
+ function To_DW_Block8192(B : Bytes) return DW_Block8192 is
+ begin
+ return DW_Block8192(To_DWords(B));
+ end To_DW_Block8192;
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : W_Block160) return W_Block160 is
+ begin
+ return W_Block160(Words(Left) xor Words(Right));
+ end "xor";
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : W_Block256) return W_Block256 is
+ begin
+ return W_Block256(Words(Left) xor Words(Right));
+ end "xor";
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : W_Block512) return W_Block512 is
+ begin
+ return W_Block512(Words(Left) xor Words(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : DW_Block512) return DW_Block512 is
+ begin
+ return DW_Block512(DWords(Left) xor DWords(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : DW_Block1024) return DW_Block1024 is
+ begin
+ return DW_Block1024(DWords(Left) xor DWords(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : DW_Block8192) return DW_Block8192 is
+ begin
+ return DW_Block8192(DWords(Left) xor DWords(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : B_Block128) return B_Block128 is
+ begin
+ return B_Block128(Bytes(Left) xor Bytes(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "xor"(Left, Right : B_Block64) return B_Block64 is
+ begin
+ return B_Block64(Bytes(Left) xor Bytes(Right));
+ end "xor";
+
+ ---------------------------------------------------------------------------
+
+ function "+"(Left : B_Block128; Right : Byte) return B_Block128 is
+ begin
+ return B_Block128(Bytes(Left) + Right);
+ end "+";
+
+ ---------------------------------------------------------------------------
+
+ function Shift_Left(Value : Bytes; Amount : Natural) return Bytes is
+ begin
+ return Aux_Byte.Shift_Left(Value,Amount);
+ end Shift_Left;
+
+ ---------------------------------------------------------------------------
+
+ function Shift_Left(Value : B_Block128; Amount :Natural) return B_Block128 is
+ begin
+ return B_Block128(Aux_Byte.Shift_Left(Bytes(Value),Amount));
+ end Shift_Left;
+
+ ----------------------------------------------------------------------------
+
+ function Shift_Right(Value : Bytes; Amount : Natural) return Bytes is
+ begin
+ return Aux_Byte.Shift_Right(Value,Amount);
+ end Shift_Right;
+
+ ---------------------------------------------------------------------------
+
+ function Shift_Right(Value : B_Block128; Amount :Natural)return B_Block128 is
+ begin
+ return B_Block128(Aux_Byte.Shift_Right(Bytes(Value),Amount));
+ end Shift_Right;
+
+
+
+
+ end Crypto.Types;
diff --git a/src/crypto-types.ads b/src/crypto-types.ads
new file mode 100644
index 0000000..ebcd6dc
--- /dev/null
+++ b/src/crypto-types.ads
@@ -0,0 +1,357 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+package Crypto.Types is
+
+ ---------------------------------------------------------------------------
+ ---------------------------TYPES-------------------------------------------
+ ---------------------------------------------------------------------------
+
+ -- primary types;
+
+ type Bit is mod 2;
+ for Bit'Size use 1;
+
+ type Byte is mod 2 ** 8;
+ for Byte'Size use 8;
+
+ type DByte is mod 2 ** 16;
+ for DByte'Size use 16;
+
+ type TByte is mod 2 ** 24 with Size => 24;
+
+ type Word is mod 2 ** 32;
+ for Word'Size use 32;
+
+ type DWord is mod 2 ** 64;
+ for DWord'Size use 64;
+
+ --package BIO is new Ada.Text_Io.Modular_IO (Byte);
+ --package WIO is new Ada.Text_Io.Modular_IO (Word);
+ --package DIO is new Ada.Text_Io.Modular_IO (DWord);
+
+ -- Arrays of primary types
+ type Bits is array (Integer range <>) of Bit;
+ type Bytes is array (Integer range <>) of Byte;
+ type DBytes is array (Integer range <>) of DByte;
+ type Words is array (Integer range <>) of Word;
+ type DWords is array (Integer range <>) of DWord;
+
+ subtype Byte_Word_Range is Natural range 0..3;
+ subtype Byte_DWord_Range is Natural range 0..7;
+
+ subtype Byte_Word is Bytes (Byte_Word_Range);
+ subtype Byte_DWord is Bytes (Byte_DWord_Range);
+
+ -- N : #bits
+ -- byte-blocks (B_BlockN): array of N/8 bytes
+ subtype B_Block32_Range is Natural range 0..3;
+ subtype B_Block48_Range is Natural range 0..5;
+ subtype B_Block56_Range is Natural range 0..6;
+ subtype B_Block64_Range is Natural range 0..7;
+ subtype B_Block128_Range is Natural range 0..15;
+ subtype B_Block160_Range is Natural range 0..19;
+ subtype B_Block192_Range is Natural range 0..23;
+ subtype B_Block256_Range is Natural range 0..31;
+
+ type B_Block32 is array(B_Block32_Range) of Byte;
+ type B_Block48 is array(B_Block48_Range) of Byte;
+ type B_Block56 is array(B_Block56_Range) of Byte;
+ type B_Block64 is array(B_Block64_Range) of Byte;
+ type B_Block128 is array(B_Block128_Range) of Byte;
+ type B_Block160 is array(B_Block160_Range) of Byte;
+ type B_Block192 is array(B_Block192_Range) of Byte;
+ type B_Block256 is array(B_Block256_Range) of Byte;
+
+
+ -- word blocks (W_BlockN): array of N/32 Words
+ subtype W_Block128_Range is Natural range 0..3;
+ subtype W_Block160_Range is Natural range 0..4;
+ subtype W_Block192_Range is Natural range 0..5;
+ subtype W_Block256_Range is Natural range 0..7;
+ subtype W_Block512_Range is Natural range 0..15;
+
+ type W_Block128 is array(W_Block128_Range) of Word;
+ type W_Block160 is array(W_Block160_Range) of Word;
+ type W_Block192 is array(W_Block192_Range) of Word;
+ type W_Block256 is array(W_Block256_Range) of Word;
+ type W_Block512 is array(W_Block512_Range) of Word;
+
+
+ -- double wordblocks (DW_BlockN): array of N/64 Words
+ subtype DW_Block128_Range is Natural range 0..1;
+ subtype DW_Block256_Range is Natural range 0..3;
+ subtype DW_Block384_Range is Natural range 0..5;
+ subtype DW_Block512_Range is Natural range 0..7;
+ subtype DW_Block1024_Range is Natural range 0..15;
+ subtype DW_Block8192_Range is Natural range 0..127;
+
+ type DW_Block128 is array(DW_Block128_Range) of DWord;
+ type DW_Block256 is array(DW_Block256_Range) of DWord;
+ type DW_Block384 is array(DW_Block384_Range) of DWord;
+ type DW_Block512 is array(DW_Block512_Range) of DWord;
+ type DW_Block1024 is array(DW_Block1024_Range) of DWord;
+ type DW_Block8192 is array(DW_Block8192_Range) of DWord;
+
+
+ subtype Hex_Byte_Range is Natural range 1..2;
+ subtype Hex_Word_Range is Natural range 1..8;
+ subtype Hex_DWord_Range is Natural range 1..16;
+
+
+ subtype Hex_Byte is String (Hex_Byte_Range);
+ subtype Hex_Word is String (Hex_Word_Range);
+ subtype Hex_DWord is String (Hex_DWord_Range);
+
+ subtype Message_Block_Length256 is Natural range 0 .. 32;
+ subtype Message_Block_Length512 is Natural range 0 .. 64;
+ subtype Message_Block_Length1024 is Natural range 0 .. 128;
+
+
+
+
+
+
+
+ ---------------------------------------------------------------------------
+ ---------------------------FUNCTIONS---------------------------------------
+ ---------------------------------------------------------------------------
+
+ function Shift_Left (Value : Byte; Amount : Natural) return Byte;
+ function Shift_Right (Value : Byte; Amount : Natural) return Byte;
+ function Rotate_Left (Value : Byte; Amount : Natural) return Byte;
+ function Rotate_Right (Value : Byte; Amount : Natural) return Byte;
+
+ function Shift_Left (Value : DByte; Amount : Natural) return DByte;
+ function Shift_Right (Value : DByte; Amount : Natural) return DByte;
+ function Rotate_Left (Value : DByte; Amount : Natural) return DByte;
+ function Rotate_Right (Value : DByte; Amount : Natural) return DByte;
+
+ function Shift_Left (Value : Word; Amount : Natural) return Word;
+ function Shift_Right (Value : Word; Amount : Natural) return Word;
+ function Rotate_Left (Value : Word; Amount : Natural) return Word;
+ function Rotate_Right (Value : Word; Amount : Natural) return Word;
+
+ function Shift_Left (Value : DWord; Amount : Natural) return DWord;
+ function Shift_Right (Value : DWord; Amount : Natural) return DWord;
+ function Rotate_Left (Value : DWord; Amount : Natural) return DWord;
+ function Rotate_Right (Value : DWord; Amount : Natural) return DWord;
+
+ pragma Import (Intrinsic, Shift_Left);
+ pragma Import (Intrinsic, Shift_Right);
+
+ function Shift_Left (Value : Bytes; Amount : Natural) return Bytes;
+ function Shift_Left (Value : B_Block128; Amount : Natural) return B_Block128;
+ function Shift_Right(Value : Bytes; Amount : Natural) return Bytes;
+ function Shift_Right(Value : B_Block128; Amount : Natural) return B_Block128;
+
+ --Operations for Bytes
+ function "xor"(Left, Right : Bytes) return Bytes;
+ function "xor"(Left : Bytes; Right : Byte) return Bytes;
+ function "+"(Left : Bytes; Right : Byte) return Bytes;
+ function "+"(Left : Byte; Right : Bytes) return Bytes;
+ function "and"(Left, Right : Bytes) return Bytes;
+
+
+ -- Operations for Words
+ function "xor"(Left, Right : Words) return Words;
+ function "+"(Left : Words; Right : Word) return Words;
+ function "+"(Left : Word; Right : Words) return Words;
+ function "+"(Left : Words; Right : Byte) return Words;
+
+
+ -- Operations for DWords
+ function "xor"(Left, Right : DWords) return DWords;
+ function "+"(Left : DWords; Right : DWord) return DWords;
+ function "+"(Left : DWord; Right : DWords) return DWords;
+ function "+"(Left : DWords; Right : Byte) return DWords;
+
+ -- Bytes to Word
+ function To_Word (A,B,C,D : Byte) return Word;
+ function To_Word (X : Byte_Word) return Word;
+ function R_To_Word (X : Byte_Word) return Word; -- reverse
+ function To_Words(Byte_Array : Bytes) return Words;
+
+ -- Word to Bytes
+ function To_Bytes (X : Word) return Byte_Word;
+ function R_To_Bytes (X : Word) return Byte_Word; --reverse
+ function To_Bytes(Word_Array : Words) return Bytes;
+
+ --Word = b_0 b_1 b2 b_3
+ -- ByteX returns b_n
+ function Byte0 (W : Word) return Byte;
+ function Byte1 (W : Word) return Byte;
+ function Byte2 (W : Word) return Byte;
+ function Byte3 (W : Word) return Byte;
+
+ -- Bytes to DWord
+ function To_DWord (X : Byte_DWord) return DWord;
+ function R_To_DWord (X : Byte_DWord) return DWord;
+ function To_DWords (Byte_Array : Bytes) return DWords;
+
+ -- DWord to Bytes
+ function To_Bytes (X : DWord) return Byte_DWord;
+ function R_To_Bytes (X : DWord) return Byte_DWord;
+ function To_Bytes (DWord_Array : DWords) return Bytes;
+
+
+ --DWord = b_0 b_1 b2 b_3 b_4 b_5 b_6 b_7
+ -- ByteX returns b_n
+ function Byte0 (D : DWord) return Byte;
+ function Byte1 (D : DWord) return Byte;
+ function Byte2 (D : DWord) return Byte;
+ function Byte3 (D : DWord) return Byte;
+ function Byte4 (D : DWord) return Byte;
+ function Byte5 (D : DWord) return Byte;
+ function Byte6 (D : DWord) return Byte;
+ function Byte7 (D : DWord) return Byte;
+
+ -- To_Word
+ function To_Word (A,B,C,D : Character) return Word;
+
+ -- String to Bytes
+ function To_Bytes(Message : String) return Bytes;
+
+ -- Bytes to String
+ function To_String(ASCII : Bytes) return String;
+
+
+ -- To_Hex
+ function To_Hex(B : Byte) return Hex_Byte;
+ function To_Hex(W : Word) return Hex_Word;
+ function To_Hex(D : DWord) return Hex_DWord;
+
+ -- To_Bytes
+ function Hex_To_Bytes(Hex : String) return Bytes;
+
+ -- Is_Zero
+ -- returns only true if the "input array" X = (others => 0)
+ function Is_Zero(Byte_Array : Bytes) return Boolean;
+ function Is_Zero(Word_Array : Words) return Boolean;
+ function Is_Zero(DWord_Array : DWords) return Boolean;
+
+
+ -- Byte Blocks To Bytes.
+ -- Needed for generic packages to convert a specific byte block.
+ function To_Bytes(B : B_Block64) return Bytes;
+ function To_Bytes(B : B_Block128) return Bytes;
+ function To_Bytes(B : B_Block192) return Bytes;
+ function To_Bytes(B : B_Block256) return Bytes;
+ function To_Bytes(W : W_Block160) return Bytes;
+ function To_Bytes(W : W_Block256) return Bytes;
+ function To_Bytes(W : W_Block512) return Bytes;
+ function To_Bytes(D : DW_Block256) return Bytes;
+ function To_Bytes(D : DW_Block384) return Bytes;
+ function To_Bytes(D : DW_Block512) return Bytes;
+ function To_Bytes(D : DW_Block1024) return Bytes;
+ function To_Bytes(D : DW_Block8192) return Bytes;
+
+
+ -- Bytes To block of Bytes.
+ -- Needed for generic packages to convert a specific byte block.
+ function To_B_Block64(B : Bytes) return B_Block64;
+ function To_B_Block128(B : Bytes) return B_Block128;
+ function To_B_Block192(B : Bytes) return B_Block192;
+ function To_B_Block256(B : Bytes) return B_Block256;
+
+
+ -- Bytes To block of words.
+ -- Needed for generic packages to convert a specific byte block.
+ function To_W_Block160(B : Bytes) return W_Block160;
+ function To_W_Block256(B : Bytes) return W_Block256;
+ function To_W_Block512(B : Bytes) return W_Block512;
+
+
+ -- Bytes To block of double words.
+ -- Needed for generic packages to convert a specific byte block.
+ function To_DW_Block256(B : Bytes) return DW_Block256;
+ function To_DW_Block384(B : Bytes) return DW_Block384;
+ function To_DW_Block512(B : Bytes) return DW_Block512;
+ function To_DW_Block1024(B : Bytes) return DW_Block1024;
+ function To_DW_Block8192(B : Bytes) return DW_Block8192;
+
+ -- Needed for generic packages to convert a specific byte block.
+ function "xor"(Left, Right : B_Block64) return B_Block64;
+ function "xor"(Left, Right : B_Block128) return B_Block128;
+ function "xor"(Left, Right : W_Block160) return W_Block160;
+ function "xor"(Left, Right : W_Block256) return W_Block256;
+ function "xor"(Left, Right : W_Block512) return W_Block512;
+ function "xor"(Left, Right : DW_Block512) return DW_Block512;
+ function "xor"(Left, Right : DW_Block1024) return DW_Block1024;
+ function "xor"(Left, Right : DW_Block8192) return DW_Block8192;
+
+ function "+"(Left : B_Block128; Right : Byte) return B_Block128;
+
+
+ -- Splits byte array of length n into a left part of length
+ -- ceiling(n/2) and a right part of length floor(n/2).
+ function Left_Part(Block : in Bytes) return Bytes;
+ function Right_Part(Block : in Bytes) return Bytes;
+
+
+
+ -- Nested generic package
+ generic
+ type T is mod <>;
+ type T_A is array (Integer range <>) of T;
+ with function Shift_Left (Value : T; Amount : Natural) return T is <>;
+ with function Shift_Right (Value : T; Amount : Natural) return T is <>;
+
+ package Generic_Mod_Aux is
+ function "xor"(Left, Right : T_A) return T_A;
+ function "xor"(Left : T_A; Right : T) return T_A;
+ function "xor"(Left : T; Right : T_A) return T_A;
+
+ function "and"(Left, Right : T_A) return T_A;
+
+ function "+"(Left : T_A; Right : T) return T_A;
+ function "+"(Left : T; Right : T_A) return T_A;
+
+ function Is_Zero(Item : T_A) return Boolean;
+
+ function Left_Part (Block : in T_A) return T_A;
+ function Right_Part(Block : in T_A) return T_A;
+
+ function Shift_Left(Value : T_A; Amount : Natural) return T_A;
+ function Shift_Right(Value : T_A; Amount : Natural) return T_A;
+ end Generic_Mod_Aux;
+
+
+
+ ---------------------------------------------------------------------------
+ -------------------------------PRIVATE-------------------------------------
+ ---------------------------------------------------------------------------
+
+private
+ pragma Inline (To_B_Block128,To_B_Block192,To_B_Block256);
+ pragma Inline ("xor","+");
+ pragma Inline (R_To_Bytes, To_Bytes);
+ pragma Inline (To_Word, Byte0, Byte1, Byte2, Byte3);
+ pragma Inline (Byte4, Byte5, Byte6, Byte7);
+ pragma Inline (To_DWord, R_To_DWord);
+ pragma Inline (Is_Zero);
+ pragma Inline (Left_Part, Right_Part);
+ pragma Import (Intrinsic, Rotate_Left);
+ pragma Import (Intrinsic, Rotate_Right);
+
+ pragma Optimize(Time);
+end Crypto.Types;
diff --git a/src/crypto.ads b/src/crypto.ads
new file mode 100644
index 0000000..2f0ed3c
--- /dev/null
+++ b/src/crypto.ads
@@ -0,0 +1,25 @@
+-- This program is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License as
+-- published by the Free Software Foundation; either version 2 of the
+-- License, or (at your option) any later version.
+
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+-- As a special exception, if other files instantiate generics from
+-- this unit, or you link this unit with other files to produce an
+-- executable, this unit does not by itself cause the resulting
+-- executable to be covered by the GNU General Public License. This
+-- exception does not however invalidate any other reasons why the
+-- executable file might be covered by the GNU Public License.
+
+
+package Crypto is
+end Crypto;
diff --git a/src/rationals.adb b/src/rationals.adb
index 7ae321c..62fe9b9 100644
--- a/src/rationals.adb
+++ b/src/rationals.adb
@@ -7,12 +7,12 @@ package body Rationals is
function Reduce
- (Numerator, Denominator : in Integer)
+ (Numerator, Denominator : in Big_Unsigned)
return Fraction
is
- A : Integer := Numerator;
- B : Integer := Denominator;
- Temp : Integer;
+ A : Big_Unsigned := Numerator;
+ B : Big_Unsigned := Denominator;
+ Temp : Big_Unsigned;
begin
-- Euclid's algorithm
loop
@@ -21,7 +21,8 @@ package body Rationals is
B := Temp mod B;
exit when B = 0;
end loop;
- return (Num => Numerator / A, Den => Denominator / A);
+ return (Num => Numerator / A,
+ Den => Denominator / A);
end Reduce;
@@ -42,7 +43,7 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left.Num + Left.Den * Right,
+ (Left.Num + Left.Den * Utils.To_Big_Unsigned (Word (Right)),
Left.Den);
end "+";
@@ -52,7 +53,7 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left * Right.Den + Right.Num,
+ (Utils.To_Big_Unsigned (Word (Left)) * Right.Den + Right.Num,
Right.Den);
end "+";
@@ -74,7 +75,7 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left.Num - Left.Den * Right,
+ (Left.Num - Left.Den * Utils.To_Big_Unsigned (Word (Right)),
Left.Den);
end "-";
@@ -84,7 +85,7 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left * Right.Den - Right.Num,
+ (Utils.To_Big_Unsigned (Word (Left)) * Right.Den - Right.Num,
Right.Den);
end "-";
@@ -116,8 +117,8 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left.Num * Right,
- Right);
+ (Left.Num * Utils.To_Big_Unsigned (Word (Right)),
+ Left.Den);
end "*";
function "*"
@@ -126,7 +127,7 @@ package body Rationals is
return Fraction is
begin
return Reduce
- (Left * Right.Num,
+ (Utils.To_Big_Unsigned (Word (Left)) * Right.Num,
Right.Den);
end "*";
@@ -149,7 +150,7 @@ package body Rationals is
begin
return Reduce
(Left.Num,
- Left.Den * Right);
+ Left.Den * Utils.To_Big_Unsigned (Word (Right)));
end "/";
function "/"
@@ -159,14 +160,14 @@ package body Rationals is
begin
return Reduce
(Right.Num,
- Left * Right.Den);
+ Utils.To_Big_Unsigned (Word (Left)) * Right.Den);
end "/";
function "/"
(Left, Right : in Integer)
return Fraction is
begin
- return Reduce (Left, Right);
+ return Reduce (Utils.To_Big_Unsigned (Word (Left)), Utils.To_Big_Unsigned (Word (Right)));
end "/";
@@ -185,7 +186,7 @@ package body Rationals is
Right : in Integer)
return Boolean is
begin
- return Left.Num = Right and Left.Den = 1;
+ return Left.Num = Utils.To_Big_Unsigned (Word (Right)) and Left.Den = 1;
end "=";
function "="
@@ -193,7 +194,7 @@ package body Rationals is
Right : in Fraction)
return Boolean is
begin
- return Left = Right.Num and Right.Den = 1;
+ return Utils.To_Big_Unsigned (Word (Left)) = Right.Num and Right.Den = 1;
end "=";
@@ -211,7 +212,7 @@ package body Rationals is
Right : in Integer)
return Boolean is
begin
- return Left.Num <= Left.Den * Right;
+ return Left.Num <= Left.Den * Utils.To_Big_Unsigned (Word (Right));
end "<=";
function "<="
@@ -219,7 +220,7 @@ package body Rationals is
Right : in Fraction)
return Boolean is
begin
- return Left * Right.Den <= Right.Num;
+ return Utils.To_Big_Unsigned (Word (Left)) * Right.Den <= Right.Num;
end "<=";
@@ -237,7 +238,7 @@ package body Rationals is
Right : in Integer)
return Boolean is
begin
- return Left.Num < Left.Den * Right;
+ return Left.Num < Left.Den * Utils.To_Big_Unsigned (Word (Right));
end "<";
function "<"
@@ -245,7 +246,7 @@ package body Rationals is
Right : in Fraction)
return Boolean is
begin
- return Left * Right.Den < Right.Num;
+ return Utils.To_Big_Unsigned (Word (Left)) * Right.Den < Right.Num;
end "<";
@@ -263,7 +264,7 @@ package body Rationals is
Right : in Integer)
return Boolean is
begin
- return Left.Num >= Left.Den * Right;
+ return Left.Num >= Left.Den * Utils.To_Big_Unsigned (Word (Right));
end ">=";
function ">="
@@ -271,7 +272,7 @@ package body Rationals is
Right : in Fraction)
return Boolean is
begin
- return Left * Right.Den >= Right.Num;
+ return Utils.To_Big_Unsigned (Word (Left)) * Right.Den >= Right.Num;
end ">=";
@@ -289,7 +290,7 @@ package body Rationals is
Right : in Integer)
return Boolean is
begin
- return Left.Num > Left.Den * Right;
+ return Left.Num > Left.Den * Utils.To_Big_Unsigned (Word (Right));
end ">";
function ">"
@@ -297,7 +298,7 @@ package body Rationals is
Right : in Fraction)
return Boolean is
begin
- return Left * Right.Den > Right.Num;
+ return Utils.To_Big_Unsigned (Word (Left)) * Right.Den > Right.Num;
end ">";
@@ -307,21 +308,21 @@ package body Rationals is
(Item : in Fraction)
return Integer is
begin
- return Item.Num;
+ return Integer (Utils.To_Words (Item.Num)(1));
end Numerator;
function Denominator
(Item : in Fraction)
return Integer is
begin
- return Item.Den;
+ return Integer (Utils.To_Words (Item.Den)(1));
end Denominator;
function Floor
(Item : in Fraction)
return Integer is
begin
- return Item.Num / Item.Den;
+ return Integer (Utils.To_Words (Item.Num / Item.Den)(0));
end Floor;
function Ceiling
@@ -329,9 +330,9 @@ package body Rationals is
return Integer is
begin
if Item.Num mod Item.Den = 0 then
- return Item.Num / Item.Den;
+ return Integer (Utils.To_Words (Item.Num / Item.Den)(1));
else
- return 1 + Item.Num / Item.Den;
+ return 1 + Integer (Utils.To_Words (Item.Num / Item.Den)(1));
end if;
end Ceiling;
@@ -339,10 +340,10 @@ package body Rationals is
(Item : in Fraction)
return Integer is
begin
- if Item.Num mod Item.Den >= Standard."/" (Item.Den, 2) then
- return 1 + Item.Num / Item.Den;
+ if Item.Num mod Item.Den >= Item.Den / 2 then
+ return 1 + Integer (Utils.To_Words (Item.Num / Item.Den)(1));
else
- return Item.Num / Item.Den;
+ return Integer (Utils.To_Words (Item.Num / Item.Den)(1));
end if;
end Round;
@@ -351,13 +352,10 @@ package body Rationals is
function Image
(Item : in Fraction)
- return String
- is
- use Ada.Strings;
- use Ada.Strings.Fixed;
+ return String is
begin
- return Trim (Integer'Image (Item.Num), Left) & '/' &
- Trim (Integer'Image (Item.Den), Left);
+ return Utils.To_String (Item.Num) & '/' &
+ Utils.To_String (Item.Den);
end Image;
function Value
@@ -371,7 +369,7 @@ package body Rationals is
S := Index (Item, "/");
A := Integer'Value (Item (Item'First .. S - 1));
B := Integer'Value (Item (S + 1 .. Item'Last));
- return Reduce (A, B);
+ return Reduce (Utils.To_Big_Unsigned (Word (A)), Utils.To_Big_Unsigned (Word (B)));
end Value;
diff --git a/src/rationals.ads b/src/rationals.ads
index 03ac95e..dfa5897 100644
--- a/src/rationals.ads
+++ b/src/rationals.ads
@@ -1,5 +1,8 @@
+private with Crypto.Types.Big_Numbers;
+
+
package Rationals is
@@ -207,9 +210,14 @@ package Rationals is
private
+ package Bignum is new Crypto.Types.Big_Numbers (Size => 128);
+ use Crypto.Types;
+ use Bignum;
+
+
type Fraction is record
- Num : Integer := 0;
- Den : Integer := 1;
+ Num : Big_Unsigned := Big_Unsigned_Zero;
+ Den : Big_Unsigned := Big_Unsigned_One;
end record;
generated by cgit (git 2.30.0) at 2024-05-01 07:00:45 +0000