raw
ffa_ch14_barrett.kv     1 ------------------------------------------------------------------------------
ffa_ch14_barrett.kv 2 ------------------------------------------------------------------------------
ffa_ch14_barrett.kv 3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
ffa_ch14_barrett.kv 4 -- --
ffa_ch15_gcd.kv 5 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
ffa_ch14_barrett.kv 6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
ffa_ch14_barrett.kv 7 -- --
ffa_ch14_barrett.kv 8 -- You do not have, nor can you ever acquire the right to use, copy or --
ffa_ch14_barrett.kv 9 -- distribute this software ; Should you use this software for any purpose, --
ffa_ch14_barrett.kv 10 -- or copy and distribute it to anyone or in any manner, you are breaking --
ffa_ch14_barrett.kv 11 -- the laws of whatever soi-disant jurisdiction, and you promise to --
ffa_ch14_barrett.kv 12 -- continue doing so for the indefinite future. In any case, please --
ffa_ch14_barrett.kv 13 -- always : read and understand any software ; verify any PGP signatures --
ffa_ch14_barrett.kv 14 -- that you use - for any purpose. --
ffa_ch14_barrett.kv 15 -- --
ffa_ch14_barrett.kv 16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
ffa_ch14_barrett.kv 17 ------------------------------------------------------------------------------
ffa_ch14_barrett.kv 18
ffa_ch14_barrett.kv 19 -----------------------------------------------------------------------------
ffa_ch14_barrett.kv 20 -- BEFORE YOU EVEN *THINK* ABOUT MODIFYING THIS PROGRAM: --
ffa_ch14_barrett.kv 21 -----------------------------------------------------------------------------
ffa_ch14_barrett.kv 22 -- `dMMd` +NMMMMMMMNo --
ffa_ch14_barrett.kv 23 -- .dM++Md..oNMMMMMMmo` --
ffa_ch14_barrett.kv 24 -- /mM+ +MmmMMMMMMNo. --
ffa_ch14_barrett.kv 25 -- /NM+ +MMMMMMNo` / --
ffa_ch14_barrett.kv 26 -- /Nd- `sNMMMMMy.-oohNNm` --
ffa_ch14_barrett.kv 27 -- `yNd- -yMMMMMMMNNNMMMMs. --
ffa_ch14_barrett.kv 28 -- hMd::. -mMMMMMdNMMMMMMm+` --
ffa_ch14_barrett.kv 29 -- :hNs.`.:yNyyyo--/sNMMMMy` --
ffa_ch14_barrett.kv 30 -- -o.. `.. `.sNh` --
ffa_ch14_barrett.kv 31 -- ..`RRR EEE AA DDD !+:` --
ffa_ch14_barrett.kv 32 -- `: R R E A A D D ! .o- --
ffa_ch14_barrett.kv 33 -- .s RRR EEE AAAA D D ! .:` --
ffa_ch14_barrett.kv 34 -- .. `` R R E A A D D ys. --
ffa_ch14_barrett.kv 35 -- -h /: R R EEE A A DDD !/ :mm- --
ffa_ch14_barrett.kv 36 -- -mm `/- THE PROOFS!!! -y sMm- --
ffa_ch14_barrett.kv 37 -- -mNy `++` YES THAT MEANS YOU! .s. .`-Nm- --
ffa_ch14_barrett.kv 38 -- `oNN-`:/y``:////:` `-////``-o.+. -NNo` --
ffa_ch14_barrett.kv 39 -- `oNN: `+:::hNMMMMNyo. `smNMMMMmy`++ :NNo` --
ffa_ch14_barrett.kv 40 -- `oNy- .: sMMMMMMMMM: -MMMMMMMMMs/s. -yNh- --
ffa_ch14_barrett.kv 41 -- -dNy. `s. sMMMMMMMmo.----mMMMMMMMNo `.` .yMd- --
ffa_ch14_barrett.kv 42 -- .dmo. `o` /mNNNmyo.`sNMMy.+ymNNNNh `-` .omd. --
ffa_ch14_barrett.kv 43 -- .mN/ -o` .---. `oNMNMNs .----. -/. /Nm. --
ffa_ch14_barrett.kv 44 -- +mN/ .hhs:.. ` .hMN-MMy ` `.-+-` /Nm+ --
ffa_ch14_barrett.kv 45 -- +NN: :hMMMs/m`d -y- dy -`:/y :NN+ --
ffa_ch14_barrett.kv 46 -- +Nd: /: `hMMMmm/ y:Ns::.`````.:oh-- :dNs. --
ffa_ch14_barrett.kv 47 -- .sNh. .h+:hMMMy./- -yMMMyyod+dssMM:. `: .hMh. --
ffa_ch14_barrett.kv 48 -- .hMy. +MNMMMMh` ` `yNMhmsNsmhNh: /` +Mh. --
ffa_ch14_barrett.kv 49 -- -hN+ -dMMMMMNso+- :s .ymmNMmyh+- + +Nh- --
ffa_ch14_barrett.kv 50 -- `MN+ /MMMMMMh:- :- :: : .+ +NM` --
ffa_ch14_barrett.kv 51 -- `Md///////+mMMMMys////////sh/- -yy/////////////////////////dM` --
ffa_ch14_barrett.kv 52 -- -ssssssssymssssssssssssssssso- .+ossssssssssssssssssssssssssss- --
ffa_ch14_barrett.kv 53 -- --
ffa_ch14_barrett.kv 54 --Ch. 14A: Barrett’s Modular Reduction: http://www.loper-os.org/?p=2842 --
ffa_ch14_barrett.kv 55 --Ch. 14A-Bis: Barrett’s Physical Bounds: http://www.loper-os.org/?p=2875 --
ffa_ch14_barrett.kv 56 -- --
ffa_ch14_barrett.kv 57 -----------------------------------------------------------------------------
ffa_ch14_barrett.kv 58
ffa_ch14_barrett.kv 59 with W_Pred; use W_Pred;
ffa_ch14_barrett.kv 60 with W_Shifts; use W_Shifts;
ffa_ch14_barrett.kv 61 with FZ_Basic; use FZ_Basic;
ffa_ch14_barrett.kv 62 with FZ_Shift; use FZ_Shift;
ffa_ch14_barrett.kv 63 with FZ_Arith; use FZ_Arith;
ffa_ch14_barrett.kv 64 with FZ_Mul; use FZ_Mul;
ffa_ch14_barrett.kv 65 with FZ_LoMul; use FZ_LoMul;
ffa_ch14_barrett.kv 66 with FZ_Measr; use FZ_Measr;
ffa_ch14_barrett.kv 67 with FZ_QShft; use FZ_QShft;
ffa_ch14_barrett.kv 68
ffa_ch14_barrett.kv 69
ffa_ch14_barrett.kv 70 package body FZ_Barr is
ffa_ch14_barrett.kv 71
ffa_ch14_barrett.kv 72 -- Prepare the precomputed Barrettoid corresponding to a given Modulus
ffa_ch14_barrett.kv 73 procedure FZ_Make_Barrettoid(Modulus : in FZ;
ffa_ch14_barrett.kv 74 Result : out Barretoid) is
ffa_ch14_barrett.kv 75
ffa_ch14_barrett.kv 76 -- Length of Modulus and Remainder
ffa_ch14_barrett.kv 77 Lm : constant Indices := Modulus'Length;
ffa_ch14_barrett.kv 78
ffa_ch14_barrett.kv 79 -- Remainder register, starts as zero
ffa_ch14_barrett.kv 80 Remainder : FZ(1 .. Lm) := (others => 0);
ffa_ch14_barrett.kv 81
ffa_ch14_barrett.kv 82 -- Length of Quotient, with an extra Word for top bit (if Degenerate)
ffa_ch14_barrett.kv 83 Lq : constant Indices := (2 * Lm) + 1;
ffa_ch14_barrett.kv 84
ffa_ch14_barrett.kv 85 -- Valid indices into Quotient, using the above
ffa_ch14_barrett.kv 86 subtype Quotient_Index is Word_Index range 1 .. Lq;
ffa_ch14_barrett.kv 87
ffa_ch14_barrett.kv 88 -- The Quotient we need, i.e. 2^(2 * ModulusBitness) / Modulus
ffa_ch14_barrett.kv 89 Quotient : FZ(Quotient_Index);
ffa_ch14_barrett.kv 90
ffa_ch14_barrett.kv 91 -- Permissible 'cuts' for the Slice operation
ffa_ch14_barrett.kv 92 subtype Divisor_Cuts is Word_Index range 2 .. Lm;
ffa_ch14_barrett.kv 93
ffa_ch14_barrett.kv 94 -- Current bit of Pseudo-Dividend; high bit is 1, all others 0
ffa_ch14_barrett.kv 95 Pb : WBool := 1;
ffa_ch14_barrett.kv 96
ffa_ch14_barrett.kv 97 -- Performs Restoring Division on a given segment
ffa_ch14_barrett.kv 98 procedure Slice(Index : Quotient_Index;
ffa_ch14_barrett.kv 99 Cut : Divisor_Cuts;
ffa_ch14_barrett.kv 100 Bits : Positive) is
ffa_ch14_barrett.kv 101 begin
ffa_ch14_barrett.kv 102
ffa_ch14_barrett.kv 103 declare
ffa_ch14_barrett.kv 104
ffa_ch14_barrett.kv 105 -- Borrow, from comparator
ffa_ch14_barrett.kv 106 C : WBool;
ffa_ch14_barrett.kv 107
ffa_ch14_barrett.kv 108 -- Left-Shift Overflow
ffa_ch14_barrett.kv 109 LsO : WBool;
ffa_ch14_barrett.kv 110
ffa_ch14_barrett.kv 111 -- Current cut of Remainder register
ffa_ch14_barrett.kv 112 Rs : FZ renames Remainder(1 .. Cut);
ffa_ch14_barrett.kv 113
ffa_ch14_barrett.kv 114 -- Current cut of Divisor
ffa_ch14_barrett.kv 115 Ds : FZ renames Modulus(1 .. Cut);
ffa_ch14_barrett.kv 116
ffa_ch14_barrett.kv 117 -- Current Word of Quotient being made, starting from the highest
ffa_ch14_barrett.kv 118 W : Word := 0;
ffa_ch14_barrett.kv 119
ffa_ch14_barrett.kv 120 -- Current bit of Quotient (inverted)
ffa_ch14_barrett.kv 121 nQb : WBool;
ffa_ch14_barrett.kv 122
ffa_ch14_barrett.kv 123 begin
ffa_ch14_barrett.kv 124
ffa_ch14_barrett.kv 125 -- For each bit in the current Pseudo-Dividend Word:
ffa_ch14_barrett.kv 126 for b in 1 .. Bits loop
ffa_ch14_barrett.kv 127
ffa_ch14_barrett.kv 128 -- Advance Rs, shifting in the current Pseudo-Dividend bit:
ffa_ch14_barrett.kv 129 FZ_ShiftLeft_O_I(N => Rs,
ffa_ch14_barrett.kv 130 ShiftedN => Rs,
ffa_ch14_barrett.kv 131 Count => 1,
ffa_ch14_barrett.kv 132 OF_In => Pb, -- Current Pseudo-Dividend bit
ffa_ch14_barrett.kv 133 Overflow => LsO);
ffa_ch14_barrett.kv 134
ffa_ch14_barrett.kv 135 -- Subtract Divisor-Cut from R-Cut; Underflow goes into C:
ffa_ch14_barrett.kv 136 FZ_Sub(X => Rs, Y => Ds, Difference => Rs, Underflow => C);
ffa_ch14_barrett.kv 137
ffa_ch14_barrett.kv 138 -- Negation of current Quotient bit
ffa_ch14_barrett.kv 139 nQb := C and W_Not(LsO);
ffa_ch14_barrett.kv 140
ffa_ch14_barrett.kv 141 -- If C=1, the subtraction underflowed, and we must undo it:
ffa_ch14_barrett.kv 142 FZ_Add_Gated(X => Rs, Y => Ds, Sum => Rs,
ffa_ch14_barrett.kv 143 Gate => nQb);
ffa_ch14_barrett.kv 144
ffa_ch14_barrett.kv 145 -- Save the bit of Quotient that we have found:
ffa_ch14_barrett.kv 146 W := Shift_Left(W, 1) or (1 - nQb); -- i.e. inverse of nQb
ffa_ch14_barrett.kv 147
ffa_ch14_barrett.kv 148 end loop;
ffa_ch14_barrett.kv 149
ffa_ch14_barrett.kv 150 -- We made a complete Word of the Quotient; save it:
ffa_ch14_barrett.kv 151 Quotient(Quotient'Last + 1 - Index) := W; -- Indexed from end
ffa_ch14_barrett.kv 152
ffa_ch14_barrett.kv 153 end;
ffa_ch14_barrett.kv 154
ffa_ch14_barrett.kv 155 end Slice;
ffa_ch14_barrett.kv 156 pragma Inline_Always(Slice);
ffa_ch14_barrett.kv 157
ffa_ch14_barrett.kv 158 -- Measure of the Modulus
ffa_ch14_barrett.kv 159 ModulusMeasure : constant FZBit_Index := FZ_Measure(Modulus);
ffa_ch14_barrett.kv 160
ffa_ch14_barrett.kv 161 begin
ffa_ch14_barrett.kv 162
ffa_ch14_barrett.kv 163 -- First, process the high Word of the Pseudo-Dividend:
ffa_ch14_barrett.kv 164 Slice(1, 2, 1); -- ... it has just one bit: a 1 at the bottom position
ffa_ch14_barrett.kv 165
ffa_ch14_barrett.kv 166 -- Once we ate the top 1 bit of Pseudo-Dividend, rest of its bits are 0
ffa_ch14_barrett.kv 167 Pb := 0;
ffa_ch14_barrett.kv 168
ffa_ch14_barrett.kv 169 -- Process the Modulus-sized segment below the top Word:
ffa_ch14_barrett.kv 170 for i in 2 .. Lm - 1 loop
ffa_ch14_barrett.kv 171
ffa_ch14_barrett.kv 172 Slice(i, i + 1, Bitness); -- stay ahead by a word to handle carry
ffa_ch14_barrett.kv 173
ffa_ch14_barrett.kv 174 end loop;
ffa_ch14_barrett.kv 175
ffa_ch14_barrett.kv 176 -- Process remaining Words:
ffa_ch14_barrett.kv 177 for i in Lm .. Lq loop
ffa_ch14_barrett.kv 178
ffa_ch14_barrett.kv 179 Slice(i, Lm, Bitness);
ffa_ch14_barrett.kv 180
ffa_ch14_barrett.kv 181 end loop;
ffa_ch14_barrett.kv 182
ffa_ch14_barrett.kv 183 -- Record the Quotient (i.e. the Barrettoid proper, Bm)
ffa_ch14_barrett.kv 184 Result.B := Quotient(Result.B'Range);
ffa_ch14_barrett.kv 185
ffa_ch14_barrett.kv 186 -- Record whether we have the Degenerate Case (1 iff Modulus = 1)
ffa_ch14_barrett.kv 187 Result.Degenerate := W_NZeroP(Quotient(Lq));
ffa_ch14_barrett.kv 188
ffa_ch14_barrett.kv 189 -- Record a copy of the Modulus, extended with zero Word:
ffa_ch14_barrett.kv 190 Result.ZXM(Modulus'Range) := Modulus;
ffa_ch14_barrett.kv 191 Result.ZXM(Result.ZXM'Last) := 0;
ffa_ch14_barrett.kv 192
ffa_ch14_barrett.kv 193 -- Record the parameter Jm:
ffa_ch14_barrett.kv 194 Result.J := ModulusMeasure - 1;
ffa_ch14_barrett.kv 195
ffa_ch14_barrett.kv 196 -- Wm - Jm
ffa_ch14_barrett.kv 197 Result.ZSlide :=
ffa_ch14_barrett.kv 198 FZBit_Index(Bitness * Modulus'Length) - ModulusMeasure + 1;
ffa_ch14_barrett.kv 199
ffa_ch14_barrett.kv 200 end FZ_Make_Barrettoid;
ffa_ch14_barrett.kv 201
ffa_ch14_barrett.kv 202
ffa_ch14_barrett.kv 203 -- Reduce X using the given precomputed Barrettoid.
ffa_ch14_barrett.kv 204 procedure FZ_Barrett_Reduce(X : in FZ;
ffa_ch14_barrett.kv 205 Bar : in Barretoid;
ffa_ch14_barrett.kv 206 XReduced : in out FZ) is
ffa_ch14_barrett.kv 207
ffa_ch14_barrett.kv 208 -- Wordness of X, the quantity being reduced
ffa_ch14_barrett.kv 209 Xl : constant Indices := X'Length;
ffa_ch14_barrett.kv 210
ffa_ch14_barrett.kv 211 -- Wordness of XReduced (result), one-half of Xl, and same as of Modulus
ffa_ch14_barrett.kv 212 Ml : constant Indices := XReduced'Length; -- i.e. # of Words in Wm.
ffa_ch14_barrett.kv 213
ffa_ch14_barrett.kv 214 -- The Modulus we will reduce X by
ffa_ch14_barrett.kv 215 Modulus : FZ renames Bar.ZXM(1 .. Ml);
ffa_ch14_barrett.kv 216
ffa_ch14_barrett.kv 217 -- Shifted X
ffa_ch14_barrett.kv 218 Xs : FZ(X'Range);
ffa_ch14_barrett.kv 219
ffa_ch14_barrett.kv 220 -- Z := Xs * Bm (has twice the length of X)
ffa_ch14_barrett.kv 221 Z : FZ(1 .. 2 * Xl);
ffa_ch14_barrett.kv 222
ffa_ch14_barrett.kv 223 -- Upper 3Wm-bit segment of Z that gets shifted to form Zs
ffa_ch14_barrett.kv 224 ZHi : FZ renames Z(Ml + 1 .. Z'Last );
ffa_ch14_barrett.kv 225
ffa_ch14_barrett.kv 226 -- Middle 2Wm-bit segment of Z, that gets multiplied by M to form Q
ffa_ch14_barrett.kv 227 Zs : FZ renames Z(Z'First + Ml .. Z'Last - Ml );
ffa_ch14_barrett.kv 228
ffa_ch14_barrett.kv 229 -- Sub-terms of the Zs * M multiplication:
ffa_ch14_barrett.kv 230 ZsLo : FZ renames Zs(Zs'First .. Zs'Last - Ml );
ffa_ch14_barrett.kv 231 ZsHi : FZ renames Zs(Zs'First + Ml .. Zs'Last );
ffa_ch14_barrett.kv 232 ZsHiM : FZ(1 .. Ml);
ffa_ch14_barrett.kv 233
ffa_ch14_barrett.kv 234 -- Q := Modulus * Zs, i.e. floor(X / M)*M + E*M
ffa_ch14_barrett.kv 235 Q : FZ(1 .. Xl);
ffa_ch14_barrett.kv 236 QHi : FZ renames Q(Q'First + Ml .. Q'Last );
ffa_ch14_barrett.kv 237
ffa_ch14_barrett.kv 238 -- R is made one Word longer than Modulus (see proof re: why)
ffa_ch14_barrett.kv 239 Rl : constant Indices := Ml + 1;
ffa_ch14_barrett.kv 240
ffa_ch14_barrett.kv 241 -- Reduction estimate, overshot by 0, 1, or 2 multiple of Modulus
ffa_ch14_barrett.kv 242 R : FZ(1 .. Rl);
ffa_ch14_barrett.kv 243
ffa_ch14_barrett.kv 244 -- Scratch for the outputs of the gated subtractions
ffa_ch14_barrett.kv 245 S : FZ(1 .. Rl);
ffa_ch14_barrett.kv 246
ffa_ch14_barrett.kv 247 -- Borrow from the gated subtractions
ffa_ch14_barrett.kv 248 C : WBool;
ffa_ch14_barrett.kv 249
ffa_ch14_barrett.kv 250 -- Barring cosmic ray, no underflow can take place in (4) and (5)
ffa_ch14_barrett.kv 251 NoCarry : WZeroOrDie := 0;
ffa_ch14_barrett.kv 252
ffa_ch14_barrett.kv 253 begin
ffa_ch14_barrett.kv 254
ffa_ch14_barrett.kv 255 -- Result is initially zero (and will stay zero if Modulus = 1)
ffa_ch14_barrett.kv 256 FZ_Clear(XReduced);
ffa_ch14_barrett.kv 257
ffa_ch15_gcd.kv 258 -- (1) Xs := X >> Jm
ffa_ch14_barrett.kv 259 FZ_Quiet_ShiftRight(N => X, ShiftedN => Xs, Count => Bar.J);
ffa_ch14_barrett.kv 260
ffa_ch15_gcd.kv 261 -- (2) Z := Xs * Bm
ffa_ch14_barrett.kv 262 FZ_Multiply_Unbuffered(X => Bar.B, Y => Xs, XY => Z);
ffa_ch14_barrett.kv 263
ffa_ch14_barrett.kv 264 -- (3) Zs := Z >> 2Wm - Jm (already thrown lower Wm, so only Wm - Jm now)
ffa_ch14_barrett.kv 265 FZ_Quiet_ShiftRight(N => ZHi, ShiftedN => ZHi, Count => Bar.ZSlide);
ffa_ch14_barrett.kv 266
ffa_ch14_barrett.kv 267 -- (4) Q := Zs * M (this is split into three operations, see below)
ffa_ch14_barrett.kv 268
ffa_ch14_barrett.kv 269 -- ... first, Q := ZsLo * M,
ffa_ch14_barrett.kv 270 FZ_Multiply_Unbuffered(ZsLo, Modulus, Q);
ffa_ch14_barrett.kv 271
ffa_ch14_barrett.kv 272 -- ... then, compute ZsHiM := ZsHi * M,
ffa_ch14_barrett.kv 273 FZ_Low_Multiply_Unbuffered(ZsHi, Modulus, ZsHiM);
ffa_ch14_barrett.kv 274
ffa_ch14_barrett.kv 275 -- ... finally, add ZsHiM to upper half of Q.
ffa_ch14_barrett.kv 276 FZ_Add_D(X => QHi, Y => ZsHiM, Overflow => NoCarry);
ffa_ch14_barrett.kv 277
ffa_ch14_barrett.kv 278 -- (5) R := X - Q (we only need Rl-sized segments of X and Q here)
ffa_ch14_barrett.kv 279 FZ_Sub(X => X(1 .. Rl), Y => Q(1 .. Rl),
ffa_ch14_barrett.kv 280 Difference => R, Underflow => NoCarry);
ffa_ch14_barrett.kv 281
ffa_ch14_barrett.kv 282 -- (6) S1 := R - M, C1 := Borrow (1st gated subtraction of Modulus)
ffa_ch14_barrett.kv 283 FZ_Sub(X => R, Y => Bar.ZXM, Difference => S, Underflow => C);
ffa_ch14_barrett.kv 284
ffa_ch14_barrett.kv 285 -- (7) R := {C1=0 -> S1, C1=1 -> R}
ffa_ch14_barrett.kv 286 FZ_Mux(X => S, Y => R, Result => R, Sel => C);
ffa_ch14_barrett.kv 287
ffa_ch14_barrett.kv 288 -- (8) S2 := R - M, C2 := Borrow (2nd gated subtraction of Modulus)
ffa_ch14_barrett.kv 289 FZ_Sub(X => R, Y => Bar.ZXM, Difference => S, Underflow => C);
ffa_ch14_barrett.kv 290
ffa_ch14_barrett.kv 291 -- (9) R := {C2=0 -> S2, C2=1 -> R}
ffa_ch14_barrett.kv 292 FZ_Mux(X => S, Y => R, Result => R, Sel => C);
ffa_ch14_barrett.kv 293
ffa_ch14_barrett.kv 294 -- (10) RFinal := {DM=0 -> R, DM=1 -> 0} (handle the degenerate case)
ffa_ch14_barrett.kv 295 FZ_Mux(X => R(1 .. Ml), Y => XReduced, Result => XReduced,
ffa_ch14_barrett.kv 296 Sel => Bar.Degenerate); -- If Modulus = 1, then XReduced is 0.
ffa_ch14_barrett.kv 297
ffa_ch14_barrett.kv 298 end FZ_Barrett_Reduce;
ffa_ch14_barrett.kv 299
ffa_ch14_barrett.kv 300 end FZ_Barr;