File : w_mul.adb
1 ------------------------------------------------------------------------------
2 ------------------------------------------------------------------------------
3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
4 -- --
5 -- (C) 2019 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 W_Shifts; use W_Shifts;
21
22
23 package body W_Mul is
24
25 function Mul_HalfWord_Iron(X : in HalfWord;
26 Y : in HalfWord) return Word is
27 begin
28 return X * Y;
29 end Mul_HalfWord_Iron;
30
31
32 -- Multiply half-words X and Y, producing a Word-sized product
33 function Mul_HalfWord_Soft(X : in HalfWord; Y : in HalfWord) return Word is
34
35 -- X-Slide
36 XS : Word := X;
37
38 -- Y-Slide
39 YS : Word := Y;
40
41 -- Gate Mask
42 GM : Word;
43
44 -- The Product
45 XY : Word := 0;
46
47 -- Performed for each bit of HalfWord's bitness:
48 procedure Bit is
49 begin
50
51 -- Compute the gate mask
52 GM := 0 - (YS and 1);
53
54 -- Perform the gated addition
55 XY := XY + (XS and GM);
56
57 -- Crank the next Y-slide bit into position
58 YS := Shift_Right(YS, 1);
59
60 -- Advance the X-slide by 1 bit
61 XS := Shift_Left(XS, 1);
62
63 end Bit;
64
65 begin
66
67 -- For each bit of the Y-Slide (unrolled) :
68 for b in 1 .. HalfByteness loop
69
70 Bit; Bit; Bit; Bit; Bit; Bit; Bit; Bit;
71
72 end loop;
73
74 -- Return the Product
75 return XY;
76
77 end Mul_HalfWord_Soft;
78
79
80 -- Get the bottom half of a Word
81 function BottomHW(W : in Word) return HalfWord is
82 begin
83 return W and (2**HalfBitness - 1);
84 end BottomHW;
85
86
87 -- Get the top half of a Word
88 function TopHW(W : in Word) return HalfWord is
89 begin
90 return Shift_Right(W, HalfBitness);
91 end TopHW;
92
93
94 -- Carry out X*Y mult, return lower word XY_LW and upper word XY_HW.
95 procedure Mul_Word(X : in Word;
96 Y : in Word;
97 XY_LW : out Word;
98 XY_HW : out Word) is
99
100 -- Bottom half of multiplicand X
101 XL : constant HalfWord := BottomHW(X);
102
103 -- Top half of multiplicand X
104 XH : constant HalfWord := TopHW(X);
105
106 -- Bottom half of multiplicand Y
107 YL : constant HalfWord := BottomHW(Y);
108
109 -- Top half of multiplicand Y
110 YH : constant HalfWord := TopHW(Y);
111
112 -- XL * YL
113 LL : constant Word := Mul_HalfWord_Iron(XL, YL);
114
115 -- XL * YH
116 LH : constant Word := Mul_HalfWord_Iron(XL, YH);
117
118 -- XH * YL
119 HL : constant Word := Mul_HalfWord_Iron(XH, YL);
120
121 -- XH * YH
122 HH : constant Word := Mul_HalfWord_Iron(XH, YH);
123
124 -- Carry
125 CL : constant Word := TopHW(TopHW(LL) + BottomHW(LH) + BottomHW(HL));
126
127 begin
128
129 -- Get the bottom half of the Product:
130 XY_LW := LL + Shift_Left(LH + HL, HalfBitness);
131
132 -- Get the top half of the Product:
133 XY_HW := HH + TopHW(HL) + TopHW(LH) + CL;
134
135 end Mul_Word;
136
137 ---------------------------------------------------------------------------
138 -- LET A CURSE FALL FOREVER on the authors of GCC, and on the Ada committee,
139 -- neither of whom saw it fit to decree a primitive which returns both
140 -- upper and lower halves of an iron MUL instruction's result. Consequently,
141 -- portable Mul_Word demands ~four~ MULs (and several additions and shifts);
142 -- while portable Sqr_Word demands ~three~ MULs (and likewise adds/shifts.)
143 -- If it were not for their idiocy, BOTH routines would weigh 1 CPU instr.!
144 ---------------------------------------------------------------------------
145
146 -- Carry out X*X squaring, return lower word XX_LW and upper word XX_HW.
147 procedure Sqr_Word(X : in Word;
148 XX_LW : out Word;
149 XX_HW : out Word) is
150
151 -- Bottom half of multiplicand X
152 XL : constant HalfWord := BottomHW(X);
153
154 -- Top half of multiplicand X
155 XH : constant HalfWord := TopHW(X);
156
157 -- XL^2
158 LL : constant Word := Mul_HalfWord_Iron(XL, XL);
159
160 -- XL * XH
161 LH : constant Word := Mul_HalfWord_Iron(XL, XH);
162
163 -- XH^2
164 HH : constant Word := Mul_HalfWord_Iron(XH, XH);
165
166 -- Carry
167 CL : constant Word := TopHW(TopHW(LL) + Shift_Left(BottomHW(LH), 1));
168
169 begin
170
171 -- Get the bottom half of the Product:
172 XX_LW := LL + Shift_Left(LH, HalfBitness + 1);
173
174 -- Get the top half of the Product:
175 XX_HW := HH + Shift_Left(TopHW(LH), 1) + CL;
176
177 end Sqr_Word;
178
179 end W_Mul;