File : fz_mul.adb
1 ------------------------------------------------------------------------------
2 ------------------------------------------------------------------------------
3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
4 -- --
5 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
7 -- --
8 -- You do not have, nor can you ever acquire the right to use, copy or --
9 -- distribute this software ; Should you use this software for any purpose, --
10 -- or copy and distribute it to anyone or in any manner, you are breaking --
11 -- the laws of whatever soi-disant jurisdiction, and you promise to --
12 -- continue doing so for the indefinite future. In any case, please --
13 -- always : read and understand any software ; verify any PGP signatures --
14 -- that you use - for any purpose. --
15 -- --
16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
17 ------------------------------------------------------------------------------
18 ------------------------------------------------------------------------------
19
20 with Words; use Words;
21 with Word_Ops; use Word_Ops;
22 with W_Mul; use W_Mul;
23 with FZ_Arith; use FZ_Arith;
24
25
26 package body FZ_Mul is
27
28 -- Comba's multiplier. (CAUTION: UNBUFFERED)
29 procedure FZ_Mul_Comba(X : in FZ;
30 Y : in FZ;
31 XY : out FZ) is
32
33 -- Words in each multiplicand
34 L : constant Word_Index := X'Length;
35
36 -- Length of Product, i.e. double the length of either multiplicand
37 LP : constant Word_Index := 2 * L;
38
39 -- 3-word Accumulator
40 A2, A1, A0 : Word := 0;
41
42 -- Type for referring to a column of XY
43 subtype ColXY is Word_Index range 0 .. LP - 1;
44
45 -- Compute the Nth (indexed from zero) column of the Product
46 procedure Col(N : in ColXY; U : in ColXY; V : in ColXY) is
47
48 -- The outputs of a Word multiplication
49 Lo, Hi : Word;
50
51 -- Carry for the Accumulator addition
52 C : WBool;
53
54 -- Sum for Accumulator addition
55 Sum : Word;
56
57 begin
58
59 -- For lower half of XY, will go from 0 to N
60 -- For upper half of XY, will go from N - L + 1 to L - 1
61 for j in U .. V loop
62
63 -- Hi:Lo := j-th Word of X * (N - j)-th Word of Y
64 Mul_Word(X(X'First + j),
65 Y(Y'First - j + N),
66 Lo, Hi);
67
68 -- Now add Hi:Lo into the Accumulator:
69
70 -- A0 += Lo; C := Carry
71 Sum := A0 + Lo;
72 C := W_Carry(A0, Lo, Sum);
73 A0 := Sum;
74
75 -- A1 += Hi + C; C := Carry
76 Sum := A1 + Hi + C;
77 C := W_Carry(A1, Hi, Sum);
78 A1 := Sum;
79
80 -- A2 += A2 + C
81 A2 := A2 + C;
82
83 end loop;
84
85 -- We now have the Nth (indexed from zero) word of XY
86 XY(XY'First + N) := A0;
87
88 -- Right-Shift the Accumulator by one Word width:
89 A0 := A1;
90 A1 := A2;
91 A2 := 0;
92
93 end Col;
94 pragma Inline_Always(Col);
95
96 begin
97
98 -- Compute the lower half of the Product:
99 for i in 0 .. L - 1 loop
100
101 Col(i, 0, i);
102
103 end loop;
104
105 -- Compute the upper half (sans last Word) of the Product:
106 for i in L .. LP - 2 loop
107
108 Col(i, i - L + 1, L - 1);
109
110 end loop;
111
112 -- The very last Word of the Product:
113 XY(XY'Last) := A0;
114
115 end FZ_Mul_Comba;
116
117
118 -- Karatsuba's Multiplier. (CAUTION: UNBUFFERED)
119 procedure Mul_Karatsuba(X : in FZ;
120 Y : in FZ;
121 XY : out FZ) is
122
123 -- L is the wordness of a multiplicand. Guaranteed to be a power of two.
124 L : constant Word_Count := X'Length;
125
126 -- An 'LSeg' is the same length as either multiplicand.
127 subtype LSeg is FZ(1 .. L);
128
129 -- K is HALF of the length of a multiplicand.
130 K : constant Word_Index := L / 2;
131
132 -- A 'KSeg' is the same length as HALF of a multiplicand.
133 subtype KSeg is FZ(1 .. K);
134
135 -- The three L-sized variables of the product equation, i.e.:
136 -- XY = LL + 2^(K*Bitness)(LL + HH + (-1^DD_Sub)*DD) + 2^(2*K*Bitness)HH
137 LL, DD, HH : LSeg;
138
139 -- K-sized terms of Dx * Dy = DD
140 Dx, Dy : KSeg; -- Dx = abs(XLo - XHi) , Dy = abs(YLo - YHi)
141
142 -- Subtraction borrows, signs of (XL - XH) and (YL - YH),
143 Cx, Cy : WBool; -- so that we can calculate (-1^DD_Sub)
144
145 -- Bottom and Top K-sized halves of the multiplicand X.
146 XLo : KSeg renames X( X'First .. X'Last - K );
147 XHi : KSeg renames X( X'First + K .. X'Last );
148
149 -- Bottom and Top K-sized halves of the multiplicand Y.
150 YLo : KSeg renames Y( Y'First .. Y'Last - K );
151 YHi : KSeg renames Y( Y'First + K .. Y'Last );
152
153 -- L-sized middle segment of the product XY (+/- K from the midpoint).
154 XYMid : LSeg renames XY( XY'First + K .. XY'Last - K );
155
156 -- Bottom and Top L-sized halves of the product XY.
157 XYLo : LSeg renames XY( XY'First .. XY'Last - L );
158 XYHi : LSeg renames XY( XY'First + L .. XY'Last );
159
160 -- Topmost K-sized quarter segment of the product XY, or 'tail'
161 XYHiHi : KSeg renames XYHi( XYHi'First + K .. XYHi'Last );
162
163 -- Whether the DD term is being subtracted.
164 DD_Sub : WBool;
165
166 -- Carry from individual term additions.
167 C : WBool;
168
169 -- Barring a cosmic ray, 0 <= TC <= 2
170 subtype TailCarry is Word range 0 .. 2;
171
172 -- Tail-Carry accumulator, for the final ripple-out into XXHiHi
173 TC : TailCarry := 0;
174
175 -- Barring a cosmic ray, the tail ripple will NOT overflow.
176 FinalCarry : WZeroOrDie := 0;
177
178 begin
179
180 -- Recurse: LL := XL * YL
181 FZ_Multiply_Unbuffered(XLo, YLo, LL);
182
183 -- Recurse: HH := XH * YH
184 FZ_Multiply_Unbuffered(XHi, YHi, HH);
185
186 -- Dx := |XL - XH| , Cx := Borrow (i.e. 1 iff XL < XH)
187 FZ_Sub_Abs(X => XLo, Y => XHi, Difference => Dx, Underflow => Cx);
188
189 -- Dy := |YL - YH| , Cy := Borrow (i.e. 1 iff YL < YH)
190 FZ_Sub_Abs(X => YLo, Y => YHi, Difference => Dy, Underflow => Cy);
191
192 -- Recurse: DD := Dx * Dy
193 FZ_Multiply_Unbuffered(Dx, Dy, DD);
194
195 -- Whether (XL - XH)(YL - YH) is positive, and so DD must be subtracted:
196 DD_Sub := 1 - (Cx xor Cy);
197
198 -- XY := LL + 2^(2 * K * Bitness) * HH
199 XYLo := LL;
200 XYHi := HH;
201
202 -- XY += 2^(K * Bitness) * HH, but carry goes in Tail Carry accum.
203 FZ_Add_D(X => XYMid, Y => HH, Overflow => TC);
204
205 -- XY += 2^(K * Bitness) * LL, ...
206 FZ_Add_D(X => XYMid, Y => LL, Overflow => C);
207
208 -- ... but the carry goes into the Tail Carry accumulator.
209 TC := TC + C;
210
211 -- XY += 2^(K * Bitness) * (-1^DD_Sub) * DD
212 FZ_Not_Cond_D(N => DD, Cond => DD_Sub); -- invert DD if 2s-complementing
213 FZ_Add_D(OF_In => DD_Sub, -- ... and then must increment
214 X => XYMid,
215 Y => DD,
216 Overflow => C); -- carry will go in Tail Carry accumulator
217
218 -- Compute the final Tail Carry for the ripple
219 TC := TC + C - DD_Sub;
220
221 -- Ripple the Tail Carry into the tail.
222 FZ_Add_D_W(X => XYHiHi, W => TC, Overflow => FinalCarry);
223
224 end Mul_Karatsuba;
225 -- CAUTION: Inlining prohibited for Mul_Karatsuba !
226
227
228 -- Multiplier. (CAUTION: UNBUFFERED)
229 procedure FZ_Multiply_Unbuffered(X : in FZ;
230 Y : in FZ;
231 XY : out FZ) is
232
233 -- The length of either multiplicand
234 L : constant Word_Count := X'Length;
235
236 begin
237
238 if L <= Karatsuba_Thresh then
239
240 -- Base case:
241 FZ_Mul_Comba(X, Y, XY);
242
243 else
244
245 -- Recursive case:
246 Mul_Karatsuba(X, Y, XY);
247
248 end if;
249
250 end FZ_Multiply_Unbuffered;
251
252
253 -- Multiplier. Preserves the inputs.
254 procedure FZ_Multiply_Buffered(X : in FZ;
255 Y : in FZ;
256 XY_Lo : out FZ;
257 XY_Hi : out FZ) is
258
259 -- Product buffer.
260 P : FZ(1 .. 2 * X'Length);
261
262 begin
263
264 FZ_Multiply_Unbuffered(X, Y, P);
265
266 XY_Lo := P(P'First .. P'First + X'Length - 1);
267 XY_Hi := P(P'First + X'Length .. P'Last);
268
269 end FZ_Multiply_Buffered;
270
271 end FZ_Mul;