File Coverage

blib/lib/Chess/Plisco.pm
Criterion Covered Total %
statement 2352 2724 86.3
branch 464 648 71.6
condition 169 224 75.4
subroutine 278 313 88.8
pod 92 93 98.9
total 3355 4002 83.8


line stmt bran cond sub pod time code
1             #! /bin/false
2              
3             # Copyright (C) 2021 Guido Flohr ,
4             # all rights reserved.
5              
6             # This program is free software. It comes without any warranty, to
7             # the extent permitted by applicable law. You can redistribute it
8             # and/or modify it under the terms of the Do What the Fuck You Want
9             # to Public License, Version 2, as published by Sam Hocevar. See
10             # http://www.wtfpl.net/ for more details.
11              
12             # Portions of this code have been ported from C code that has the following
13             # copyright notice:
14              
15             # Copyright (C) 2007 Pradyumna Kannan.
16             #
17             # This code is provided 'as-is', without any express or implied warranty.
18             # In no event will the authors be held liable for any damages arising from
19             # the use of this code. Permission is granted to anyone to use this
20             # code for any purpose, including commercial applications, and to alter
21             # it and redistribute it freely, subject to the following restrictions:
22             #
23             # 1. The origin of this code must not be misrepresented; you must not
24             # claim that you wrote the original code. If you use this code in a
25             # product, an acknowledgment in the product documentation would be
26             # appreciated but is not required.
27             #
28             # 2. Altered source versions must be plainly marked as such, and must not be
29             # misrepresented as being the original code.
30             #
31             # 3. This notice may not be removed or altered from any source distribution.
32              
33             # Make Dist::Zilla happy.
34             # ABSTRACT: Representation of a chess position with move generator, legality checker etc.
35              
36             # Welcome to the world of spaghetti code! It is deliberately ugly because
37             # trying to avoid function/method call overhead is one of the major goals.
38             # In the future it may make sense to try to make the code more readable by
39             # more extensive use of Chess::Plisco::Macro.
40              
41             package Chess::Plisco;
42             $Chess::Plisco::VERSION = '0.4';
43 39     39   2019766 use strict;
  39         310  
  39         1195  
44 39     39   2609 use integer;
  39         120  
  39         191  
45 39     39   994 no warnings qw(portable);
  39         118  
  39         2216  
46 39     39   36505 use overload '""' => sub { shift->toFEN };
  39     1823   30975  
  39         371  
  1823         25531  
47              
48 39     39   19647 use Locale::TextDomain qw('Chess-Plisco');
  39         574844  
  39         226  
49 39     39   887570 use Scalar::Util qw(reftype);
  39         88  
  39         1537  
50 39     39   202 use Config;
  39         71  
  39         1535  
51              
52             # Macros from Chess::Plisco::Macro are already expanded here!
53              
54 39     39   200 use base qw(Exporter);
  39         82  
  39         4145  
55              
56             # Colors.
57 39     39   224 use constant CP_WHITE => 0;
  39         75  
  39         2596  
58 39     39   248 use constant CP_BLACK => 1;
  39         78  
  39         2156  
59              
60             # Piece constants.
61 39     39   195 use constant CP_NO_PIECE => 0;
  39         75  
  39         1620  
62 39     39   216 use constant CP_PAWN => 1;
  39         85  
  39         1773  
63 39     39   215 use constant CP_KNIGHT => 2;
  39         76  
  39         1748  
64 39     39   232 use constant CP_BISHOP => 3;
  39         74  
  39         2013  
65 39     39   284 use constant CP_ROOK => 4;
  39         62  
  39         2146  
66 39     39   256 use constant CP_QUEEN => 5;
  39         82  
  39         1621  
67 39     39   206 use constant CP_KING => 6;
  39         81  
  39         1760  
68 39     39   213 use constant CP_PAWN_VALUE => 100;
  39         74  
  39         1828  
69 39     39   208 use constant CP_KNIGHT_VALUE => 320;
  39         74  
  39         1850  
70 39     39   224 use constant CP_BISHOP_VALUE => 330;
  39         164  
  39         1834  
71 39     39   244 use constant CP_ROOK_VALUE => 500;
  39         65  
  39         1560  
72 39     39   264 use constant CP_QUEEN_VALUE => 900;
  39         69  
  39         2399  
73              
74             # Accessor indices. The layout is selected in such a way that piece types
75             # can be used directly as indices in order to get the corresponding bitboard,
76             # and getting the pieces for the side to move and the side not to move can
77             # be simplified by just adding the color or the negated color to the index
78             # of the white pieces. This must not change in future versions!
79 39     39   257 use constant CP_POS_HALF_MOVES => 0;
  39         65  
  39         1836  
80 39     39   205 use constant CP_POS_PAWNS => CP_PAWN;
  39         72  
  39         1733  
81 39     39   200 use constant CP_POS_KNIGHTS => CP_KNIGHT;
  39         77  
  39         1891  
82 39     39   213 use constant CP_POS_BISHOPS => CP_BISHOP;
  39         168  
  39         1981  
83 39     39   242 use constant CP_POS_ROOKS => CP_ROOK;
  39         61  
  39         1717  
84 39     39   203 use constant CP_POS_QUEENS => CP_QUEEN;
  39         60  
  39         1671  
85 39     39   224 use constant CP_POS_KINGS => CP_KING;
  39         85  
  39         1635  
86 39     39   193 use constant CP_POS_WHITE_PIECES => 7;
  39         77  
  39         2013  
87 39     39   243 use constant CP_POS_BLACK_PIECES => CP_POS_WHITE_PIECES + CP_BLACK;
  39         77  
  39         1725  
88 39     39   194 use constant CP_POS_HALF_MOVE_CLOCK => 9;
  39         61  
  39         1618  
89 39     39   188 use constant CP_POS_INFO => 10;
  39         66  
  39         1809  
90 39     39   225 use constant CP_POS_EVASION_SQUARES => 11;
  39         63  
  39         1581  
91 39     39   194 use constant CP_POS_SIGNATURE => 12;
  39         67  
  39         1694  
92 39     39   207 use constant CP_POS_REVERSIBLE_CLOCK => 13;
  39         75  
  39         1745  
93             # 3 reserved slots.
94 39     39   243 use constant CP_POS_IN_CHECK => 17;
  39         106  
  39         1667  
95              
96             # How to evade a check?
97 39     39   196 use constant CP_EVASION_ALL => 0;
  39         98  
  39         2059  
98 39     39   232 use constant CP_EVASION_CAPTURE => 1;
  39         70  
  39         1639  
99 39     39   210 use constant CP_EVASION_KING_MOVE => 2;
  39         61  
  39         1754  
100              
101             # Board masks and shifts.
102             # Squares.
103 39     39   201 use constant CP_A1 => 0;
  39         98  
  39         1733  
104 39     39   266 use constant CP_B1 => 1;
  39         92  
  39         1658  
105 39     39   193 use constant CP_C1 => 2;
  39         79  
  39         1686  
106 39     39   228 use constant CP_D1 => 3;
  39         88  
  39         1830  
107 39     39   237 use constant CP_E1 => 4;
  39         78  
  39         1725  
108 39     39   190 use constant CP_F1 => 5;
  39         65  
  39         2033  
109 39     39   220 use constant CP_G1 => 6;
  39         96  
  39         2037  
110 39     39   208 use constant CP_H1 => 7;
  39         74  
  39         1706  
111 39     39   197 use constant CP_A2 => 8;
  39         64  
  39         1620  
112 39     39   211 use constant CP_B2 => 9;
  39         61  
  39         1894  
113 39     39   783 use constant CP_C2 => 10;
  39         99  
  39         1553  
114 39     39   188 use constant CP_D2 => 11;
  39         70  
  39         1622  
115 39     39   253 use constant CP_E2 => 12;
  39         80  
  39         1661  
116 39     39   190 use constant CP_F2 => 13;
  39         68  
  39         1780  
117 39     39   210 use constant CP_G2 => 14;
  39         98  
  39         1639  
118 39     39   204 use constant CP_H2 => 15;
  39         68  
  39         1589  
119 39     39   275 use constant CP_A3 => 16;
  39         102  
  39         1790  
120 39     39   208 use constant CP_B3 => 17;
  39         82  
  39         1658  
121 39     39   202 use constant CP_C3 => 18;
  39         59  
  39         1583  
122 39     39   206 use constant CP_D3 => 19;
  39         60  
  39         2012  
123 39     39   222 use constant CP_E3 => 20;
  39         87  
  39         1556  
124 39     39   203 use constant CP_F3 => 21;
  39         85  
  39         1571  
125 39     39   379 use constant CP_G3 => 22;
  39         89  
  39         1661  
126 39     39   203 use constant CP_H3 => 23;
  39         65  
  39         1792  
127 39     39   190 use constant CP_A4 => 24;
  39         954  
  39         1606  
128 39     39   209 use constant CP_B4 => 25;
  39         72  
  39         1508  
129 39     39   182 use constant CP_C4 => 26;
  39         78  
  39         1506  
130 39     39   233 use constant CP_D4 => 27;
  39         65  
  39         1765  
131 39     39   215 use constant CP_E4 => 28;
  39         87  
  39         1601  
132 39     39   210 use constant CP_F4 => 29;
  39         72  
  39         1638  
133 39     39   202 use constant CP_G4 => 30;
  39         67  
  39         1695  
134 39     39   201 use constant CP_H4 => 31;
  39         58  
  39         1647  
135 39     39   194 use constant CP_A5 => 32;
  39         71  
  39         1698  
136 39     39   238 use constant CP_B5 => 33;
  39         92  
  39         1846  
137 39     39   204 use constant CP_C5 => 34;
  39         90  
  39         1594  
138 39     39   204 use constant CP_D5 => 35;
  39         102  
  39         1693  
139 39     39   204 use constant CP_E5 => 36;
  39         110  
  39         2133  
140 39     39   214 use constant CP_F5 => 37;
  39         59  
  39         1948  
141 39     39   203 use constant CP_G5 => 38;
  39         73  
  39         1887  
142 39     39   206 use constant CP_H5 => 39;
  39         56  
  39         1645  
143 39     39   206 use constant CP_A6 => 40;
  39         59  
  39         1623  
144 39     39   199 use constant CP_B6 => 41;
  39         72  
  39         1964  
145 39     39   203 use constant CP_C6 => 42;
  39         59  
  39         1642  
146 39     39   207 use constant CP_D6 => 43;
  39         61  
  39         1724  
147 39     39   247 use constant CP_E6 => 44;
  39         64  
  39         1738  
148 39     39   195 use constant CP_F6 => 45;
  39         66  
  39         1780  
149 39     39   204 use constant CP_G6 => 46;
  39         91  
  39         1764  
150 39     39   200 use constant CP_H6 => 47;
  39         61  
  39         1640  
151 39     39   205 use constant CP_A7 => 48;
  39         79  
  39         1782  
152 39     39   206 use constant CP_B7 => 49;
  39         87  
  39         1611  
153 39     39   188 use constant CP_C7 => 50;
  39         62  
  39         1527  
154 39     39   232 use constant CP_D7 => 51;
  39         57  
  39         1688  
155 39     39   247 use constant CP_E7 => 52;
  39         80  
  39         1728  
156 39     39   205 use constant CP_F7 => 53;
  39         72  
  39         1742  
157 39     39   223 use constant CP_G7 => 54;
  39         88  
  39         1591  
158 39     39   212 use constant CP_H7 => 55;
  39         69  
  39         1645  
159 39     39   210 use constant CP_A8 => 56;
  39         63  
  39         1602  
160 39     39   200 use constant CP_B8 => 57;
  39         62  
  39         1641  
161 39     39   195 use constant CP_C8 => 58;
  39         62  
  39         1633  
162 39     39   206 use constant CP_D8 => 59;
  39         70  
  39         1570  
163 39     39   225 use constant CP_E8 => 60;
  39         94  
  39         1884  
164 39     39   206 use constant CP_F8 => 61;
  39         63  
  39         1634  
165 39     39   210 use constant CP_G8 => 62;
  39         60  
  39         1669  
166 39     39   195 use constant CP_H8 => 63;
  39         59  
  39         1765  
167              
168             # Files.
169 39     39   198 use constant CP_A_MASK => 0x0101010101010101;
  39         63  
  39         1592  
170 39     39   197 use constant CP_B_MASK => 0x0202020202020202;
  39         59  
  39         1673  
171 39     39   213 use constant CP_C_MASK => 0x0404040404040404;
  39         58  
  39         1634  
172 39     39   204 use constant CP_D_MASK => 0x0808080808080808;
  39         79  
  39         1659  
173 39     39   252 use constant CP_E_MASK => 0x1010101010101010;
  39         102  
  39         2303  
174 39     39   241 use constant CP_F_MASK => 0x2020202020202020;
  39         59  
  39         2054  
175 39     39   203 use constant CP_G_MASK => 0x4040404040404040;
  39         72  
  39         2035  
176 39     39   222 use constant CP_H_MASK => 0x8080808080808080;
  39         73  
  39         1603  
177              
178             # Ranks.
179 39     39   239 use constant CP_1_MASK => 0x00000000000000ff;
  39         74  
  39         1860  
180 39     39   198 use constant CP_2_MASK => 0x000000000000ff00;
  39         79  
  39         2111  
181 39     39   215 use constant CP_3_MASK => 0x0000000000ff0000;
  39         57  
  39         1633  
182 39     39   198 use constant CP_4_MASK => 0x00000000ff000000;
  39         94  
  39         1806  
183 39     39   232 use constant CP_5_MASK => 0x000000ff00000000;
  39         90  
  39         1702  
184 39     39   259 use constant CP_6_MASK => 0x0000ff0000000000;
  39         71  
  39         1609  
185 39     39   201 use constant CP_7_MASK => 0x00ff000000000000;
  39         72  
  39         1871  
186 39     39   211 use constant CP_8_MASK => 0xff00000000000000;
  39         82  
  39         1710  
187              
188 39     39   210 use constant CP_FILE_A => (0);
  39         76  
  39         1582  
189 39     39   187 use constant CP_FILE_B => (1);
  39         75  
  39         1803  
190 39     39   210 use constant CP_FILE_C => (2);
  39         68  
  39         1651  
191 39     39   214 use constant CP_FILE_D => (3);
  39         58  
  39         1511  
192 39     39   203 use constant CP_FILE_E => (4);
  39         80  
  39         1776  
193 39     39   221 use constant CP_FILE_F => (5);
  39         64  
  39         1631  
194 39     39   229 use constant CP_FILE_G => (6);
  39         82  
  39         1641  
195 39     39   208 use constant CP_FILE_H => (7);
  39         68  
  39         1720  
196              
197 39     39   212 use constant CP_RANK_1 => (0);
  39         59  
  39         1682  
198 39     39   206 use constant CP_RANK_2 => (1);
  39         71  
  39         1701  
199 39     39   214 use constant CP_RANK_3 => (2);
  39         65  
  39         1608  
200 39     39   248 use constant CP_RANK_4 => (3);
  39         91  
  39         1647  
201 39     39   222 use constant CP_RANK_5 => (4);
  39         71  
  39         1725  
202 39     39   215 use constant CP_RANK_6 => (5);
  39         95  
  39         1727  
203 39     39   213 use constant CP_RANK_7 => (6);
  39         87  
  39         1643  
204 39     39   201 use constant CP_RANK_8 => (7);
  39         135  
  39         1673  
205              
206 39     39   212 use constant CP_WHITE_MASK => 0x5555555555555555;
  39         74  
  39         1972  
207 39     39   223 use constant CP_BLACK_MASK => 0xaaaaaaaaaaaaaaaa;
  39         81  
  39         2674  
208              
209 39         1934 use constant CP_PIECE_CHARS => [
210             ['', 'P', 'N', 'B', 'R', 'Q', 'K'],
211             ['', 'p', 'n', 'b', 'r', 'q', 'k'],
212 39     39   223 ];
  39         71  
213              
214 39     39   223 use constant CP_RANDOM_SEED => 0x415C0415C0415C0;
  39         89  
  39         9417  
215             my $cp_random = CP_RANDOM_SEED;
216              
217             my @pawn_aux_data = (
218             # White.
219             [
220             # Mask for regular moves.
221             ~(CP_7_MASK | CP_8_MASK),
222             # Mask for double moves.
223             CP_2_MASK,
224             # Promotion mask.
225             CP_7_MASK,
226             # Single step offset.
227             8,
228             ],
229             # Black.
230             [
231             # Mask for regular moves.
232             ~(CP_2_MASK | CP_1_MASK),
233             # Mask for double moves.
234             CP_7_MASK,
235             # Promotion mask.
236             CP_2_MASK,
237             # Single step offset.
238             -8,
239             ],
240             );
241              
242             # Map ep squares to the mask of the pawn that gets removed.
243             my @ep_pawn_masks;
244              
245             my @castling_aux_data = (
246             # White.
247             [
248             # From shift.
249             CP_E1,
250             # From mask.
251             (CP_E_MASK & CP_1_MASK),
252             # King-side crossing square.
253             (CP_F_MASK & CP_1_MASK),
254             # King-side king's destination square.
255             CP_G1,
256             # Queen-side crossing mask.
257             (CP_D_MASK & CP_1_MASK),
258             # Queen-side king's destination square.
259             CP_C1,
260             # Queen-side rook crossing mask.
261             (CP_B_MASK & CP_1_MASK),
262             ],
263             # Black.
264             [
265             # From shift.
266             CP_E8,
267             # From mask.
268             (CP_E_MASK & CP_8_MASK),
269             # King-side crossing mask.
270             (CP_F_MASK & CP_8_MASK),
271             # King-side king's destination square.
272             CP_G8,
273             # Queen-side crossing mask.
274             (CP_D_MASK & CP_8_MASK),
275             # Queen-side king's destination square.
276             CP_C8,
277             # Queen-side rook crossing mask.
278             (CP_B_MASK & CP_8_MASK),
279             ],
280             );
281              
282             # These arrays map a bit shift offset to bitboards that the corresponding
283             # piece can attack from that square. They are filled at compile-time at the
284             # end of this file.
285             my @king_attack_masks;
286             my @knight_attack_masks;
287              
288             # These are for pawn single steps, double steps, and captures,
289             # first for white then for black.
290             my @pawn_masks;
291              
292             # Two-dimensional array for determining common lines (diagonals or files/ranks).
293             my @common_lines;
294              
295             # Information for castlings, part 1. Lookup by target square of the king, the
296             # move mask of the rook and the negative mask for the castling rights.
297             my @castling_rook_move_masks;
298              
299             # Information for castlings, part 2. For a1, h1, a8, and h8 remove these
300             # castling rights.
301             my @castling_rights_rook_masks;
302              
303             # Information for castlings, part 3. For the king destination squares c1, g1,
304             # c8, and g8, where does the rook move? Needed for moveGivesCheck().
305             my @castling_rook_to_mask;
306              
307             # Change in material. Looked up via a combined mask of color to move,
308             # captured and promotion piece.
309             my @material_deltas;
310              
311             # This table is used in the static exchange evaluation in order to
312             # detect x-ray attacks. It gives a mask of all squares that will
313             # attack the destination square if a piece moves from the start square to the
314             # destination square. Example: The "obscured mask" of the bishop move "d3e6"
315             # is a bitboard with the squares "b1" and "c2" because a queen or bishop on one
316             # of these two squares will attack "e6", when the bishop moves there.
317             #
318             # FIXME! All multi-dimensional lookup tables that are using from and to as
319             # their index, should changed to just use the lower 12 bits of the move
320             # instead. That saves us one array dereferencing.
321             my @obscured_masks;
322              
323             my @zk_pieces;
324             my @zk_castling;
325             my @zk_ep_files;
326             my $zk_color;
327              
328             my @zk_move_masks;
329              
330             my @move_numbers;
331              
332             my @magicmovesbdb;
333             my @magicmovesrdb;
334              
335             my @magicmoves_r_magics;
336             my @magicmoves_r_mask;
337             my @magicmoves_b_magics;
338             my @magicmoves_b_mask;
339              
340 39     39   252 use constant CP_MAGICMOVES_B_MAGICS => \@magicmoves_b_magics;
  39         62  
  39         1895  
341 39     39   195 use constant CP_MAGICMOVES_R_MAGICS => \@magicmoves_r_magics;
  39         66  
  39         1649  
342 39     39   437 use constant CP_MAGICMOVES_B_MASK => \@magicmoves_b_mask;
  39         262  
  39         1799  
343 39     39   248 use constant CP_MAGICMOVES_R_MASK => \@magicmoves_r_mask;
  39         79  
  39         2050  
344 39     39   281 use constant CP_MAGICMOVESBDB => \@magicmovesbdb;
  39         62  
  39         1758  
345 39     39   211 use constant CP_MAGICMOVESRDB => \@magicmovesrdb;
  39         93  
  39         586838  
346              
347             my @piece_values = (0, CP_PAWN_VALUE, CP_KNIGHT_VALUE, CP_BISHOP_VALUE,
348             CP_ROOK_VALUE, CP_QUEEN_VALUE);
349              
350             # Do not remove this line!
351              
352              
353             sub new {
354 141270     141270 1 719967 my ($class, $fen) = @_;
355              
356 141270 100 66     525681 return $class->newFromFEN($fen) if defined $fen && length $fen;
357              
358 27         77 my $self = bless [], $class;
359 27         693 $self->[CP_POS_WHITE_PIECES] = CP_1_MASK | CP_2_MASK;
360 27         83 $self->[CP_POS_BLACK_PIECES] = CP_8_MASK | CP_7_MASK,
361             $self->[CP_POS_KINGS] = (CP_1_MASK | CP_8_MASK) & CP_E_MASK;
362 27         55 $self->[CP_POS_QUEENS] = (CP_D_MASK & CP_1_MASK)
363             | (CP_D_MASK & CP_8_MASK);
364 27         57 $self->[CP_POS_ROOKS] = ((CP_A_MASK | CP_H_MASK) & CP_1_MASK)
365             | ((CP_A_MASK | CP_H_MASK) & CP_8_MASK);
366 27         54 $self->[CP_POS_BISHOPS] = ((CP_C_MASK | CP_F_MASK) & CP_1_MASK)
367             | ((CP_C_MASK | CP_F_MASK) & CP_8_MASK);
368 27         53 $self->[CP_POS_KNIGHTS] = ((CP_B_MASK | CP_G_MASK) & CP_1_MASK)
369             | ((CP_B_MASK | CP_G_MASK) & CP_8_MASK);
370 27         97 $self->[CP_POS_PAWNS] = CP_2_MASK | CP_7_MASK;
371 27         55 $self->[CP_POS_HALF_MOVE_CLOCK] = 0;
372 27         55 $self->[CP_POS_REVERSIBLE_CLOCK] = 0;
373 27         53 $self->[CP_POS_HALF_MOVES] = 0;
374              
375 27         45 my $info = 0;
376 27         103 ($info = ($info & ~(1 << 0)) | (1 << 0));
377 27         58 ($info = ($info & ~(1 << 1)) | (1 << 1));
378 27         59 ($info = ($info & ~(1 << 2)) | (1 << 2));
379 27         50 ($info = ($info & ~(1 << 3)) | (1 << 3));
380 27         54 ($info = ($info & ~(1 << 4)) | (CP_WHITE << 4));
381 27         50 ($info = ($info & ~(0x3f << 5)) | (0 << 5));
382 27         44 $self->[CP_POS_INFO] = $info;
383            
384 27         119 $self->__updateZobristKey;
385 27 50       45 (do { my $c = (($info & (1 << 4)) >> 4); my $kings = $self->[CP_POS_KINGS] & ($c ? $self->[CP_POS_BLACK_PIECES] : $self->[CP_POS_WHITE_PIECES]); my $king_shift = (do { my $A = $kings - 1 - ((($kings - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); ($info = ($info & ~(0x3f << 11)) | ($king_shift << 11)); my $checkers = $self->[CP_POS_IN_CHECK] = (do { my $her_color = !$c; my $her_pieces = $self->[CP_POS_WHITE_PIECES + $her_color]; my $occupancy = $self->[CP_POS_WHITE_PIECES + $c] | $her_pieces; my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$c]->[2]->[$king_shift] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$king_shift] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$king_shift] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$king_shift]) * CP_MAGICMOVES_B_MAGICS->[$king_shift]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$king_shift]) * CP_MAGICMOVES_R_MAGICS->[$king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));}); if ($checkers) { if ($checkers & ($checkers - 1)) { ($info = ($info & ~(0x3 << 17)) | (CP_EVASION_KING_MOVE << 17)); } elsif ($checkers & ($self->[CP_POS_KNIGHTS] | ($self->[CP_POS_PAWNS]))) { ($info = ($info & ~(0x3 << 17)) | (CP_EVASION_CAPTURE << 17)); $self->[CP_POS_EVASION_SQUARES] = $checkers; } else { ($info = ($info & ~(0x3 << 17)) | (CP_EVASION_ALL << 17)); my $piece_shift = (do { my $A = $checkers - 1 - ((($checkers - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); my ($attack_type, undef, $attack_ray) = @{$common_lines[$king_shift]->[$piece_shift]}; if ($attack_ray) { $self->[CP_POS_EVASION_SQUARES] = $attack_ray; } else { $self->[CP_POS_EVASION_SQUARES] = $checkers; } } } $self->[CP_POS_INFO] = $info;});
  27 0       64  
  27 0       110  
  27 0       53  
  27 50       85  
  27         72  
  27         52  
  27         57  
  27         62  
  27         56  
  27         91  
  27         44  
  27         51  
  27         64  
  27         63  
  27         41  
  27         352  
  27         73  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  27         49  
386            
387 27         88 return $self;
388             }
389              
390             sub newFromFEN {
391 141252     141252 1 203939 my ($class, $fen) = @_;
392              
393 141252         675492 my ($pieces, $color, $castling, $ep_square, $hmc, $moveno)
394             = split /[ \t]+/, $fen;
395 141252 100       281078 $ep_square = '-' if !defined $ep_square;
396 141252 100       230450 $hmc = 0 if !defined $hmc;
397 141252 100       214663 $moveno = 1 if !defined $moveno;
398              
399 141252 100 33     466099 if (!(defined $pieces && defined $color && defined $castling)) {
      66        
400 1         6 die __"Illegal FEN: Incomplete.\n";
401             }
402              
403 141251         427659 my @ranks = split '/', $pieces;
404 141251 100       280276 die __"Illegal FEN: FEN does not have exactly eight ranks.\n"
405             if @ranks != 8;
406            
407 141249         170294 my $w_pieces = 0;
408 141249         155370 my $b_pieces = 0;
409 141249         159608 my $kings = 0;
410 141249         156894 my $rooks = 0;
411 141249         148087 my $knights = 0;
412 141249         146745 my $bishops = 0;
413 141249         148770 my $queens = 0;
414 141249         143018 my $pawns = 0;
415              
416 141249         152501 my $material = 0;
417 141249         141673 my $shift = 56;
418 141249         151124 my $rankno = 7;
419 141249         228138 foreach my $rank (@ranks) {
420 1129970         2095830 my @chars = split '', $rank;
421 1129970         1351191 foreach my $char (@chars) {
422 4975721 100 100     10723246 if ('1' le $char && '8' ge $char) {
423 2431455         2721675 $shift += $char;
424 2431455         2820454 next;
425             }
426              
427 2544266         2758383 my $mask = 1 << $shift;
428 2544266 100       5538674 if ('P' eq $char) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
429 445546         467329 $w_pieces |= $mask;
430 445546         426180 $pawns |= $mask;
431 445546         441104 $material += CP_PAWN_VALUE;
432             } elsif ('p' eq $char) {
433 516191         533173 $b_pieces |= $mask;
434 516191         495807 $pawns |= $mask;
435 516191         517142 $material -= CP_PAWN_VALUE;
436             } elsif ('N' eq $char) {
437 183796         192285 $w_pieces |= $mask;
438 183796         186321 $knights |= $mask;
439 183796         189558 $material += CP_KNIGHT_VALUE;
440             } elsif ('n' eq $char) {
441 161701         171141 $b_pieces |= $mask;
442 161701         169645 $knights |= $mask;
443 161701         171596 $material -= CP_KNIGHT_VALUE;
444             } elsif ('B' eq $char) {
445 199681         213129 $w_pieces |= $mask;
446 199681         226709 $bishops |= $mask;
447 199681         208427 $material += CP_BISHOP_VALUE;
448             } elsif ('b' eq $char) {
449 179242         220486 $b_pieces |= $mask;
450 179242         181139 $bishops |= $mask;
451 179242         189361 $material -= CP_BISHOP_VALUE;
452             } elsif ('R' eq $char) {
453 177770         186414 $w_pieces |= $mask;
454 177770         179528 $rooks |= $mask;
455 177770         183849 $material += CP_ROOK_VALUE;
456             } elsif ('r' eq $char) {
457 159198         167513 $b_pieces |= $mask;
458 159198         159039 $rooks |= $mask;
459 159198         174003 $material -= CP_ROOK_VALUE;
460             } elsif ('Q' eq $char) {
461 130692         150081 $w_pieces |= $mask;
462 130692         133872 $queens |= $mask;
463 130692         143781 $material += CP_QUEEN_VALUE;
464             } elsif ('q' eq $char) {
465 107953         120568 $b_pieces |= $mask;
466 107953         113067 $queens |= $mask;
467 107953         111361 $material -= CP_QUEEN_VALUE;
468             } elsif ('K' eq $char) {
469 141245         150248 $w_pieces |= $mask;
470 141245         144994 $kings |= $mask;
471             } elsif ('k' eq $char) {
472 141248         153775 $b_pieces |= $mask;
473 141248         146406 $kings |= $mask;
474             } else {
475 3         10 die __x("Illegal FEN: Illegal piece/number '{x}'.\n",
476             x => $char);
477             }
478 2544263         2843900 ++$shift;
479             }
480              
481 1129967 100       1640784 if (($rankno-- << 3) + 8 != $shift) {
482 1         3 die __x("Illegal FEN: Incomplete or overpopulated rank '{rank}'.\n",
483             rank => $rank);
484             }
485              
486 1129966         1633704 $shift -= 16;
487             }
488              
489 141245         149810 my $popcount;
490              
491 141245         158069 { my $_b = $w_pieces & $kings; for ($popcount = 0; $_b; ++$popcount) { $_b &= $_b - 1; } };
  141245         168953  
  141245         233051  
  141245         230961  
492 141245 50       231524 if ($popcount != 1) {
493 0         0 die __"Illegal FEN: White must have exactly one king.\n";
494             }
495 141245         157931 { my $_b = $b_pieces & $kings; for ($popcount = 0; $_b; ++$popcount) { $_b &= $_b - 1; } };
  141245         165169  
  141245         239807  
  141245         215921  
496 141245 50       224328 if ($popcount != 1) {
497 0         0 die __"Illegal FEN: Black must have exactly one king.\n";
498             }
499              
500 141245         288119 my $self = bless [], $class;
501              
502 141245         261395 $self->[CP_POS_WHITE_PIECES] = $w_pieces;
503 141245         209708 $self->[CP_POS_BLACK_PIECES] = $b_pieces;
504 141245         171232 $self->[CP_POS_KINGS] = $kings;
505 141245         168197 $self->[CP_POS_QUEENS] = $queens;
506 141245         171595 $self->[CP_POS_ROOKS] = $rooks;
507 141245         171608 $self->[CP_POS_BISHOPS] = $bishops;
508 141245         173603 $self->[CP_POS_KNIGHTS] = $knights;
509 141245         168340 $self->[CP_POS_PAWNS] = $pawns;
510              
511 141245         153920 my $pos_info = 0;
512 141245         189087 ($pos_info = (($pos_info & 0x7fffffff) | ($material << 19)));
513              
514 141245 100       256455 if ('w' eq lc $color) {
    50          
515 90726         110984 ($pos_info = ($pos_info & ~(1 << 4)) | (CP_WHITE << 4));
516             } elsif ('b' eq lc $color) {
517 50519         69854 ($pos_info = ($pos_info & ~(1 << 4)) | (CP_BLACK << 4));
518             } else {
519 0         0 die __x"Illegal FEN: Side to move is neither 'w' nor 'b'.\n";
520             }
521              
522 141245 50       233245 if (!length $castling) {
523 0         0 die __"Illegal FEN: Missing castling state.\n";
524             }
525 141245 50       422128 if ($castling !~ /^(?:-|K?Q?k?q?)/) {
526 0         0 die __x("Illegal FEN: Illegal castling state '{state}'.\n",
527             state => $castling);
528             }
529              
530 141245         176062 my ($piece_type, $piece_color);
531              
532 141245         298048 ($piece_type, $piece_color) = $self->pieceAtShift(CP_E1);
533 141245 100 100     317691 if (!($piece_type && $piece_type == CP_KING && $piece_color == CP_WHITE)) {
      100        
534 135603         181768 $castling =~ s/KQ//;
535             }
536 141245         199275 ($piece_type, $piece_color) = $self->pieceAtShift(CP_E8);
537 141245 100 100     317794 if (!($piece_type && $piece_type == CP_KING && $piece_color == CP_BLACK)) {
      100        
538 138620         171116 $castling =~ s/kq//;
539             }
540              
541 141245 100       276591 if ($castling =~ /K/) {
542 372         824 ($piece_type, $piece_color) = $self->pieceAtShift(CP_H1);
543 372 50 33     1833 if ($piece_type && $piece_type == CP_ROOK && $piece_color == CP_WHITE) {
      33        
544 372         698 ($pos_info = ($pos_info & ~(1 << 0)) | (1 << 0));
545             }
546             }
547 141245 100       237454 if ($castling =~ /Q/) {
548 348         684 ($piece_type, $piece_color) = $self->pieceAtShift(CP_A1);
549 348 50 33     1615 if ($piece_type && $piece_type == CP_ROOK && $piece_color == CP_WHITE) {
      33        
550 348         624 ($pos_info = ($pos_info & ~(1 << 1)) | (1 << 1));
551             }
552             }
553 141245 100       234515 if ($castling =~ /k/) {
554 394         795 ($piece_type, $piece_color) = $self->pieceAtShift(CP_H8);
555 394 50 33     2528 if ($piece_type && $piece_type == CP_ROOK && $piece_color == CP_BLACK) {
      33        
556 394         714 ($pos_info = ($pos_info & ~(1 << 2)) | (1 << 2));
557             }
558             }
559 141245 100       204080 if ($castling =~ /q/) {
560 303         756 ($piece_type, $piece_color) = $self->pieceAtShift(CP_A8);
561 303 50 33     1506 if ($piece_type && $piece_type == CP_ROOK && $piece_color == CP_BLACK) {
      33        
562 303         527 ($pos_info = ($pos_info & ~(1 << 3)) | (1 << 3));
563             }
564             }
565              
566 141245         189224 my $to_move = (($pos_info & (1 << 4)) >> 4);
567 141245 100 66     202119 if ('-' eq $ep_square) {
    100 33        
    50          
568 141130         172730 ($pos_info = ($pos_info & ~(0x3f << 5)) | (0 << 5));
569             } elsif ($to_move == CP_WHITE && $ep_square =~ /^[a-h]6$/) {
570 66         231 my $ep_shift = $self->squareToShift($ep_square);
571 66 50       260 if ((1 << ($ep_shift - 8)) & $self->[CP_POS_BLACK_PIECES]
572             & $self->[CP_POS_PAWNS]) {
573 66         151 ($pos_info = ($pos_info & ~(0x3f << 5)) | ($self->squareToShift($ep_square) << 5));
574             }
575             } elsif ($to_move == CP_BLACK && $ep_square =~ /^[a-h]3$/) {
576 49         173 my $ep_shift = $self->squareToShift($ep_square);
577 49 100       216 if ((1 << ($ep_shift + 8)) & $self->[CP_POS_WHITE_PIECES]
578             & $self->[CP_POS_PAWNS]) {
579 48         319 ($pos_info = ($pos_info & ~(0x3f << 5)) | ($self->squareToShift($ep_square) << 5));
580             }
581             }
582              
583 141245         223847 $self->[CP_POS_INFO] = $pos_info;
584              
585 141245 50       352618 if ($hmc !~ /^0|[1-9][0-9]*$/) {
586 0         0 $hmc = 0;
587             }
588 141245         295010 $self->[CP_POS_HALF_MOVE_CLOCK] = $self->[CP_POS_REVERSIBLE_CLOCK] = $hmc;
589              
590 141245 50       351384 if ($moveno !~ /^[1-9][0-9]*$/) {
591 0         0 $moveno = 1;
592             }
593              
594 141245 100       253064 if (((($self->[CP_POS_INFO] & (1 << 4)) >> 4)) == CP_WHITE) {
595 90726         142463 $self->[CP_POS_HALF_MOVES] = ($moveno - 1) << 1;
596             } else {
597 50519         89648 $self->[CP_POS_HALF_MOVES] = (($moveno - 1) << 1) + 1;
598             }
599              
600 141245         320372 $self->__updateZobristKey;
601 141245 100       148614 (do { my $c = (($pos_info & (1 << 4)) >> 4); my $kings = $self->[CP_POS_KINGS] & ($c ? $self->[CP_POS_BLACK_PIECES] : $self->[CP_POS_WHITE_PIECES]); my $king_shift = (do { my $A = $kings - 1 - ((($kings - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); ($pos_info = ($pos_info & ~(0x3f << 11)) | ($king_shift << 11)); my $checkers = $self->[CP_POS_IN_CHECK] = (do { my $her_color = !$c; my $her_pieces = $self->[CP_POS_WHITE_PIECES + $her_color]; my $occupancy = $self->[CP_POS_WHITE_PIECES + $c] | $her_pieces; my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$c]->[2]->[$king_shift] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$king_shift] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$king_shift] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$king_shift]) * CP_MAGICMOVES_B_MAGICS->[$king_shift]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$king_shift]) * CP_MAGICMOVES_R_MAGICS->[$king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));}); if ($checkers) { if ($checkers & ($checkers - 1)) { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_KING_MOVE << 17)); } elsif ($checkers & ($self->[CP_POS_KNIGHTS] | ($self->[CP_POS_PAWNS]))) { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_CAPTURE << 17)); $self->[CP_POS_EVASION_SQUARES] = $checkers; } else { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_ALL << 17)); my $piece_shift = (do { my $A = $checkers - 1 - ((($checkers - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); my ($attack_type, undef, $attack_ray) = @{$common_lines[$king_shift]->[$piece_shift]}; if ($attack_ray) { $self->[CP_POS_EVASION_SQUARES] = $attack_ray; } else { $self->[CP_POS_EVASION_SQUARES] = $checkers; } } } $self->[CP_POS_INFO] = $pos_info;});
  141245 100       168446  
  141245 100       244179  
  141245 100       158678  
  141245 100       185473  
  141245         182396  
  141245         160816  
  141245         172241  
  141245         157755  
  141245         190219  
  141245         187835  
  141245         148232  
  141245         194503  
  141245         188689  
  141245         165950  
  141245         156760  
  141245         749448  
  141245         236848  
  1485         4446  
  10         21  
  405         734  
  405         653  
  1070         1687  
  1070         1385  
  1070         1735  
  1070         1747  
  1070         1902  
  1070         1697  
  1070         1441  
  1070         1962  
  1070         1550  
  1070         3219  
  1070         2420  
  1059         1759  
  11         22  
  141245         170289  
602              
603 141245         562315 return $self;
604             }
605              
606             sub pseudoLegalMoves {
607 174517     174517 1 366625 my ($self) = @_;
608              
609 174517         274980 my $pos_info = $self->[CP_POS_INFO];
610 174517         256505 my $to_move = (($pos_info & (1 << 4)) >> 4);
611 174517         240989 my $my_pieces = $self->[CP_POS_WHITE_PIECES + $to_move];
612 174517         262110 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
613 174517         231332 my $occupancy = $my_pieces | $her_pieces;
614 174517         215282 my $empty = ~$occupancy;
615              
616 174517         234991 my (@moves, $target_mask, $base_move);
617              
618             # Generate king moves. We take advantage of the fact that there is always
619             # exactly one king of each color on the board. So there is no need for a
620             # loop.
621 174517         246754 my $king_mask = $my_pieces & $self->[CP_POS_KINGS];
622              
623 174517         205589 my $from = (do { my $A = $king_mask - 1 - ((($king_mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  174517         264839  
  174517         273909  
  174517         241073  
  174517         263217  
  174517         223194  
  174517         274002  
624              
625 174517         280838 $base_move = ($from << 6 | CP_KING << 15);
626              
627 174517         262455 $target_mask = ~$my_pieces & $king_attack_masks[$from];
628              
629 174517         330644 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  1095294         1114866  
  1095294         1159487  
  1095294         1237126  
  1095294         1257823  
  1095294         1155709  
  1095294         1222227  
  1095294         1169555  
  1095294         1338681  
  1095294         1612555  
630              
631 174517         263187 my $in_check = $self->[CP_POS_IN_CHECK];
632 174517 100 100     560797 return @moves if $in_check && CP_EVASION_KING_MOVE == (($pos_info & (0x3 << 17)) >> 17);
633              
634             # Generate castlings.
635             # Mask out the castling rights for the side to move.
636 172308         254583 my $castling_rights = ($pos_info >> ($to_move << 1)) & 0x3;
637 172308 100       291168 if ($castling_rights) {
638             my ($king_from, $king_from_mask, $king_side_crossing_mask,
639             $king_side_dest_shift,
640             $queen_side_crossing_mask, $queen_side_dest_shift,
641             $queen_side_rook_crossing_mask)
642 6410         7152 = @{$castling_aux_data[$to_move]};
  6410         14603  
643 6410 50       10940 if ($king_mask & $king_from_mask) {
644 6410 100 100     21526 if (($castling_rights & 0x1)
645             && !(((1 << $king_side_dest_shift) | $king_side_crossing_mask)
646             & $occupancy)) {
647 3116         5556 push @moves, ($king_from << 6 | CP_KING << 15)
648             | $king_side_dest_shift;
649             }
650 6410 100 100     20914 if (($castling_rights & 0x2)
651             && (!(($queen_side_crossing_mask
652             | $queen_side_rook_crossing_mask
653             | (1 << $queen_side_dest_shift))
654             & $occupancy))) {
655 3124         5336 push @moves, ($king_from << 6 | CP_KING << 15)
656             | $queen_side_dest_shift;
657             }
658             }
659             }
660              
661             # Generate knight moves.
662 172308         263516 my $knight_mask = $my_pieces & $self->[CP_POS_KNIGHTS];
663 172308         320704 while ($knight_mask) {
664 203259         217197 my $from = (do { my $B = $knight_mask & -$knight_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  203259         269633  
  203259         329201  
  203259         285035  
  203259         244621  
  203259         288062  
  203259         248726  
  203259         294964  
665              
666 203259         282179 $base_move = ($from << 6 | CP_KNIGHT << 15);
667            
668 203259         291962 $target_mask = ~$my_pieces & $knight_attack_masks[$from];
669              
670 203259         332503 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  879466         922053  
  879466         954495  
  879466         1025772  
  879466         999243  
  879466         948657  
  879466         1015677  
  879466         958614  
  879466         1120945  
  879466         1282468  
671              
672 203259         341796 $knight_mask = (($knight_mask) & (($knight_mask) - 1));
673             }
674              
675             # Generate bishop moves.
676 172308         268446 my $bishop_mask = $my_pieces & $self->[CP_POS_BISHOPS];
677 172308         319780 while ($bishop_mask) {
678 199290         250911 my $from = (do { my $B = $bishop_mask & -$bishop_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  199290         268443  
  199290         279454  
  199290         272738  
  199290         261186  
  199290         301371  
  199290         260218  
  199290         295512  
679              
680 199290         312492 $base_move = ($from << 6 | CP_BISHOP << 15);
681            
682 199290         454189 $target_mask = CP_MAGICMOVESBDB->[$from][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)] & ($empty | $her_pieces);
683              
684 199290         357440 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  833082         830127  
  833082         896290  
  833082         978438  
  833082         934219  
  833082         877453  
  833082         943643  
  833082         884185  
  833082         1045071  
  833082         1199454  
685              
686 199290         323330 $bishop_mask = (($bishop_mask) & (($bishop_mask) - 1));
687             }
688              
689             # Generate rook moves.
690 172308         258748 my $rook_mask = $my_pieces & $self->[CP_POS_ROOKS];
691 172308         306396 while ($rook_mask) {
692 125781         159706 my $from = (do { my $B = $rook_mask & -$rook_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  125781         166934  
  125781         178896  
  125781         185119  
  125781         158215  
  125781         165780  
  125781         166515  
  125781         169621  
693              
694 125781         166816 $base_move = ($from << 6 | CP_ROOK << 15);
695            
696 125781         285063 $target_mask = CP_MAGICMOVESRDB->[$from][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)] & ($empty | $her_pieces);
697              
698 125781         240962 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  891960         919461  
  891960         954819  
  891960         1004556  
  891960         1015346  
  891960         935305  
  891960         978091  
  891960         946880  
  891960         1082931  
  891960         1287641  
699              
700 125781         204961 $rook_mask = (($rook_mask) & (($rook_mask) - 1));
701             }
702              
703             # Generate queen moves.
704 172308         264675 my $queen_mask = $my_pieces & $self->[CP_POS_QUEENS];
705 172308         322766 while ($queen_mask) {
706 86096         107256 my $from = (do { my $B = $queen_mask & -$queen_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  86096         129082  
  86096         123801  
  86096         150853  
  86096         128041  
  86096         134832  
  86096         110252  
  86096         137760  
707              
708 86096         130964 $base_move = ($from << 6 | CP_QUEEN << 15);
709            
710 86096         289859 $target_mask =
711             (CP_MAGICMOVESRDB->[$from][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)]
712             | CP_MAGICMOVESBDB->[$from][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)])
713             & ($empty | $her_pieces);
714              
715 86096         162789 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  1003525         1017597  
  1003525         1046804  
  1003525         1115249  
  1003525         1071174  
  1003525         1033931  
  1003525         1074452  
  1003525         1046399  
  1003525         1205462  
  1003525         1405583  
716              
717 86096         149630 $queen_mask = (($queen_mask) & (($queen_mask) - 1));
718             }
719              
720             # Generate pawn moves.
721             my ($regular_mask, $double_mask, $promotion_mask, $offset) =
722 172308         223845 @{$pawn_aux_data[$to_move]};
  172308         414906  
723              
724             my ($pawn_single_masks, $pawn_double_masks, $pawn_capture_masks) =
725 172308         248649 @{$pawn_masks[$to_move]};
  172308         318174  
726              
727 172308         239615 my $pawns = $self->[CP_POS_PAWNS];
728              
729 172308         197000 my $pawn_mask;
730              
731 172308         245638 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
732 172308 100       276612 my $ep_target_mask = $ep_shift ? (1 << $ep_shift) : 0;
733              
734             # Pawn single steps and captures w/o promotions.
735 172308         242808 $pawn_mask = $my_pieces & $pawns & $regular_mask;
736 172308         306363 while ($pawn_mask) {
737 466800         482452 my $from = (do { my $B = $pawn_mask & -$pawn_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  466800         532324  
  466800         556222  
  466800         538352  
  466800         542780  
  466800         580204  
  466800         547038  
  466800         590963  
738              
739 466800         547253 $base_move = ($from << 6 | CP_PAWN << 15);
740 466800         678358 $target_mask = ($pawn_single_masks->[$from] & $empty)
741             | ($pawn_capture_masks->[$from] & ($her_pieces | $ep_target_mask));
742 466800         716039 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  363789         405677  
  363789         437841  
  363789         473681  
  363789         440956  
  363789         423722  
  363789         462313  
  363789         412515  
  363789         496998  
  363789         582134  
743 466800         733602 $pawn_mask = (($pawn_mask) & (($pawn_mask) - 1));
744             }
745              
746             # Pawn double steps.
747 172308         250428 $pawn_mask = $my_pieces & $pawns & $double_mask;
748 172308         325119 while ($pawn_mask) {
749 81534         92562 my $from = (do { my $B = $pawn_mask & -$pawn_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  81534         100687  
  81534         123665  
  81534         103375  
  81534         100373  
  81534         100507  
  81534         109232  
  81534         112971  
750 81534         105999 my $cross_mask = $pawn_single_masks->[$from] & $empty;
751              
752 81534 100       134160 if ($cross_mask) {
753 61896         85989 $target_mask = $pawn_double_masks->[$from] & $empty;
754 61896 100       97532 if ($target_mask) {
755 51651         61513 my $to = $from + ($offset << 1);
756 51651         74868 push @moves, ($from << 6) | $to | CP_PAWN << 15;
757             }
758             }
759 81534         139009 $pawn_mask = (($pawn_mask) & (($pawn_mask) - 1));
760             }
761              
762             # Pawn promotions including captures.
763 172308         258248 $pawn_mask = $my_pieces & $pawns & ~$regular_mask;
764 172308         315096 while ($pawn_mask) {
765 29951         37887 my $from = (do { my $B = $pawn_mask & -$pawn_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  29951         42062  
  29951         54059  
  29951         46037  
  29951         40501  
  29951         41769  
  29951         37886  
  29951         46801  
766              
767 29951         43640 $base_move = ($from << 6 | CP_PAWN << 15);
768 29951         50259 $target_mask = ($pawn_single_masks->[$from] & $empty)
769             | ($pawn_capture_masks->[$from] & ($her_pieces | $ep_target_mask));
770 29951         56676 while ($target_mask) { my $base_move = $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); push @moves, $base_move | (CP_QUEEN << 12), $base_move | (CP_ROOK << 12), $base_move | (CP_BISHOP << 12), $base_move | (CP_KNIGHT << 12); $target_mask = (($target_mask) & (($target_mask) - 1));};
  24634         28916  
  24634         30577  
  24634         40375  
  24634         37789  
  24634         33361  
  24634         38908  
  24634         35923  
  24634         39401  
  24634         48839  
  24634         40842  
771 29951         52627 $pawn_mask = (($pawn_mask) & (($pawn_mask) - 1));
772             }
773              
774 172308         1096480 return @moves;
775             }
776              
777             sub pseudoLegalAttacks {
778 189307     189307 1 270021 my ($self) = @_;
779              
780 189307         304940 my $pos_info = $self->[CP_POS_INFO];
781 189307         270662 my $to_move = (($pos_info & (1 << 4)) >> 4);
782 189307         277233 my $my_pieces = $self->[CP_POS_WHITE_PIECES + $to_move];
783 189307         298654 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
784 189307         270458 my $occupancy = $my_pieces | $her_pieces;
785 189307         254394 my $empty = ~$occupancy;
786              
787 189307         251000 my (@moves, $target_mask, $base_move);
788              
789             # Generate king moves. We take advantage of the fact that there is always
790             # exactly one king of each color on the board. So there is no need for a
791             # loop.
792 189307         261146 my $king_mask = $my_pieces & $self->[CP_POS_KINGS];
793              
794 189307         217304 my $from = (do { my $A = $king_mask - 1 - ((($king_mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  189307         280559  
  189307         278634  
  189307         242266  
  189307         317602  
  189307         266589  
  189307         296402  
795              
796 189307         281212 $base_move = ($from << 6 | CP_KING << 15);
797              
798 189307         260200 $target_mask = $her_pieces & $king_attack_masks[$from];
799              
800 189307         376399 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  137091         166810  
  137091         161704  
  137091         203172  
  137091         193376  
  137091         182679  
  137091         193276  
  137091         164781  
  137091         232425  
  137091         254352  
801              
802             # Generate knight moves.
803 189307         295960 my $knight_mask = $my_pieces & $self->[CP_POS_KNIGHTS];
804 189307         330670 while ($knight_mask) {
805 265072         279031 my $from = (do { my $B = $knight_mask & -$knight_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  265072         338327  
  265072         367862  
  265072         347111  
  265072         372190  
  265072         361526  
  265072         348344  
  265072         344062  
806              
807 265072         319110 $base_move = ($from << 6 | CP_KNIGHT << 15);
808            
809 265072         355115 $target_mask = $her_pieces & $knight_attack_masks[$from];
810              
811 265072         425773 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  142511         184426  
  142511         178682  
  142511         201423  
  142511         172413  
  142511         176842  
  142511         164130  
  142511         177359  
  142511         221397  
  142511         243800  
812              
813 265072         450169 $knight_mask = (($knight_mask) & (($knight_mask) - 1));
814             }
815              
816             # Generate bishop moves.
817 189307         262352 my $bishop_mask = $my_pieces & $self->[CP_POS_BISHOPS];
818 189307         328843 while ($bishop_mask) {
819 268774         292796 my $from = (do { my $B = $bishop_mask & -$bishop_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  268774         317306  
  268774         390961  
  268774         363342  
  268774         350292  
  268774         336687  
  268774         329959  
  268774         398354  
820              
821 268774         345542 $base_move = ($from << 6 | CP_BISHOP << 15);
822            
823 268774         564264 $target_mask = CP_MAGICMOVESBDB->[$from][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)] & $her_pieces;
824              
825 268774         438046 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  141385         177045  
  141385         164989  
  141385         219501  
  141385         199177  
  141385         184943  
  141385         196264  
  141385         180189  
  141385         211044  
  141385         253238  
826              
827 268774         435061 $bishop_mask = (($bishop_mask) & (($bishop_mask) - 1));
828             }
829              
830             # Generate rook moves.
831 189307         260298 my $rook_mask = $my_pieces & $self->[CP_POS_ROOKS];
832 189307         330594 while ($rook_mask) {
833 175107         194729 my $from = (do { my $B = $rook_mask & -$rook_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  175107         219263  
  175107         258334  
  175107         241820  
  175107         218089  
  175107         237378  
  175107         209659  
  175107         226458  
834              
835 175107         240477 $base_move = ($from << 6 | CP_ROOK << 15);
836            
837 175107         384239 $target_mask = CP_MAGICMOVESRDB->[$from][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)] & $her_pieces;
838              
839 175107         289741 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  159263         186502  
  159263         204486  
  159263         216368  
  159263         196071  
  159263         194609  
  159263         189973  
  159263         198064  
  159263         215274  
  159263         276546  
840              
841 175107         279294 $rook_mask = (($rook_mask) & (($rook_mask) - 1));
842             }
843              
844             # Generate queen moves.
845 189307         267852 my $queen_mask = $my_pieces & $self->[CP_POS_QUEENS];
846 189307         330761 while ($queen_mask) {
847 123955         146113 my $from = (do { my $B = $queen_mask & -$queen_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  123955         172876  
  123955         202823  
  123955         191066  
  123955         176362  
  123955         194389  
  123955         185012  
  123955         182460  
848              
849 123955         190717 $base_move = ($from << 6 | CP_QUEEN << 15);
850            
851 123955         376021 $target_mask =
852             (CP_MAGICMOVESRDB->[$from][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)]
853             | CP_MAGICMOVESBDB->[$from][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)])
854             & $her_pieces;
855              
856 123955         237442 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  192802         214148  
  192802         231923  
  192802         271121  
  192802         242290  
  192802         225201  
  192802         249064  
  192802         217898  
  192802         253861  
  192802         310998  
857              
858 123955         226957 $queen_mask = (($queen_mask) & (($queen_mask) - 1));
859             }
860              
861             # Generate pawn moves.
862             my ($regular_mask, $double_mask, $promotion_mask, $offset) =
863 189307         231427 @{$pawn_aux_data[$to_move]};
  189307         402217  
864              
865             my ($pawn_single_masks, $pawn_double_masks, $pawn_capture_masks) =
866 189307         247469 @{$pawn_masks[$to_move]};
  189307         332710  
867              
868 189307         257657 my $pawns = $self->[CP_POS_PAWNS];
869              
870 189307         215913 my $pawn_mask;
871              
872 189307         253923 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
873 189307 100       301104 my $ep_target_mask = $ep_shift ? (1 << $ep_shift) : 0;
874              
875             # Pawn captures w/o promotions.
876 189307         250807 $pawn_mask = $my_pieces & $pawns & $regular_mask;
877 189307         316610 while ($pawn_mask) {
878 496260         499483 my $from = (do { my $B = $pawn_mask & -$pawn_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  496260         567020  
  496260         611552  
  496260         653293  
  496260         562240  
  496260         564669  
  496260         536818  
  496260         622396  
879              
880 496260         617255 $base_move = ($from << 6 | CP_PAWN << 15);
881 496260         620385 $target_mask = ($pawn_capture_masks->[$from] & ($her_pieces | $ep_target_mask));
882 496260         741245 while ($target_mask) { push @moves, $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); $target_mask = (($target_mask) & (($target_mask) - 1));};
  63746         76378  
  63746         85636  
  63746         91294  
  63746         92338  
  63746         84259  
  63746         88822  
  63746         82288  
  63746         99867  
  63746         105521  
883 496260         787159 $pawn_mask = (($pawn_mask) & (($pawn_mask) - 1));
884             }
885              
886             # Pawn promotions including captures.
887 189307         325487 $pawn_mask = $my_pieces & $pawns & ~$regular_mask;
888 189307         330254 while ($pawn_mask) {
889 28675         42806 my $from = (do { my $B = $pawn_mask & -$pawn_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  28675         40321  
  28675         43245  
  28675         43303  
  28675         45098  
  28675         48621  
  28675         39271  
  28675         43752  
890              
891 28675         39207 $base_move = ($from << 6 | CP_PAWN << 15);
892 28675         54610 $target_mask = ($pawn_single_masks->[$from] & $empty)
893             | ($pawn_capture_masks->[$from] & ($her_pieces | $ep_target_mask));
894 28675         59875 while ($target_mask) { my $base_move = $base_move | (do { my $B = $target_mask & -$target_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); push @moves, $base_move | (CP_QUEEN << 12), $base_move | (CP_ROOK << 12), $base_move | (CP_BISHOP << 12), $base_move | (CP_KNIGHT << 12); $target_mask = (($target_mask) & (($target_mask) - 1));};
  21252         30491  
  21252         31651  
  21252         29211  
  21252         29196  
  21252         27079  
  21252         28422  
  21252         30219  
  21252         34910  
  21252         39445  
  21252         38312  
895 28675         49531 $pawn_mask = (($pawn_mask) & (($pawn_mask) - 1));
896             }
897              
898 189307         609711 return @moves;
899             }
900              
901             # FIXME! Make this a macro!
902             sub __update {
903 0     0   0 my ($self) = @_;
904              
905             # Update king's shift.
906 0         0 my $pos_info = $self->[CP_POS_INFO];
907              
908 0         0 $self->[CP_POS_INFO] = $pos_info;
909             }
910              
911             sub attacked {
912 16     16 1 68 my ($self, $shift) = @_;
913              
914 16         17 return (do { my $her_color = !((($self->[CP_POS_INFO] & (1 << 4)) >> 4)); my $her_pieces = $self->[CP_POS_WHITE_PIECES + $her_color]; my $occupancy = $self->[CP_POS_WHITE_PIECES + ((($self->[CP_POS_INFO] & (1 << 4)) >> 4))] | $her_pieces; my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[((($self->[CP_POS_INFO] & (1 << 4)) >> 4))]->[2]->[$shift] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$shift] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$shift] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$shift]) * CP_MAGICMOVES_B_MAGICS->[$shift]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$shift]) * CP_MAGICMOVES_R_MAGICS->[$shift]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));});
  16         27  
  16         23  
  16         20  
  16         92  
  16         114  
915             }
916              
917             sub moveAttacked {
918 3     3 1 1609 my ($self, $move) = @_;
919              
920 3 50       12 if ($move =~ /[a-z]/i) {
921 0 0       0 $move = $self->parseMove($move) or return;
922             }
923              
924 3         8 my ($from, $to) = ((($move >> 6) & 0x3f), (($move) & 0x3f));
925 3         4 return (do { my $my_color = ((($self->[CP_POS_INFO] & (1 << 4)) >> 4)); my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$my_color]; my $occupancy = ($self->[CP_POS_WHITE_PIECES + $my_color] | $her_pieces) & ~(1 << $from); my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$my_color]->[2]->[$to] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$to] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$to] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$to][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$to]) * CP_MAGICMOVES_B_MAGICS->[$to]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$to][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$to]) * CP_MAGICMOVES_R_MAGICS->[$to]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));});
  3         5  
  3         6  
  3         6  
  3         5  
  3         34  
926             }
927              
928             sub moveGivesCheck {
929 24     24 0 14673 my ($self, $move) = @_;
930              
931             # FIXME! Check that all of these variables are really needed at least twice!
932 24         56 my $pos_info = $self->[CP_POS_INFO];
933 24         53 my $from = (($move >> 6) & 0x3f);
934 24         47 my $from_mask = 1 << $from;
935 24         37 my $to = (($move) & 0x3f);
936 24         38 my $to_mask = 1 << $to;
937              
938 24         32 my $piece = (($move >> 15) & 0x7);
939 24         41 my $to_move = (($pos_info & (1 << 4)) >> 4);
940 24         47 my $my_pieces = $self->[CP_POS_WHITE_PIECES + $to_move];
941 24         49 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
942 24         45 my $her_king_mask = $self->[CP_POS_KINGS] & $her_pieces;
943 24         37 my $her_king_shift = (do { my $A = $her_king_mask - 1 - ((($her_king_mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  24         45  
  24         61  
  24         42  
  24         39  
  24         36  
  24         44  
944 24         53 my $occupancy = $self->[CP_POS_WHITE_PIECES] | $self->[CP_POS_BLACK_PIECES];
945 24         52 my $bsliders = $my_pieces
946             & ($self->[CP_POS_BISHOPS] | $self->[CP_POS_QUEENS]);
947 24         33 my $rsliders = $my_pieces
948             & ($self->[CP_POS_ROOKS] | $self->[CP_POS_QUEENS]);
949 24         35 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
950 24 100 100     101 if ($piece == CP_PAWN && $ep_shift && $to == $ep_shift) {
      66        
951             # Remove the captured piece, as well.
952 1         2 $from_mask |= $ep_pawn_masks[$ep_shift];
953             }
954              
955 24 100 100     460 if (($piece == CP_PAWN)
    100 100        
    100 66        
    100 100        
    100 66        
    100 100        
    100 66        
      100        
956             && ($to_mask & $pawn_masks[!$to_move]->[2]->[$her_king_shift])) {
957 2         15 return 1;
958             } elsif (($piece == CP_KNIGHT)
959             && ($to_mask & $knight_attack_masks[$her_king_shift])) {
960             # Direct knight check.
961 2         14 return 1;
962             } elsif (($piece == CP_BISHOP || $piece == CP_QUEEN)
963             && (CP_MAGICMOVESBDB->[$her_king_shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$her_king_shift]) * CP_MAGICMOVES_B_MAGICS->[$her_king_shift]) >> 55) & ((1 << (64 - 55)) - 1)] & $to_mask)) {
964             # Direct bishop/queen check.
965 2         13 return 1;
966             } elsif (($piece == CP_ROOK || $piece == CP_QUEEN)
967             && (CP_MAGICMOVESRDB->[$her_king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$her_king_shift]) * CP_MAGICMOVES_R_MAGICS->[$her_king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & $to_mask)) {
968             # Direct rook/queen check.
969 2         15 return 1;
970             } elsif ($piece == CP_KING && ((($from - $to) & 0x3) == 0x2)
971             && (CP_MAGICMOVESRDB->[$her_king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$her_king_shift]) * CP_MAGICMOVES_R_MAGICS->[$her_king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & $castling_rook_to_mask[$to])) {
972 4         19 return 1;
973             } elsif (CP_MAGICMOVESBDB->[$her_king_shift][(((($occupancy ^ $from_mask) & CP_MAGICMOVES_B_MASK->[$her_king_shift]) * CP_MAGICMOVES_B_MAGICS->[$her_king_shift]) >> 55) & ((1 << (64 - 55)) - 1)]
974             & (($my_pieces & ($self->[CP_POS_BISHOPS] | $self->[CP_POS_QUEENS]) & ~$from_mask))) {
975 1         7 return 1;
976             } elsif (CP_MAGICMOVESRDB->[$her_king_shift][(((($occupancy ^ $from_mask) & CP_MAGICMOVES_R_MASK->[$her_king_shift]) * CP_MAGICMOVES_R_MAGICS->[$her_king_shift]) >> 52) & ((1 << (64 - 52)) - 1)]
977             & (($my_pieces & ($self->[CP_POS_ROOKS] | $self->[CP_POS_QUEENS]) & ~$from_mask))) {
978 3         16 return 1;
979             }
980              
981 8         54 return;
982             }
983              
984             sub movePinned {
985 14     14 1 4130 my ($self, $move) = @_;
986              
987 14 50       53 if ($move =~ /[a-z]/i) {
988 0 0       0 $move = $self->parseMove($move) or return;
989             }
990              
991 14         27 my $to_move = ((($self->[CP_POS_INFO] & (1 << 4)) >> 4));
992 14         18 my $my_pieces = $self->[CP_POS_WHITE_PIECES + $to_move];
993 14         19 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
994 14         25 my ($from, $to) = ((($move >> 6) & 0x3f), (($move) & 0x3f));
995              
996 14 100 33     15 return ( do { my $pinned; my $king_ray = $common_lines[$from]->[((($self->[CP_POS_INFO] & (0x3f << 11)) >> 11))]; if ($king_ray) { my ($is_rook, $ray_mask) = @$king_ray; if (!((1 << $to) & $ray_mask)) { if ($is_rook) { my $rmagic = CP_MAGICMOVESRDB->[$from][((((($my_pieces | $her_pieces)) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)] & $ray_mask; $pinned = ($rmagic & (1 << ((($self->[CP_POS_INFO] & (0x3f << 11)) >> 11)))) && ($rmagic & $her_pieces & ($self->[CP_POS_QUEENS] | $self->[CP_POS_ROOKS])); } else { my $bmagic = CP_MAGICMOVESBDB->[$from][((((($my_pieces | $her_pieces)) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)] & $ray_mask; $pinned = ($bmagic & (1 << ((($self->[CP_POS_INFO] & (0x3f << 11)) >> 11)))) && ($bmagic & $her_pieces & ($self->[CP_POS_QUEENS] | $self->[CP_POS_BISHOPS])); } } } $pinned;});
  14 100 66     14  
  14 50       30  
  14         24  
  14         24  
  14         30  
  6         9  
  2         8  
  2         64  
  4         13  
  4         20  
  14         44  
997             }
998              
999             sub moveEquivalent {
1000 273     273 1 346 my ($self, $m1, $m2) = @_;
1001              
1002 273         686 return (($m1 & 0x7fff) == ($m2 & 0x7fff));
1003             }
1004              
1005             sub moveSignificant {
1006 0     0 1 0 my ($self, $move) = @_;
1007              
1008 0         0 return ($move & 0x7fff);
1009             }
1010              
1011             sub doMove {
1012 3988173     3988173 1 4839389 my ($self, $move) = @_;
1013              
1014 3988173         4556166 my $pos_info = $self->[CP_POS_INFO];
1015 3988173         6163273 my ($from, $to, $promote, $piece) =
1016             ((($move >> 6) & 0x3f), (($move) & 0x3f), (($move >> 12) & 0x7),
1017             (($move >> 15) & 0x7));
1018              
1019 3988173         4551503 my $to_move = (($pos_info & (1 << 4)) >> 4);
1020 3988173         4478046 my $from_mask = 1 << $from;
1021 3988173         4349501 my $to_mask = 1 << $to;
1022 3988173         4401230 my $move_mask = (1 << $from) | $to_mask;
1023 3988173         4480153 my $king_shift = (($pos_info & (0x3f << 11)) >> 11);
1024 3988173         4872949 my $my_pieces = $self->[CP_POS_WHITE_PIECES + $to_move];
1025 3988173         4614552 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
1026              
1027             # A move can be illegal for these reasons:
1028             #
1029             # 1. The moving piece is pinned by a sliding piece and would expose our
1030             # king to check.
1031             # 2. The king moves into check.
1032             # 3. The king crosses an attacked square while castling.
1033             # 4. A pawn captured en passant discovers a check.
1034             #
1035             # Checks number two and three are done below, and only for king moves.
1036             # Check number 4 is done below for en passant moves.
1037 3988173 100 100     4093726 return if ( do { my $pinned; my $king_ray = $common_lines[$from]->[$king_shift]; if ($king_ray) { my ($is_rook, $ray_mask) = @$king_ray; if (!((1 << $to) & $ray_mask)) { if ($is_rook) { my $rmagic = CP_MAGICMOVESRDB->[$from][((((($my_pieces | $her_pieces)) & CP_MAGICMOVES_R_MASK->[$from]) * CP_MAGICMOVES_R_MAGICS->[$from]) >> 52) & ((1 << (64 - 52)) - 1)] & $ray_mask; $pinned = ($rmagic & (1 << $king_shift)) && ($rmagic & $her_pieces & ($self->[CP_POS_QUEENS] | $self->[CP_POS_ROOKS])); } else { my $bmagic = CP_MAGICMOVESBDB->[$from][((((($my_pieces | $her_pieces)) & CP_MAGICMOVES_B_MASK->[$from]) * CP_MAGICMOVES_B_MAGICS->[$from]) >> 55) & ((1 << (64 - 55)) - 1)] & $ray_mask; $pinned = ($bmagic & (1 << $king_shift)) && ($bmagic & $her_pieces & ($self->[CP_POS_QUEENS] | $self->[CP_POS_BISHOPS])); } } } $pinned;});
  3988173 100 100     3971397  
  3988173 100       5486096  
  3988173 100       5863407  
  3958611         5049737  
  3958611         6684961  
  3530123         4502799  
  631782         1154861  
  631782         1512642  
  2898341         4900068  
  2898341         5220580  
  3988173         6502544  
1038              
1039 3907095         4934313 my $old_castling = my $new_castling = $pos_info & 0xf;
1040 3907095         4427221 my $in_check = $self->[CP_POS_IN_CHECK];
1041 3907095         4175880 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
1042 3907095 100       5084063 my $zk_update = $ep_shift ? ($zk_ep_files[$ep_shift & 0x7]) : 0;
1043              
1044 3907095 100       6402238 if ($piece == CP_KING) {
    100          
1045             # Does the king move into check?
1046 945437 100       965502 return if (do { my $my_color = ((($self->[CP_POS_INFO] & (1 << 4)) >> 4)); my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$my_color]; my $occupancy = ($self->[CP_POS_WHITE_PIECES + $my_color] | $her_pieces) & ~(1 << $from); my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$my_color]->[2]->[$to] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$to] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$to] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$to][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$to]) * CP_MAGICMOVES_B_MAGICS->[$to]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$to][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$to]) * CP_MAGICMOVES_R_MAGICS->[$to]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));});
  945437         1134907  
  945437         1191069  
  945437         1276039  
  945437         1023897  
  945437         5299865  
1047              
1048             # Castling?
1049 330029 100       626224 if ((($from - $to) & 0x3) == 0x2) {
1050             # Are we checked?
1051 5272 100       8535 return if $in_check;
1052              
1053             # Is the field that the king has to cross attacked?
1054 5270 100       6337 return if (do { my $her_color = !$to_move; my $her_pieces = $self->[CP_POS_WHITE_PIECES + $her_color]; my $occupancy = $self->[CP_POS_WHITE_PIECES + $to_move] | $her_pieces; my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$to_move]->[2]->[($from + $to) >> 1] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[($from + $to) >> 1] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[($from + $to) >> 1] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[($from + $to) >> 1][(((($occupancy) & CP_MAGICMOVES_B_MASK->[($from + $to) >> 1]) * CP_MAGICMOVES_B_MAGICS->[($from + $to) >> 1]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[($from + $to) >> 1][(((($occupancy) & CP_MAGICMOVES_R_MASK->[($from + $to) >> 1]) * CP_MAGICMOVES_R_MAGICS->[($from + $to) >> 1]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));});
  5270         6905  
  5270         7177  
  5270         7486  
  5270         6710  
  5270         28817  
1055              
1056             # The move is legal. Move the rook.
1057 4712         6484 my $rook_move_mask = $castling_rook_move_masks[$to];
1058 4712         5415 $self->[CP_POS_ROOKS] ^= $rook_move_mask;
1059 4712         6376 $self->[CP_POS_WHITE_PIECES + $to_move] ^= $rook_move_mask;
1060             }
1061              
1062             # Remove the castling rights.
1063 329469         520697 $new_castling &= ~(0x3 << ($to_move << 1));
1064             } elsif ($in_check) {
1065             # Early exits for check. First handle the case that the piece is
1066             # a pawn that gets captured en passant.
1067 1050365 100       1524782 if (!($self->[CP_POS_EVASION_SQUARES] & $to_mask)) {
1068             # Exception: En passant capture if the capture pawn is the one
1069             # that gives check.
1070 1006873 100 100     1586263 if (!($piece == CP_PAWN && $to == $ep_shift
      66        
1071             && ($ep_pawn_masks[$ep_shift] & $in_check))) {
1072 1006807         2999864 return;
1073             }
1074             }
1075             }
1076              
1077             # Remove castling rights if a rook moves from its original square or it
1078             # gets captured. We simplify that by simply checking whether either the
1079             # start or the destination square is a1, h1, a8, or h8.
1080 2284320         2798710 $new_castling &= $castling_rights_rook_masks[$from];
1081 2284320         2517361 $new_castling &= $castling_rights_rook_masks[$to];
1082              
1083 2284320         4532185 my @state = @$self[CP_POS_HALF_MOVE_CLOCK .. CP_POS_IN_CHECK];
1084              
1085 2284320         2885269 my ($captured, $zk_captured) = (CP_NO_PIECE, CP_NO_PIECE);
1086 2284320         2397746 my $captured_mask = 0;
1087 2284320 100       3400409 if ($to_mask & $her_pieces) {
1088 1329643 100       2572320 if ($to_mask & $self->[CP_POS_PAWNS]) {
    100          
    100          
    100          
1089 529891         665430 $captured = $zk_captured = CP_PAWN;
1090             } elsif ($to_mask & $self->[CP_POS_KNIGHTS]) {
1091 307614         398398 $captured = $zk_captured = CP_KNIGHT;
1092             } elsif ($to_mask & $self->[CP_POS_BISHOPS]) {
1093 252568         358854 $captured = $zk_captured = CP_BISHOP;
1094             } elsif ($to_mask & $self->[CP_POS_ROOKS]) {
1095 152835         183680 $captured = $zk_captured = CP_ROOK;
1096             } else {
1097 86735         125851 $captured = $zk_captured = CP_QUEEN;
1098             }
1099 1329643         1470714 $captured_mask = 1 << $to;
1100             }
1101              
1102 2284320 100       4151380 if ($piece == CP_PAWN) {
    100          
    100          
1103             # Check en passant.
1104 376229 100 100     685358 if ($ep_shift && $to == $ep_shift) {
1105 636         1216 $captured_mask = $ep_pawn_masks[$ep_shift];
1106              
1107             # Removing the pawn may discover a check.
1108 636         1485 my $occupancy = ($self->[CP_POS_WHITE_PIECES] | $self->[CP_POS_BLACK_PIECES])
1109             & ((~$move_mask) ^ $captured_mask);
1110 636 50       4465 if (CP_MAGICMOVESBDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$king_shift]) * CP_MAGICMOVES_B_MAGICS->[$king_shift]) >> 55) & ((1 << (64 - 55)) - 1)] & $her_pieces
    100          
1111             & ($self->[CP_POS_BISHOPS] | $self->[CP_POS_QUEENS])) {
1112 0         0 return;
1113             } elsif (CP_MAGICMOVESRDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$king_shift]) * CP_MAGICMOVES_R_MAGICS->[$king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & $her_pieces
1114             & ($self->[CP_POS_ROOKS] | $self->[CP_POS_QUEENS])) {
1115 60         261 return;
1116             }
1117            
1118 576         1023 $captured = CP_PAWN;
1119 576         752 $zk_captured = CP_KING; # This is interpreted as an ep capture.
1120             }
1121 376169         513167 $self->[CP_POS_HALF_MOVE_CLOCK]
1122             = $self->[CP_POS_REVERSIBLE_CLOCK] = 0;
1123 376169 100       579669 if ((!(($to - $from) & 0x9))) {
1124 34260         48905 ($pos_info = ($pos_info & ~(0x3f << 5)) | (($from + (($to - $from) >> 1)) << 5));
1125             } else {
1126 341909         432876 ($pos_info = ($pos_info & ~(0x3f << 5)) | (0 << 5));
1127             }
1128             } elsif ($her_pieces & $to_mask) {
1129             # No need to check for en passant because pawn moves reset the
1130             # half-move clock anyway.
1131 1169739         1580137 $self->[CP_POS_HALF_MOVE_CLOCK]
1132             = $self->[CP_POS_REVERSIBLE_CLOCK] = 0;
1133 1169739         1475701 ($pos_info = ($pos_info & ~(0x3f << 5)) | (0 << 5));
1134             } elsif ($old_castling != $new_castling) {
1135 47743         56330 $self->[CP_POS_REVERSIBLE_CLOCK] = 0;
1136 47743         55424 ++$self->[CP_POS_HALF_MOVE_CLOCK];
1137 47743         55369 ($pos_info = ($pos_info & ~(0x3f << 5)) | (0 << 5));
1138             } else {
1139 690609         837556 ++$self->[CP_POS_HALF_MOVE_CLOCK];
1140 690609         732112 ++$self->[CP_POS_REVERSIBLE_CLOCK];
1141 690609         877132 ($pos_info = ($pos_info & ~(0x3f << 5)) | (0 << 5));
1142             }
1143              
1144             # Move all pieces involved.
1145 2284260 100       3628752 if ($captured != CP_NO_PIECE) {
1146 1330219         1766646 $self->[CP_POS_WHITE_PIECES + !$to_move] ^= $captured_mask;
1147 1330219         1502910 $self->[$captured] ^= $captured_mask;
1148 1330219         1844771 (($move) = (($move) & ~0x1c0000) | (($captured) & 0x7) << 18);
1149             }
1150              
1151 2284260         2726336 $self->[CP_POS_WHITE_PIECES + $to_move] ^= $move_mask;
1152 2284260         2622623 $self->[$piece] ^= $move_mask;
1153              
1154             # It is better to overwrite the castling rights unconditionally because
1155             # it safes branches. There is one edge case, where a pawn captures a
1156             # rook that is on its initial position. In that case, the castling
1157             # rights may have to be updated.
1158 2284260         2688060 ($pos_info = ($pos_info & ~0xf) | $new_castling);
1159              
1160 2284260 100       3475404 if ($promote) {
1161 129574         147458 $self->[CP_POS_PAWNS] ^= $to_mask;
1162 129574         158619 $self->[$promote] ^= $to_mask;
1163             }
1164              
1165 2284260         2838258 (($move) = (($move) & ~0x20_0000) | (($to_move) & 0x1) << 21);
1166 2284260         4562661 my @undo_info = ($move, $captured_mask, @state);
1167              
1168 2284260         2696112 ++$self->[CP_POS_HALF_MOVES];
1169 2284260         2749100 ($pos_info = ($pos_info & ~(1 << 4)) | (!$to_move << 4));
1170              
1171             # The material balance is stored in the most signicant bits. It is
1172             # already left-shifted 19 bit in the lookup table so that we can
1173             # simply add it.
1174 2284260         2941767 $pos_info += $material_deltas[$to_move | ($promote << 1) | ($captured << 4)];
1175              
1176 2284260         2586982 my $signature = $state[CP_POS_SIGNATURE - CP_POS_HALF_MOVE_CLOCK];
1177              
1178 2284260 100       3363204 if ($old_castling != $new_castling) {
1179 50314         62744 $zk_update ^= $zk_castling[$old_castling]
1180             ^ $zk_castling[$new_castling];
1181             }
1182              
1183             # For the signature lookup we have to replace the real captured piece
1184             # because it may be a king which is interpreted as a pawn captured en
1185             # passant.
1186 2284260         3643947 $signature ^= $zk_update
1187             ^ $zk_move_masks[($zk_captured << 18) | ($move & 0x23_ffff)];
1188              
1189 2284260         2652373 $self->[CP_POS_SIGNATURE] = $signature;
1190              
1191 2284260 100       2439687 (do { my $c = (($pos_info & (1 << 4)) >> 4); my $kings = $self->[CP_POS_KINGS] & ($c ? $self->[CP_POS_BLACK_PIECES] : $self->[CP_POS_WHITE_PIECES]); my $king_shift = (do { my $A = $kings - 1 - ((($kings - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); ($pos_info = ($pos_info & ~(0x3f << 11)) | ($king_shift << 11)); my $checkers = $self->[CP_POS_IN_CHECK] = (do { my $her_color = !$c; my $her_pieces = $self->[CP_POS_WHITE_PIECES + $her_color]; my $occupancy = $self->[CP_POS_WHITE_PIECES + $c] | $her_pieces; my $queens = $self->[CP_POS_QUEENS]; $her_pieces & (($pawn_masks[$c]->[2]->[$king_shift] & $self->[CP_POS_PAWNS]) | ($knight_attack_masks[$king_shift] & $self->[CP_POS_KNIGHTS]) | ($king_attack_masks[$king_shift] & $self->[CP_POS_KINGS]) | (CP_MAGICMOVESBDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$king_shift]) * CP_MAGICMOVES_B_MAGICS->[$king_shift]) >> 55) & ((1 << (64 - 55)) - 1)] & ($queens | $self->[CP_POS_BISHOPS])) | (CP_MAGICMOVESRDB->[$king_shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$king_shift]) * CP_MAGICMOVES_R_MAGICS->[$king_shift]) >> 52) & ((1 << (64 - 52)) - 1)] & ($queens | $self->[CP_POS_ROOKS])));}); if ($checkers) { if ($checkers & ($checkers - 1)) { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_KING_MOVE << 17)); } elsif ($checkers & ($self->[CP_POS_KNIGHTS] | ($self->[CP_POS_PAWNS]))) { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_CAPTURE << 17)); $self->[CP_POS_EVASION_SQUARES] = $checkers; } else { ($pos_info = ($pos_info & ~(0x3 << 17)) | (CP_EVASION_ALL << 17)); my $piece_shift = (do { my $A = $checkers - 1 - ((($checkers - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);}); my ($attack_type, undef, $attack_ray) = @{$common_lines[$king_shift]->[$piece_shift]}; if ($attack_ray) { $self->[CP_POS_EVASION_SQUARES] = $attack_ray; } else { $self->[CP_POS_EVASION_SQUARES] = $checkers; } } } $self->[CP_POS_INFO] = $pos_info;});
  2284260 100       2673871  
  2284260 100       3434941  
  2284260 100       2555519  
  2284260 100       2999651  
  2284260         2767526  
  2284260         2529977  
  2284260         2696990  
  2284260         2532054  
  2284260         3086463  
  2284260         2922471  
  2284260         2333228  
  2284260         2767271  
  2284260         2977183  
  2284260         2710649  
  2284260         2544266  
  2284260         7749973  
  2284260         3356399  
  311371         678608  
  6211         9748  
  42694         68329  
  42694         59532  
  262466         353278  
  262466         322193  
  262466         360835  
  262466         329165  
  262466         318798  
  262466         356262  
  262466         305037  
  262466         401075  
  262466         323928  
  262466         607014  
  262466         440610  
  262033         358658  
  433         860  
  2284260         2716419  
1192              
1193 2284260         6990774 return \@undo_info;
1194             }
1195              
1196             sub undoMove {
1197 2091390     2091390 1 3166328 my ($self, $undo_info) = @_;
1198              
1199 2091390         4075697 my ($move, $captured_mask, @state) = @$undo_info;
1200              
1201 2091390         3502582 my ($from, $to, $promote, $piece, $captured) =
1202             ((($move >> 6) & 0x3f), (($move) & 0x3f), (($move >> 12) & 0x7),
1203             (($move >> 15) & 0x7), (($move >> 18) & 0x7));
1204              
1205 2091390         2741881 my $move_mask = (1 << $from) | (1 << $to);
1206 2091390         2876154 my $to_move = !((($self->[CP_POS_INFO] & (1 << 4)) >> 4));
1207              
1208             # Castling?
1209 2091390 100 100     3962699 if ($piece == CP_KING && ((($from - $to) & 0x3) == 0x2)) {
1210             # Restore the rook.
1211 2427         3090 my $rook_move_mask = $castling_rook_move_masks[$to];
1212              
1213 2427         3276 $self->[CP_POS_WHITE_PIECES + $to_move] ^= $rook_move_mask;
1214 2427         3079 $self->[CP_POS_ROOKS] ^= $rook_move_mask;
1215             }
1216              
1217 2091390         2587544 $self->[CP_POS_WHITE_PIECES + $to_move ] ^= $move_mask;
1218              
1219 2091390 100       2914372 if ($promote) {
1220 124690         148403 my $remove_mask = 1 << $to;
1221 124690         148777 $self->[CP_POS_PAWNS] |= 1 << $from;
1222 124690         156654 $self->[$promote] ^= $remove_mask;
1223             } else {
1224 1966700         2232802 $self->[$piece] ^= $move_mask;
1225             }
1226              
1227 2091390 100       2956391 if ($captured) {
1228 1314065         1784416 $self->[CP_POS_WHITE_PIECES + !$to_move] |= $captured_mask;
1229 1314065         1518638 $self->[$captured] |= $captured_mask;
1230             }
1231              
1232 2091390         3830798 @$self[CP_POS_HALF_MOVE_CLOCK .. CP_POS_IN_CHECK] = @state;
1233              
1234             # FIXME! Copy as well?
1235 2091390         3947909 --($self->[CP_POS_HALF_MOVES]);
1236             }
1237              
1238             sub bMagic {
1239 0     0 1 0 my ($self, $shift, $occupancy) = @_;
1240              
1241 0         0 return CP_MAGICMOVESBDB->[$shift][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$shift]) * CP_MAGICMOVES_B_MAGICS->[$shift]) >> 55) & ((1 << (64 - 55)) - 1)];
1242             }
1243              
1244             sub rMagic {
1245 0     0 1 0 my ($self, $shift, $occupancy) = @_;
1246              
1247 0         0 return CP_MAGICMOVESRDB->[$shift][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$shift]) * CP_MAGICMOVES_R_MAGICS->[$shift]) >> 52) & ((1 << (64 - 52)) - 1)];
1248             }
1249              
1250             # Position info methods.
1251             sub castlingRights {
1252 4424     4424 1 6018 my ($self) = @_;
1253              
1254 4424         6215 return ($self->[CP_POS_INFO] & 0xf);
1255             }
1256              
1257             sub whiteKingSideCastlingRight {
1258 0     0 1 0 my ($self) = @_;
1259              
1260 0         0 return ($self->[CP_POS_INFO] & (1 << 0));
1261             }
1262              
1263             sub whiteQueenSideCastlingRight {
1264 0     0 1 0 my ($self) = @_;
1265              
1266 0         0 return ($self->[CP_POS_INFO] & (1 << 1));
1267             }
1268              
1269             sub blackKingSideCastlingRight {
1270 0     0 1 0 my ($self) = @_;
1271              
1272 0         0 return ($self->[CP_POS_INFO] & (1 << 2));
1273             }
1274              
1275             sub blackQueenSideCastlingRight {
1276 0     0 1 0 my ($self) = @_;
1277              
1278 0         0 return ($self->[CP_POS_INFO] & (1 << 3));
1279             }
1280              
1281             sub toMove {
1282 7840     7840 1 293517 my ($self) = @_;
1283              
1284 7840         17534 return ((($self->[CP_POS_INFO] & (1 << 4)) >> 4));
1285             }
1286              
1287             sub enPassantShift {
1288 5229     5229 1 7171 my ($self) = @_;
1289              
1290 5229         10686 return ((($self->[CP_POS_INFO] & (0x3f << 5)) >> 5));
1291             }
1292              
1293             sub kingShift {
1294 4     4 1 795 my ($self) = @_;
1295              
1296 4         23 return ((($self->[CP_POS_INFO] & (0x3f << 11)) >> 11));
1297             }
1298              
1299             sub evasion {
1300 0     0 1 0 my ($self) = @_;
1301              
1302 0         0 return ((($self->[CP_POS_INFO] & (0x3 << 17)) >> 17));
1303             }
1304              
1305             sub material {
1306 0     0 1 0 my ($self) = @_;
1307              
1308 0         0 return (($self->[CP_POS_INFO] >> 19));
1309             }
1310              
1311             # Move methods.
1312             sub moveFrom {
1313 2268155     2268155 1 2428757 my (undef, $move) = @_;
1314              
1315 2268155         2900356 return (($move >> 6) & 0x3f);
1316             }
1317              
1318             sub moveSetFrom {
1319 0     0 1 0 my (undef, $move, $from) = @_;
1320              
1321 0         0 (($move) = (($move) & ~0xfc0) | (($from) & 0x3f) << 6);
1322              
1323 0         0 return $move;
1324             }
1325              
1326             sub moveTo {
1327 2268155     2268155 1 2507210 my (undef, $move) = @_;
1328              
1329 2268155         2951143 return (($move) & 0x3f);
1330             }
1331              
1332             sub moveSetTo {
1333 0     0 1 0 my (undef, $move, $to) = @_;
1334              
1335 0         0 (($move) = (($move) & ~0xfc0) | (($to) & 0x3f) << 6);
1336              
1337 0         0 return $move;
1338             }
1339              
1340             sub movePromote {
1341 2267847     2267847 1 2402378 my (undef, $move) = @_;
1342              
1343 2267847         2873555 return (($move >> 12) & 0x7);
1344             }
1345              
1346             sub moveSetPromote {
1347 327     327 1 364 my (undef, $move, $promote) = @_;
1348              
1349 327         401 (($move) = (($move) & ~0x7000) | (($promote) & 0x7) << 12);
1350              
1351 327         473 return $move;
1352             }
1353              
1354             sub movePiece {
1355 2267834     2267834 1 2418248 my (undef, $move) = @_;
1356              
1357 2267834         3057254 return (($move >> 15) & 0x7);
1358             }
1359              
1360             sub moveSetPiece {
1361 0     0 1 0 my (undef, $move, $piece) = @_;
1362              
1363 0         0 (($move) = (($move) & ~0x38000) | (($piece) & 0x7) << 15);
1364              
1365 0         0 return $move;
1366             }
1367              
1368             sub moveCaptured {
1369 17     17 1 55 my (undef, $move) = @_;
1370              
1371 17         105 return (($move >> 18) & 0x7);
1372             }
1373              
1374             sub moveSetCaptured {
1375 0     0 1 0 my (undef, $move, $piece) = @_;
1376              
1377 0         0 (($move) = (($move) & ~0x1c0000) | (($piece) & 0x7) << 18);
1378              
1379 0         0 return $move;
1380             }
1381              
1382             sub moveColor {
1383 17     17 1 48 my (undef, $move) = @_;
1384              
1385 17         85 return (($move >> 21) & 0x1);
1386             }
1387              
1388             sub moveSetColor {
1389 0     0 1 0 my (undef, $move, $color) = @_;
1390              
1391 0         0 (($move) = (($move) & ~0x20_0000) | (($color) & 0x1) << 21);
1392              
1393 0         0 return $move;
1394             }
1395              
1396             sub moveCoordinateNotation {
1397 51936     51936 1 62444 my (undef, $move) = @_;
1398              
1399 51936         157974 return chr(97 + ((($move >> 6) & 0x3f) & 0x7)) . (1 + ((($move >> 6) & 0x3f) >> 3)) . chr(97 + ((($move) & 0x3f) & 0x7)) . (1 + ((($move) & 0x3f) >> 3)) . CP_PIECE_CHARS->[CP_BLACK]->[(($move >> 12) & 0x7)];
1400             }
1401              
1402             sub LAN {
1403 0     0 1 0 &moveCoordinateNotation;
1404             }
1405              
1406             sub SEE {
1407 1091971     1091971 1 1460655 my ($self, $move) = @_;
1408              
1409 1091971         1381730 my $to = (($move) & 0x3f);
1410 1091971         1308305 my $from = (($move >> 6) & 0x3f);
1411 1091971         1265861 my $not_from_mask = ~(1 << ($from));
1412 1091971         1245709 my $pos_info = $self->[CP_POS_INFO];
1413 1091971         1313144 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
1414 1091971   100     1928887 my $move_is_ep = ($ep_shift && $to == $ep_shift
1415             && (($move >> 15) & 0x7) == CP_PAWN);
1416 1091971         1168830 my $white = $self->[CP_POS_WHITE_PIECES];
1417 1091971         1157610 my $black = $self->[CP_POS_BLACK_PIECES];
1418 1091971         1214203 my $occupancy = $white | $black;
1419              
1420             # FIXME! This is possible without a branch.
1421 1091971 100       1557912 if ($move_is_ep) {
1422 7         19 $occupancy &= ~$ep_pawn_masks[$to];
1423             }
1424              
1425 1091971         1256439 my $to_mask = 1 << $to;
1426 1091971         1278163 my $maybe_promote = $to_mask & (CP_1_MASK | CP_8_MASK);
1427 1091971 100       1591081 my $shifted_pawn_value = ($maybe_promote
1428             ? CP_QUEEN_VALUE - CP_PAWN_VALUE
1429             : CP_PAWN_VALUE) << 8;
1430              
1431 1091971         1248424 my (@white_attackers, @black_attackers, $mask);
1432              
1433             # Now generate all squares that are attacking the target square. This is
1434             # done in order of piece value. We silently assume here this relationship:
1435             #
1436             # P < N <= B < R < Q (< K)
1437             #
1438             # But this does not seem to be any restriction.
1439             #
1440             # For each attack vector we store the piece value shifted 8 bits to the
1441             # right ORed with the from shift.
1442              
1443 1091971         1226719 my $pawns = $self->[CP_POS_PAWNS];
1444             # We have to use the opposite pawn masks because we want to get the
1445             # attacking squares of the target square, and not the attacked squares
1446             # of the start square.
1447 1091971         1613793 $mask = $pawn_masks[CP_BLACK]->[2]->[$to] & $pawns
1448             & $white & $not_from_mask;
1449 1091971         1744824 while ($mask) {
1450 79709         90446 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  79709         118729  
  79709         124648  
  79709         117555  
  79709         107367  
  79709         129288  
  79709         98082  
  79709         122533  
1451              
1452 79709         130066 push @white_attackers, ($afrom | $shifted_pawn_value);
1453 79709         139387 $mask = (($mask) & (($mask) - 1));
1454             }
1455 1091971         1497341 $mask = $pawn_masks[CP_WHITE]->[2]->[$to] & $pawns
1456             & $black & $not_from_mask;
1457 1091971         1673582 while ($mask) {
1458 99358         131040 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  99358         124316  
  99358         155417  
  99358         153601  
  99358         147274  
  99358         140992  
  99358         122927  
  99358         147040  
1459              
1460 99358         140587 push @black_attackers, ($afrom | $shifted_pawn_value);
1461 99358         169469 $mask = (($mask) & (($mask) - 1));
1462             }
1463              
1464 1091971         1276850 my $knights = $self->[CP_POS_KNIGHTS];
1465 1091971         1225677 my $shifted_knight_value = CP_KNIGHT_VALUE << 8;
1466 1091971         1448549 $mask = $knight_attack_masks[$to] & $knights & $white & $not_from_mask;
1467 1091971         1651141 while ($mask) {
1468 145278         164884 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  145278         189279  
  145278         214005  
  145278         200542  
  145278         177831  
  145278         189209  
  145278         175487  
  145278         205777  
1469              
1470 145278         220627 push @white_attackers, ($afrom | $shifted_knight_value);
1471 145278         268693 $mask = (($mask) & (($mask) - 1));
1472             }
1473 1091971         1293722 $mask = $knight_attack_masks[$to] & $knights & $black & $not_from_mask;
1474 1091971         1532973 while ($mask) {
1475 139534         160836 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  139534         180308  
  139534         196891  
  139534         198189  
  139534         170140  
  139534         208016  
  139534         176841  
  139534         198717  
1476              
1477 139534         204085 push @black_attackers, ($afrom | $shifted_knight_value);
1478 139534         236449 $mask = (($mask) & (($mask) - 1));
1479             }
1480              
1481 1091971         2146855 my $bishop_mask = CP_MAGICMOVESBDB->[$to][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$to]) * CP_MAGICMOVES_B_MAGICS->[$to]) >> 55) & ((1 << (64 - 55)) - 1)] & $not_from_mask;
1482 1091971         2135571 my $rook_mask = CP_MAGICMOVESRDB->[$to][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$to]) * CP_MAGICMOVES_R_MAGICS->[$to]) >> 52) & ((1 << (64 - 52)) - 1)] & $not_from_mask;
1483 1091971         1253528 my $queen_mask = $bishop_mask | $rook_mask;
1484              
1485 1091971         1272956 my $bishops = $self->[CP_POS_BISHOPS];
1486 1091971         1170587 my $shifted_bishop_value = CP_BISHOP_VALUE << 8;
1487 1091971         1237776 $mask = $bishop_mask & $bishops & $white;
1488 1091971         1649253 while ($mask) {
1489 136199         157439 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  136199         167361  
  136199         193869  
  136199         205799  
  136199         186087  
  136199         187647  
  136199         163650  
  136199         207279  
1490              
1491 136199         224233 push @white_attackers, ($afrom | $shifted_bishop_value);
1492 136199         231780 $mask = (($mask) & (($mask) - 1));
1493             }
1494 1091971         1231827 $mask = $bishop_mask & $bishops & $black;
1495 1091971         1593165 while ($mask) {
1496 97608         123679 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  97608         132321  
  97608         144701  
  97608         143310  
  97608         130554  
  97608         139954  
  97608         117142  
  97608         138325  
1497              
1498 97608         133599 push @black_attackers, ($afrom | $shifted_bishop_value);
1499 97608         169187 $mask = (($mask) & (($mask) - 1));
1500             }
1501              
1502 1091971         1229137 my $rooks = $self->[CP_POS_ROOKS];
1503 1091971         1196331 my $shifted_rook_value = CP_ROOK_VALUE << 8;
1504 1091971         1226620 $mask = $rook_mask & $rooks & $white;
1505 1091971         1646206 while ($mask) {
1506 126435         159193 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  126435         156381  
  126435         174512  
  126435         176789  
  126435         176631  
  126435         179531  
  126435         151516  
  126435         193162  
1507              
1508 126435         173209 push @white_attackers, ($afrom | $shifted_rook_value);
1509 126435         217011 $mask = (($mask) & (($mask) - 1));
1510             }
1511 1091971         1362802 $mask = $rook_mask & $rooks & $black;
1512 1091971         1620953 while ($mask) {
1513 83498         98645 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  83498         108203  
  83498         118213  
  83498         123574  
  83498         105610  
  83498         140498  
  83498         125113  
  83498         131301  
1514              
1515 83498         122259 push @black_attackers, ($afrom | $shifted_rook_value);
1516 83498         139968 $mask = (($mask) & (($mask) - 1));
1517             }
1518              
1519 1091971         1219511 my $queens = $self->[CP_POS_QUEENS];
1520 1091971         1195374 my $shifted_queen_value = CP_QUEEN_VALUE << 8;
1521 1091971         1254307 $mask = $queen_mask & $queens & $white;
1522 1091971         1605478 while ($mask) {
1523 163472         180117 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  163472         191701  
  163472         227564  
  163472         232855  
  163472         200490  
  163472         224019  
  163472         224562  
  163472         234219  
1524              
1525 163472         210662 push @white_attackers, ($afrom | $shifted_queen_value);
1526 163472         273600 $mask = (($mask) & (($mask) - 1));
1527             }
1528 1091971         1258014 $mask = $queen_mask & $queens & $black;
1529 1091971         1584001 while ($mask) {
1530 116272         135423 my $afrom = (do { my $B = $mask & -$mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  116272         142552  
  116272         163804  
  116272         159058  
  116272         150052  
  116272         165456  
  116272         147281  
  116272         155238  
1531              
1532 116272         169088 push @black_attackers, ($afrom | $shifted_queen_value);
1533 116272         197683 $mask = (($mask) & (($mask) - 1));
1534             }
1535              
1536 1091971         1263760 my $kings = $self->[CP_POS_KINGS];
1537 1091971         1139376 my $shifted_king_value = 9999 << 8;
1538 1091971         1434554 $mask = $king_attack_masks[$to] & $kings & $white;
1539 1091971 100       1510532 if ($mask) {
1540 132109         158621 my $afrom = (do { my $A = $mask - 1 - ((($mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  132109         182471  
  132109         180223  
  132109         177721  
  132109         171623  
  132109         167483  
  132109         184456  
1541              
1542 132109         188217 push @white_attackers, ($afrom | $shifted_king_value);
1543             }
1544 1091971         1277398 $mask = $king_attack_masks[$to] & $kings & $black;
1545 1091971 100       1487275 if ($mask) {
1546 254950         289162 my $afrom = (do { my $A = $mask - 1 - ((($mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  254950         341863  
  254950         343217  
  254950         319750  
  254950         335076  
  254950         317358  
  254950         329400  
1547              
1548 254950         335030 push @black_attackers, ($afrom | $shifted_king_value);
1549             }
1550              
1551 1091971         1191831 $occupancy &= $not_from_mask;
1552              
1553 1091971         1232413 my $promote = (($move >> 12) & 0x7);
1554              
1555 1091971         1145746 my $captured;
1556 1091971 100 100     3546530 if ($move_is_ep || ($to_mask & $pawns)) {
    100          
    100          
    100          
    100          
1557 350152         443144 $captured = CP_PAWN;
1558             } elsif ($to_mask & $knights) {
1559 181082         227956 $captured = CP_KNIGHT;
1560             } elsif ($to_mask & $bishops) {
1561 141693         179679 $captured = CP_BISHOP;
1562             } elsif ($to_mask & $rooks) {
1563 82293         104454 $captured = CP_ROOK;
1564             } elsif ($to_mask & $queens) {
1565 39635         52613 $captured = CP_QUEEN;
1566             } else {
1567             # For SEE purposes we have to assume that we do not underpromote.
1568 297116         348912 $captured = CP_NO_PIECE;
1569             }
1570              
1571 1091971         1593347 my $side_to_move = !((($self->[CP_POS_INFO] & (1 << 4)) >> 4));
1572 1091971         1572296 my @gain = ($piece_values[$captured]);
1573 1091971         1425876 my $attacker_value = $piece_values[(($move >> 15) & 0x7)];
1574 1091971 100       1560526 if ($promote) {
1575 91856         114625 $attacker_value = $piece_values[$promote];
1576 91856         120481 $gain[0] += $attacker_value - CP_PAWN_VALUE;
1577             }
1578              
1579 1091971         1329540 my $sliding_mask = $bishops | $rooks | $queens;
1580 1091971         1176508 my $sliding_rooks_mask = $rooks | $queens;
1581 1091971         1161991 my $sliding_bishops_mask = $bishops | $queens;
1582 1091971         1134227 my $depth = 0;
1583 1091971         1466980 my @attackers = (\@white_attackers, \@black_attackers);
1584              
1585 1091971         1185994 while (1) {
1586 1880095         1881690 ++$depth;
1587              
1588             # FIXME! Rather remember the last gain in order to save an array
1589             # dereferencing.
1590 1880095         2286517 $gain[$depth] = $attacker_value - $gain[$depth - 1];
1591              
1592             # Add x-ray attackers.
1593 1880095         2727974 my $obscured_mask = $obscured_masks[$from]->[$to];
1594 1880095 100       2683071 if ($sliding_mask & $obscured_mask) {
1595             # This is the slow part.
1596 216699   100     489632 my $is_rook_move = (($from & 7) == ($to & 7))
1597             || (($from & 56) == ($to & 56));
1598 216699         249564 my $piece;
1599 216699 100 100     742522 if ($is_rook_move && ($obscured_mask & $sliding_rooks_mask)) {
    100 100        
1600 70036         153507 $mask = $sliding_rooks_mask & CP_MAGICMOVESRDB->[$to][(((($occupancy) & CP_MAGICMOVES_R_MASK->[$to]) * CP_MAGICMOVES_R_MAGICS->[$to]) >> 52) & ((1 << (64 - 52)) - 1)];
1601 70036         84298 $piece = CP_ROOK;
1602             } elsif (!$is_rook_move && ($obscured_mask & $sliding_bishops_mask)) {
1603 44008         103163 $mask = $sliding_bishops_mask & CP_MAGICMOVESBDB->[$to][(((($occupancy) & CP_MAGICMOVES_B_MASK->[$to]) * CP_MAGICMOVES_B_MAGICS->[$to]) >> 55) & ((1 << (64 - 55)) - 1)];
1604 44008         60944 $piece = CP_BISHOP;
1605             }
1606 216699 100       402725 if ($obscured_mask & $mask) {
1607 77100         96645 my $piece_mask;
1608              
1609 77100 100       137425 if ($from > $to) {
1610 37024 100       44578 $piece_mask = (do { my $B = $obscured_mask & $mask; if ($B & 0x8000_0000_0000_0000) { 0x8000_0000_0000_0000; } else { $B |= $B >> 1; $B |= $B >> 2; $B |= $B >> 4; $B |= $B >> 8; $B |= $B >> 16; $B |= $B >> 32; $B - ($B >> 1); }});
  37024         50505  
  37024         64361  
  759         1503  
  36265         51199  
  36265         48691  
  36265         42594  
  36265         44585  
  36265         48252  
  36265         41508  
  36265         64285  
1611             } else {
1612 40076         64193 $piece_mask = (($obscured_mask & $mask) & -($obscured_mask & $mask));
1613             }
1614 77100 50       129089 if ($piece_mask) {
1615 77100         85508 my $color;
1616 77100 100       123370 if ($piece_mask & $white) {
1617 40682         49304 $color = CP_WHITE;
1618             } else {
1619 36418         47855 $color = CP_BLACK;
1620             }
1621 77100 100       138563 if ($piece_mask & $queens) {
1622 34565         46751 $piece = CP_QUEEN;
1623             }
1624              
1625             # Now insert the x-ray attacker into the list. Since the
1626             # piece is encoded in the upper bytes, we can do a simple,
1627             # unmasked comparison.
1628 77100         105104 my $attackers_array = $attackers[$color];
1629             my $item = ($piece_values[$piece] << 8)
1630 77100         101009 | (do { my $A = $piece_mask - 1 - ((($piece_mask - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  77100         112984  
  77100         110456  
  77100         90189  
  77100         95824  
  77100         102761  
  77100         117202  
1631 77100         135411 unshift @$attackers_array, $item;
1632 77100         206159 foreach my $i (0.. @$attackers_array - 2) {
1633 35136 100       85558 last if $attackers_array->[$i] <= $attackers_array->[$i + 1];
1634 18846         52871 ($attackers_array->[$i], $attackers_array->[$i+1])
1635             = ($attackers_array->[$i + 1], $attackers_array->[$i]);
1636             }
1637             }
1638             }
1639             }
1640              
1641 1880095         1886985 my $attacker_def = shift @{$attackers[$side_to_move]};
  1880095         2426320  
1642 1880095 100       2739983 if (!$attacker_def) {
1643 899810         1178660 last;
1644             }
1645              
1646 980285         1017261 $attacker_value = $attacker_def >> 8;
1647 980285         1071052 $from = $attacker_def & 0xff;
1648              
1649             # Can we prune?
1650 980285 50       1964050 if ((((-$gain[$depth - 1]) > ($gain[$depth])) ? (-$gain[$depth - 1]) : ($gain[$depth])) < 0) {
    100          
1651 192161         277142 last;
1652             }
1653              
1654 788124         933163 $occupancy -= (1 << $from);
1655              
1656 788124         974357 $side_to_move = !$side_to_move;
1657             }
1658              
1659 1091971         1712198 while (--$depth) {
1660 788124 100       1628259 $gain[$depth - 1]= -((((-$gain[$depth - 1]) > ($gain[$depth])) ? (-$gain[$depth - 1]) : ($gain[$depth])));
1661             }
1662              
1663 1091971         2954278 return $gain[0];
1664             }
1665              
1666             sub parseMove {
1667 1368     1368 1 35812 my ($self, $notation) = @_;
1668              
1669 1368         2050 my $move;
1670 1368 100       4294 if ($notation =~ /^([a-h][1-8])([a-h][1-8])([qrbn])?$/i) {
1671 91 50       237 $move = $self->__parseUCIMove(map { lc $_ } ($1, $2, $3))
  273         750  
1672             or return;
1673             } else {
1674 1277 50       4290 $move = $self->__parseSAN($notation) or return;
1675             }
1676              
1677 1368         2169 my $piece;
1678 1368         2828 my $from_mask = 1 << ((($move >> 6) & 0x3f));
1679 1368 100       7183 if ($from_mask & $self->[CP_POS_PAWNS]) {
    100          
    100          
    100          
    100          
    50          
1680 315         518 $piece = CP_PAWN;
1681             } elsif ($from_mask & $self->[CP_POS_KNIGHTS]) {
1682 241         440 $piece = CP_KNIGHT;
1683             } elsif ($from_mask & $self->[CP_POS_BISHOPS]) {
1684 172         311 $piece = CP_BISHOP;
1685             } elsif ($from_mask & $self->[CP_POS_ROOKS]) {
1686 209         414 $piece = CP_ROOK;
1687             } elsif ($from_mask & $self->[CP_POS_QUEENS]) {
1688 306         603 $piece = CP_QUEEN;
1689             } elsif ($from_mask & $self->[CP_POS_KINGS]) {
1690 125         220 $piece = CP_KING;
1691             } else {
1692 0         0 require Carp;
1693 0         0 Carp::croak(__"Illegal move: start square is empty.\n");
1694             }
1695              
1696 1368         2820 (($move) = (($move) & ~0x38000) | (($piece) & 0x7) << 15);
1697              
1698 1368         2002 my $captured = CP_NO_PIECE;
1699 1368         2234 my $to_mask = 1 << ((($move) & 0x3f));
1700 1368 100 100     11048 if ($to_mask & $self->[CP_POS_PAWNS]) {
    100 100        
    100          
    100          
    100          
    50          
    100          
1701 110         209 $captured = CP_PAWN;
1702             } elsif ($to_mask & $self->[CP_POS_KNIGHTS]) {
1703 51         99 $captured = CP_KNIGHT;
1704             } elsif ($to_mask & $self->[CP_POS_BISHOPS]) {
1705 50         103 $captured = CP_BISHOP;
1706             } elsif ($to_mask & $self->[CP_POS_ROOKS]) {
1707 40         82 $captured = CP_ROOK;
1708             } elsif ($to_mask & $self->[CP_POS_QUEENS]) {
1709 29         66 $captured = CP_QUEEN;
1710             } elsif ($to_mask & $self->[CP_POS_KINGS]) {
1711 0         0 $captured = CP_KING;
1712             } elsif ($piece == CP_PAWN && $self->enPassantShift
1713             && ((($move) & 0x3f)) == $self->enPassantShift) {
1714 10         18 $captured = CP_PAWN;
1715             }
1716 1368         2764 (($move) = (($move) & ~0x1c0000) | (($captured) & 0x7) << 18);
1717              
1718 1368         3480 (($move) = (($move) & ~0x20_0000) | (($self->toMove) & 0x1) << 21);
1719              
1720 1368         4614 return $move;
1721             }
1722              
1723             sub __parseUCIMove {
1724 1368     1368   6070 my ($class, $from_square, $to_square, $promote) = @_;
1725              
1726 1368         2765 my $move = 0;
1727 1368         3135 my $from = $class->squareToShift($from_square);
1728 1368         2521 my $to = $class->squareToShift($to_square);
1729              
1730 1368 50       2863 return if $from < 0;
1731 1368 50       2466 return if $from > 63;
1732 1368 50       2854 return if $to < 0;
1733 1368 50       2586 return if $to > 63;
1734              
1735 1368         2502 (($move) = (($move) & ~0xfc0) | (($from) & 0x3f) << 6);
1736 1368         2454 (($move) = (($move) & ~0x3f) | (($to) & 0x3f));
1737              
1738 1368 100       2884 if ($promote) {
1739 28         137 my %pieces = (
1740             q => CP_QUEEN,
1741             r => CP_ROOK,
1742             b => CP_BISHOP,
1743             n => CP_KNIGHT,
1744             );
1745              
1746 28   50     153 (($move) = (($move) & ~0x7000) | (($pieces{lc $promote} or return) & 0x7) << 12);
1747             }
1748              
1749 1368         7417 return $move;
1750             }
1751              
1752             sub bitboardPopcount {
1753 0     0 1 0 my (undef, $bitboard) = @_;
1754              
1755 0         0 my $count;
1756 0         0 { my $_b = $bitboard; for ($count = 0; $_b; ++$count) { $_b &= $_b - 1; } };
  0         0  
  0         0  
  0         0  
1757              
1758 0         0 return $count;
1759             }
1760              
1761             sub bitboardClearLeastSet {
1762 39000     39000 1 47750 my (undef, $bitboard) = @_;
1763              
1764 39000         67941 return (($bitboard) & (($bitboard) - 1));
1765             }
1766              
1767             sub bitboardClearButLeastSet {
1768 0     0 1 0 my (undef, $bitboard) = @_;
1769              
1770 0         0 return (($bitboard) & -($bitboard));
1771             }
1772              
1773             sub bitboardCountIsolatedTrailingZbits {
1774 0     0 1 0 my (undef, $bitboard) = @_;
1775              
1776 0         0 return (do { my $A = $bitboard - 1 - ((($bitboard - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1777             }
1778              
1779             sub bitboardCountTrailingZbits {
1780 39000     39000 1 52767 my (undef, $bitboard) = @_;
1781              
1782 39000         40986 return (do { my $B = $bitboard & -$bitboard; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  39000         48498  
  39000         57864  
  39000         48630  
  39000         43976  
  39000         46140  
  39000         43309  
  39000         52940  
1783             }
1784              
1785             sub bitboardMoreThanOneSet {
1786 0     0 1 0 my (undef, $bitboard) = @_;
1787              
1788 0   0     0 return ($bitboard && ($bitboard & ($bitboard - 1)));
1789             }
1790              
1791             sub insufficientMaterial {
1792             my ($self) = @_;
1793              
1794             # FIXME! Once we distinguish black and white material (should we?),
1795             # we can try to take an early exit here if any of the two sides has
1796             # more material than a bishop.
1797              
1798             # All of these are sufficient to mate.
1799             if ($self->[CP_POS_PAWNS] | $self->[CP_POS_ROOKS] | $self->[CP_POS_QUEENS]) {
1800             return;
1801             }
1802              
1803             # There is neither a queen nor a rook nor a pawn. Two or more minor
1804             # pieces on one side can always mate.
1805             my $not_kings = ~$self->[CP_POS_KINGS];
1806              
1807             my $white = $self->[CP_POS_WHITE_PIECES];
1808             my $white_minor_pieces = $white & $not_kings;
1809             if (($white_minor_pieces && ($white_minor_pieces & ($white_minor_pieces - 1)))) {
1810             return;
1811             }
1812              
1813             my $black = $self->[CP_POS_BLACK_PIECES];
1814             my $black_minor_pieces = $black & $not_kings;
1815             if (($black_minor_pieces && ($black_minor_pieces & ($black_minor_pieces - 1)))) {
1816             return;
1817             }
1818              
1819             # One minor piece against a lone king cannot mate.
1820             if(!($white_minor_pieces && $black_minor_pieces)) {
1821             return 1;
1822             }
1823              
1824             # Both sides have exactly one minor piece. The only combination that
1825             # is a draw is KBKB with bishops of different color. That means, that
1826             # both sides can mate if a knight is on the board.
1827             if ($self->[CP_POS_KNIGHTS]) {
1828             return;
1829             }
1830              
1831             # Every side has one bishop. It is not necessarily a draw, if they are
1832             # on different colored squares.
1833             my $bishops = $self->[CP_POS_BISHOPS];
1834             if (!!($white & $bishops & CP_WHITE_MASK)
1835             != !!($black & $bishops & CP_BLACK_MASK)) {
1836             return;
1837             }
1838              
1839             return 1;
1840             }
1841              
1842             sub __updateZobristKey {
1843 141272     141272   183570 my ($self) = @_;
1844              
1845 141272         156094 my $signature = 0;
1846 141272         150596 my $piece_mask;
1847              
1848             my ($pawns, $knights, $bishops, $rooks, $queens, $kings, $white, $black)
1849 141272         184860 = @{$self}[CP_POS_PAWNS .. CP_POS_BLACK_PIECES];
  141272         275586  
1850              
1851 141272         185283 $piece_mask = $pawns & $white;
1852 141272         244057 while ($piece_mask) {
1853 445762         445532 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  445762         513472  
  445762         525159  
  445762         497811  
  445762         471210  
  445762         483027  
  445762         472548  
  445762         550629  
1854 445762         587561 $signature ^= $zk_pieces[(((CP_PAWN) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1855 445762         662379 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1856             }
1857              
1858 141272         160581 $piece_mask = $pawns & $black;
1859 141272         239533 while ($piece_mask) {
1860 516388         502756 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  516388         561262  
  516388         579786  
  516388         578994  
  516388         559603  
  516388         568016  
  516388         543913  
  516388         605397  
1861 516388         615609 $signature ^= $zk_pieces[(((CP_PAWN) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1862 516388         757781 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1863             }
1864              
1865 141272         164993 $piece_mask = $knights & $white;
1866 141272         217683 while ($piece_mask) {
1867 183850         194161 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  183850         212585  
  183850         227371  
  183850         216347  
  183850         205159  
  183850         220657  
  183850         217161  
  183850         223561  
1868 183850         237049 $signature ^= $zk_pieces[(((CP_KNIGHT) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1869 183850         283254 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1870             }
1871              
1872 141272         158757 $piece_mask = $knights & $black;
1873 141272         211095 while ($piece_mask) {
1874 161749         169158 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  161749         181619  
  161749         193128  
  161749         205241  
  161749         181945  
  161749         189107  
  161749         175174  
  161749         200148  
1875 161749         208173 $signature ^= $zk_pieces[(((CP_KNIGHT) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1876 161749         238510 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1877             }
1878              
1879 141272         174510 $piece_mask = $bishops & $white;
1880 141272         208667 while ($piece_mask) {
1881 199735         195814 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  199735         224133  
  199735         252893  
  199735         229562  
  199735         218848  
  199735         240492  
  199735         234335  
  199735         242356  
1882 199735         253567 $signature ^= $zk_pieces[(((CP_BISHOP) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1883 199735         298602 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1884             }
1885              
1886 141272         161248 $piece_mask = $bishops & $black;
1887 141272         207093 while ($piece_mask) {
1888 179290         180135 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  179290         200827  
  179290         212437  
  179290         217673  
  179290         196085  
  179290         218841  
  179290         195693  
  179290         211543  
1889 179290         228136 $signature ^= $zk_pieces[(((CP_BISHOP) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1890 179290         288119 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1891             }
1892              
1893 141272         162591 $piece_mask = $rooks & $white;
1894 141272         209613 while ($piece_mask) {
1895 177824         176771 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  177824         210030  
  177824         223494  
  177824         209792  
  177824         198636  
  177824         203804  
  177824         196538  
  177824         223507  
1896 177824         230819 $signature ^= $zk_pieces[(((CP_ROOK) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1897 177824         268306 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1898             }
1899              
1900 141272         155941 $piece_mask = $rooks & $black;
1901 141272         217747 while ($piece_mask) {
1902 159245         165241 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  159245         194916  
  159245         191022  
  159245         195385  
  159245         180339  
  159245         187250  
  159245         194488  
  159245         191666  
1903 159245         211914 $signature ^= $zk_pieces[(((CP_ROOK) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1904 159245         235883 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1905             }
1906              
1907 141272         160283 $piece_mask = $queens & $white;
1908 141272         208035 while ($piece_mask) {
1909 130719         135334 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  130719         149128  
  130719         153806  
  130719         154645  
  130719         149177  
  130719         164869  
  130719         146038  
  130719         169896  
1910 130719         174032 $signature ^= $zk_pieces[(((CP_QUEEN) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1911 130719         205597 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1912             }
1913              
1914 141272         163251 $piece_mask = $queens & $black;
1915 141272         207513 while ($piece_mask) {
1916 107977         113859 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  107977         121248  
  107977         144441  
  107977         131402  
  107977         122060  
  107977         132750  
  107977         117200  
  107977         131976  
1917 107977         144779 $signature ^= $zk_pieces[(((CP_QUEEN) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1918 107977         169979 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1919             }
1920              
1921 141272         158959 $piece_mask = $kings & $white;
1922 141272         206656 while ($piece_mask) {
1923 141272         168140 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  141272         157753  
  141272         171492  
  141272         173975  
  141272         178040  
  141272         168159  
  141272         170422  
  141272         175722  
1924 141272         186056 $signature ^= $zk_pieces[(((CP_KING) << 7) | ((CP_WHITE) << 6) | ($shift)) - 128];
1925 141272         209997 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1926             }
1927              
1928 141272         160800 $piece_mask = $kings & $black;
1929 141272         192773 while ($piece_mask) {
1930 141272         148176 my $shift = (do { my $B = $piece_mask & -$piece_mask; my $A = $B - 1 - ((($B - 1) >> 1) & 0x5555_5555_5555_5555); my $C = ($A & 0x3333_3333_3333_3333) + (($A >> 2) & 0x3333_3333_3333_3333); my $n = $C + ($C >> 32); $n = ($n & 0x0f0f0f0f) + (($n >> 4) & 0x0f0f0f0f); $n = ($n & 0xffff) + ($n >> 16); $n = ($n & 0xff) + ($n >> 8);});
  141272         159136  
  141272         171366  
  141272         173006  
  141272         151938  
  141272         173546  
  141272         154183  
  141272         180153  
1931 141272         176285 $signature ^= $zk_pieces[(((CP_KING) << 7) | ((CP_BLACK) << 6) | ($shift)) - 128];
1932 141272         217187 $piece_mask = (($piece_mask) & (($piece_mask) - 1));
1933             }
1934              
1935 141272         181591 my $pos_info = $self->[CP_POS_INFO];
1936 141272         165493 my $ep_shift = (($pos_info & (0x3f << 5)) >> 5);
1937 141272 100       199973 if ($ep_shift) {
1938 114         212 $signature ^= $zk_ep_files[$ep_shift & 0x7];
1939             }
1940 141272         154960 my $castling = $pos_info & 0xf;
1941 141272         175217 $signature ^= $zk_castling[$castling];
1942              
1943 141272 100       210682 if ((($pos_info & (1 << 4)) >> 4)) {
1944 50519         55741 $signature ^= $zk_color;
1945             }
1946              
1947 141272         162455 $self->[CP_POS_SIGNATURE] = $signature;
1948              
1949 141272         195035 return $signature;
1950             }
1951              
1952             sub __zobristKeyLookup {
1953 5054400     5054400   6178662 my ($self, $piece, $color, $shift) = @_;
1954              
1955 5054400         6827309 return $zk_pieces[((($piece) << 7) | (($color) << 6) | ($shift)) - 128];
1956             }
1957              
1958             sub __zobristKeyLookupByIndex {
1959 0     0   0 my ($self, $index) = @_;
1960              
1961 0         0 return $zk_pieces[$index];
1962             }
1963              
1964             sub __zobristKeyDump {
1965 0     0   0 my ($self) = @_;
1966              
1967 0         0 my $output = "Pieces\n======\n\n";
1968 0         0 for (my $i = 0; $i < 768; ++$i) {
1969 0         0 $output .= sprintf '% 4u:', $i;
1970 0         0 my $s = $i + 128;
1971 0         0 my $pc = $s >> 7;
1972 0 0 0     0 if ($pc && $pc <= CP_KING) {
1973 0         0 my $shift = $s & 63;
1974 0         0 my $co = ($s >> 6) & 1;
1975 0         0 my $square = $self->shiftToSquare($shift);
1976 0         0 my $piece_char = CP_PIECE_CHARS->[$co]->[$pc];
1977 0         0 $output .= "$piece_char:$square:";
1978             } else {
1979 0         0 $output .= ' ';
1980             }
1981 0         0 $output .= sprintf " 0x%016x (%d)\n", $zk_pieces[$i], $zk_pieces[$i];
1982             }
1983              
1984 0         0 $output .= "\nEn-Passant Files\n";
1985 0         0 $output .= "================\n\n";
1986 0         0 foreach my $file (CP_FILE_A .. CP_FILE_H) {
1987 0         0 my $char = chr($file + ord('a'));
1988 0         0 $output .= sprintf "$char: 0x%016x (%d)\n", $zk_ep_files[$file], $zk_ep_files[$file];
1989             }
1990              
1991 0         0 $output .= "\nCastling States\n";
1992 0         0 $output .= "===============\n\n";
1993 0         0 foreach my $castling (0 .. 15) {
1994 0         0 my $castle = '';
1995 0 0       0 if ($castling) {
1996 0 0       0 $castle .= 'K' if $castling & 0x1;
1997 0 0       0 $castle .= 'Q' if $castling & 0x2;
1998 0 0       0 $castle .= 'k' if $castling & 0x4;
1999 0 0       0 $castle .= 'q' if $castling & 0x8;
2000             } else {
2001 0         0 $castle = '-';
2002             }
2003              
2004 0         0 $output .= sprintf "% 2u:% 4s: 0x%016x (%d)\n", $castling, $castle, $zk_castling[$castling], $zk_castling[$castling];
2005             }
2006              
2007 0         0 $output .= "\nColor\n=====\n\n";
2008 0         0 $output .= sprintf "1:black: 0x%016x (%d)\n", $zk_color, $zk_color;
2009              
2010 0         0 return $output;
2011             }
2012              
2013             sub insufficientMaterial {
2014 40     40 1 221 my ($self) = @_;
2015              
2016             # FIXME! Once we distinguish black and white material (should we?),
2017             # we can try to take an early exit here if any of the two sides has
2018             # more material than a bishop.
2019              
2020             # All of these are sufficient to mate.
2021 40 100       85 if ($self->[CP_POS_PAWNS] | $self->[CP_POS_ROOKS] | $self->[CP_POS_QUEENS]) {
2022 12         47 return;
2023             }
2024              
2025             # There is neither a queen nor a rook nor a pawn. Two or more minor
2026             # pieces on one side can always mate.
2027 28         39 my $not_kings = ~$self->[CP_POS_KINGS];
2028              
2029 28         46 my $white = $self->[CP_POS_WHITE_PIECES];
2030 28         34 my $white_minor_pieces = $white & $not_kings;
2031 28 100 100     87 if (($white_minor_pieces && ($white_minor_pieces & ($white_minor_pieces - 1)))) {
2032 8         32 return;
2033             }
2034              
2035 20         29 my $black = $self->[CP_POS_BLACK_PIECES];
2036 20         27 my $black_minor_pieces = $black & $not_kings;
2037 20 100 100     55 if (($black_minor_pieces && ($black_minor_pieces & ($black_minor_pieces - 1)))) {
2038 7         31 return;
2039             }
2040              
2041             # One minor piece against a lone king cannot mate.
2042 13 100 100     64 if(!($white_minor_pieces && $black_minor_pieces)) {
2043 6         32 return 1;
2044             }
2045              
2046             # Both sides have exactly one minor piece. The only combination that
2047             # is a draw is KBKB with bishops of different color. That means, that
2048             # both sides can mate if a knight is on the board.
2049 7 100       12 if ($self->[CP_POS_KNIGHTS]) {
2050 3         13 return;
2051             }
2052              
2053             # Every side has one bishop. It is not necessarily a draw, if they are
2054             # on different colored squares.
2055 4         6 my $bishops = $self->[CP_POS_BISHOPS];
2056 4 100       11 if (!!($white & $bishops & CP_WHITE_MASK)
2057             != !!($black & $bishops & CP_BLACK_MASK)) {
2058 2         9 return;
2059             }
2060              
2061 2         8 return 1;
2062             }
2063              
2064             # Do not remove this line!
2065              
2066              
2067             my @export_accessors = qw(
2068             CP_POS_WHITE_PIECES CP_POS_BLACK_PIECES
2069             CP_POS_KINGS CP_POS_QUEENS
2070             CP_POS_ROOKS CP_POS_BISHOPS CP_POS_KNIGHTS CP_POS_PAWNS
2071             CP_POS_HALF_MOVE_CLOCK CP_POS_REVERSIBLE_CLOCK CP_POS_HALF_MOVES
2072             CP_POS_INFO CP_POS_SIGNATURE
2073             CP_POS_IN_CHECK CP_POS_EVASION_SQUARES
2074             );
2075              
2076             my @export_board = qw(
2077             CP_FILE_A CP_FILE_B CP_FILE_C CP_FILE_D
2078             CP_FILE_E CP_FILE_F CP_FILE_G CP_FILE_H
2079             CP_RANK_1 CP_RANK_2 CP_RANK_3 CP_RANK_4
2080             CP_RANK_5 CP_RANK_6 CP_RANK_7 CP_RANK_8
2081             CP_A1 CP_A2 CP_A3 CP_A4 CP_A5 CP_A6 CP_A7 CP_A8
2082             CP_B1 CP_B2 CP_B3 CP_B4 CP_B5 CP_B6 CP_B7 CP_B8
2083             CP_C1 CP_C2 CP_C3 CP_C4 CP_C5 CP_C6 CP_C7 CP_C8
2084             CP_D1 CP_D2 CP_D3 CP_D4 CP_D5 CP_D6 CP_D7 CP_D8
2085             CP_E1 CP_E2 CP_E3 CP_E4 CP_E5 CP_E6 CP_E7 CP_E8
2086             CP_F1 CP_F2 CP_F3 CP_F4 CP_F5 CP_F6 CP_F7 CP_F8
2087             CP_G1 CP_G2 CP_G3 CP_G4 CP_G5 CP_G6 CP_G7 CP_G8
2088             CP_H1 CP_H2 CP_H3 CP_H4 CP_H5 CP_H6 CP_H7 CP_H8
2089             CP_A_MASK CP_B_MASK CP_C_MASK CP_D_MASK
2090             CP_E_MASK CP_F_MASK CP_G_MASK CP_H_MASK
2091             CP_1_MASK CP_2_MASK CP_3_MASK CP_4_MASK
2092             CP_5_MASK CP_6_MASK CP_7_MASK CP_8_MASK
2093             CP_WHITE_MASK CP_BLACK_MASK
2094             );
2095              
2096             my @export_pieces = qw(
2097             CP_WHITE CP_BLACK
2098             CP_NO_PIECE CP_PAWN CP_KNIGHT CP_BISHOP CP_ROOK CP_QUEEN CP_KING
2099             CP_PAWN_VALUE CP_KNIGHT_VALUE CP_BISHOP_VALUE CP_ROOK_VALUE CP_QUEEN_VALUE
2100             CP_PIECE_CHARS
2101             );
2102              
2103             my @export_magicmoves = qw(
2104             CP_MAGICMOVES_B_MAGICS
2105             CP_MAGICMOVES_R_MAGICS
2106             CP_MAGICMOVES_B_MASK
2107             CP_MAGICMOVES_R_MASK
2108             CP_MAGICMOVESBDB
2109             CP_MAGICMOVESRDB
2110             );
2111              
2112             my @export_aux = qw(CP_INT_SIZE CP_CHAR_BIT CP_RANDOM_SEED);
2113              
2114             our @EXPORT_OK = (@export_pieces, @export_board, @export_accessors,
2115             @export_magicmoves, @export_aux);
2116              
2117             our %EXPORT_TAGS = (
2118             accessors => [@export_accessors],
2119             pieces => [@export_pieces],
2120             board => [@export_board],
2121             magicmoves => [@export_magicmoves],
2122             aux => [@export_aux],
2123             all => [@EXPORT_OK],
2124             );
2125              
2126             # Bit twiddling stuff.
2127 39     39   482 use constant CP_INT_SIZE => $Config{ivsize};
  39         83  
  39         6432  
2128 39     39   298 use constant CP_CHAR_BIT => 8;
  39         825  
  39         2149  
2129              
2130             # Diagonals parallel to a1-h8.
2131 39     39   235 use constant CP_A1A1_MASK => 0x0000000000000001;
  39         73  
  39         1771  
2132 39     39   212 use constant CP_B1A2_MASK => 0x0000000000000102;
  39         108  
  39         4224  
2133 39     39   301 use constant CP_C1A3_MASK => 0x0000000000010204;
  39         77  
  39         1814  
2134 39     39   196 use constant CP_D1A4_MASK => 0x0000000001020408;
  39         118  
  39         1525  
2135 39     39   191 use constant CP_E1A5_MASK => 0x0000000102040810;
  39         74  
  39         1822  
2136 39     39   242 use constant CP_F1A6_MASK => 0x0000010204081020;
  39         84  
  39         1718  
2137 39     39   207 use constant CP_G1A7_MASK => 0x0001020408102040;
  39         74  
  39         1706  
2138 39     39   201 use constant CP_H1A8_MASK => 0x0102040810204080;
  39         80  
  39         1718  
2139 39     39   294 use constant CP_H2B8_MASK => 0x0204081020408000;
  39         63  
  39         1734  
2140 39     39   213 use constant CP_H3C8_MASK => 0x0408102040800000;
  39         76  
  39         1611  
2141 39     39   218 use constant CP_H4D8_MASK => 0x0810204080000000;
  39         159  
  39         1688  
2142 39     39   204 use constant CP_H5E8_MASK => 0x1020408000000000;
  39         61  
  39         1638  
2143 39     39   218 use constant CP_H6F8_MASK => 0x2040800000000000;
  39         61  
  39         1866  
2144 39     39   222 use constant CP_H7G8_MASK => 0x4080000000000000;
  39         116  
  39         1763  
2145 39     39   215 use constant CP_H8H8_MASK => 0x8000000000000000;
  39         74  
  39         1961  
2146              
2147             # Diagonals parallel to h1-a8
2148 39     39   248 use constant CP_H1H1_MASK => 0x0000000000000080;
  39         121  
  39         1826  
2149 39     39   215 use constant CP_H2G1_MASK => 0x0000000000008040;
  39         71  
  39         1774  
2150 39     39   247 use constant CP_H3F1_MASK => 0x0000000000804020;
  39         61  
  39         2878  
2151 39     39   194 use constant CP_H4E1_MASK => 0x0000000080402010;
  39         75  
  39         1704  
2152 39     39   239 use constant CP_H5D1_MASK => 0x0000008040201008;
  39         60  
  39         1917  
2153 39     39   222 use constant CP_H6C1_MASK => 0x0000804020100804;
  39         68  
  39         1947  
2154 39     39   212 use constant CP_H7B1_MASK => 0x0080402010080402;
  39         97  
  39         1774  
2155 39     39   223 use constant CP_H8A1_MASK => 0x8040201008040201;
  39         75  
  39         2027  
2156 39     39   219 use constant CP_G8A2_MASK => 0x4020100804020100;
  39         60  
  39         1846  
2157 39     39   201 use constant CP_F8A3_MASK => 0x2010080402010000;
  39         66  
  39         1671  
2158 39     39   214 use constant CP_E8A4_MASK => 0x1008040201000000;
  39         72  
  39         1803  
2159 39     39   228 use constant CP_D8A5_MASK => 0x0804020100000000;
  39         90  
  39         1880  
2160 39     39   215 use constant CP_C8A6_MASK => 0x0402010000000000;
  39         69  
  39         1781  
2161 39     39   209 use constant CP_B8A7_MASK => 0x0201000000000000;
  39         93  
  39         1973  
2162 39     39   223 use constant CP_A8A8_MASK => 0x0100000000000000;
  39         80  
  39         1752  
2163              
2164             # Diagonals parallel to a1-h8, the other way round.
2165 39     39   206 use constant CP_A2B1_MASK => 0x0000000000000102;
  39         64  
  39         1641  
2166 39     39   253 use constant CP_A3C1_MASK => 0x0000000000010204;
  39         72  
  39         1914  
2167 39     39   216 use constant CP_A4D1_MASK => 0x0000000001020408;
  39         89  
  39         1759  
2168 39     39   209 use constant CP_A5E1_MASK => 0x0000000102040810;
  39         86  
  39         1705  
2169 39     39   209 use constant CP_A6F1_MASK => 0x0000010204081020;
  39         69  
  39         1680  
2170 39     39   204 use constant CP_A7G1_MASK => 0x0001020408102040;
  39         63  
  39         1838  
2171 39     39   243 use constant CP_A8H1_MASK => 0x0102040810204080;
  39         67  
  39         1758  
2172 39     39   238 use constant CP_B8H2_MASK => 0x0204081020408000;
  39         70  
  39         2197  
2173 39     39   211 use constant CP_C8H3_MASK => 0x0408102040800000;
  39         56  
  39         2398  
2174 39     39   256 use constant CP_D8H4_MASK => 0x0810204080000000;
  39         78  
  39         1871  
2175 39     39   209 use constant CP_E8H5_MASK => 0x1020408000000000;
  39         107  
  39         1831  
2176 39     39   213 use constant CP_F8H6_MASK => 0x2040800000000000;
  39         63  
  39         1722  
2177 39     39   196 use constant CP_G8H7_MASK => 0x4080000000000000;
  39         68  
  39         1750  
2178              
2179             # Diagonals parallel to h1-a8, the other way round.
2180 39     39   197 use constant CP_G1H2_MASK => 0x0000000000008040;
  39         72  
  39         1633  
2181 39     39   205 use constant CP_F1H3_MASK => 0x0000000000804020;
  39         70  
  39         1649  
2182 39     39   231 use constant CP_E1H4_MASK => 0x0000000080402010;
  39         74  
  39         1658  
2183 39     39   213 use constant CP_D1H5_MASK => 0x0000008040201008;
  39         64  
  39         1714  
2184 39     39   217 use constant CP_C1H6_MASK => 0x0000804020100804;
  39         82  
  39         1655  
2185 39     39   229 use constant CP_B1H7_MASK => 0x0080402010080402;
  39         81  
  39         1702  
2186 39     39   257 use constant CP_A1H8_MASK => 0x8040201008040201;
  39         71  
  39         1624  
2187 39     39   498 use constant CP_A2G8_MASK => 0x4020100804020100;
  39         67  
  39         1688  
2188 39     39   517 use constant CP_A3F8_MASK => 0x2010080402010000;
  39         79  
  39         1721  
2189 39     39   220 use constant CP_A4E8_MASK => 0x1008040201000000;
  39         76  
  39         1632  
2190 39     39   237 use constant CP_A5D8_MASK => 0x0804020100000000;
  39         81  
  39         1733  
2191 39     39   205 use constant CP_A6C8_MASK => 0x0402010000000000;
  39         68  
  39         1652  
2192 39     39   233 use constant CP_A7B8_MASK => 0x0201000000000000;
  39         65  
  39         131533  
2193              
2194             @magicmoves_r_magics = (
2195             0x0080001020400080, 0x0040001000200040, 0x0080081000200080, 0x0080040800100080,
2196             0x0080020400080080, 0x0080010200040080, 0x0080008001000200, 0x0080002040800100,
2197             0x0000800020400080, 0x0000400020005000, 0x0000801000200080, 0x0000800800100080,
2198             0x0000800400080080, 0x0000800200040080, 0x0000800100020080, 0x0000800040800100,
2199             0x0000208000400080, 0x0000404000201000, 0x0000808010002000, 0x0000808008001000,
2200             0x0000808004000800, 0x0000808002000400, 0x0000010100020004, 0x0000020000408104,
2201             0x0000208080004000, 0x0000200040005000, 0x0000100080200080, 0x0000080080100080,
2202             0x0000040080080080, 0x0000020080040080, 0x0000010080800200, 0x0000800080004100,
2203             0x0000204000800080, 0x0000200040401000, 0x0000100080802000, 0x0000080080801000,
2204             0x0000040080800800, 0x0000020080800400, 0x0000020001010004, 0x0000800040800100,
2205             0x0000204000808000, 0x0000200040008080, 0x0000100020008080, 0x0000080010008080,
2206             0x0000040008008080, 0x0000020004008080, 0x0000010002008080, 0x0000004081020004,
2207             0x0000204000800080, 0x0000200040008080, 0x0000100020008080, 0x0000080010008080,
2208             0x0000040008008080, 0x0000020004008080, 0x0000800100020080, 0x0000800041000080,
2209             0x00FFFCDDFCED714A, 0x007FFCDDFCED714A, 0x003FFFCDFFD88096, 0x0000040810002101,
2210             0x0001000204080011, 0x0001000204000801, 0x0001000082000401, 0x0001FFFAABFAD1A2
2211             );
2212              
2213             @magicmoves_r_mask = (
2214             0x000101010101017E, 0x000202020202027C, 0x000404040404047A, 0x0008080808080876,
2215             0x001010101010106E, 0x002020202020205E, 0x004040404040403E, 0x008080808080807E,
2216             0x0001010101017E00, 0x0002020202027C00, 0x0004040404047A00, 0x0008080808087600,
2217             0x0010101010106E00, 0x0020202020205E00, 0x0040404040403E00, 0x0080808080807E00,
2218             0x00010101017E0100, 0x00020202027C0200, 0x00040404047A0400, 0x0008080808760800,
2219             0x00101010106E1000, 0x00202020205E2000, 0x00404040403E4000, 0x00808080807E8000,
2220             0x000101017E010100, 0x000202027C020200, 0x000404047A040400, 0x0008080876080800,
2221             0x001010106E101000, 0x002020205E202000, 0x004040403E404000, 0x008080807E808000,
2222             0x0001017E01010100, 0x0002027C02020200, 0x0004047A04040400, 0x0008087608080800,
2223             0x0010106E10101000, 0x0020205E20202000, 0x0040403E40404000, 0x0080807E80808000,
2224             0x00017E0101010100, 0x00027C0202020200, 0x00047A0404040400, 0x0008760808080800,
2225             0x00106E1010101000, 0x00205E2020202000, 0x00403E4040404000, 0x00807E8080808000,
2226             0x007E010101010100, 0x007C020202020200, 0x007A040404040400, 0x0076080808080800,
2227             0x006E101010101000, 0x005E202020202000, 0x003E404040404000, 0x007E808080808000,
2228             0x7E01010101010100, 0x7C02020202020200, 0x7A04040404040400, 0x7608080808080800,
2229             0x6E10101010101000, 0x5E20202020202000, 0x3E40404040404000, 0x7E80808080808000
2230             );
2231              
2232             @magicmoves_b_magics = (
2233             0x0002020202020200, 0x0002020202020000, 0x0004010202000000, 0x0004040080000000,
2234             0x0001104000000000, 0x0000821040000000, 0x0000410410400000, 0x0000104104104000,
2235             0x0000040404040400, 0x0000020202020200, 0x0000040102020000, 0x0000040400800000,
2236             0x0000011040000000, 0x0000008210400000, 0x0000004104104000, 0x0000002082082000,
2237             0x0004000808080800, 0x0002000404040400, 0x0001000202020200, 0x0000800802004000,
2238             0x0000800400A00000, 0x0000200100884000, 0x0000400082082000, 0x0000200041041000,
2239             0x0002080010101000, 0x0001040008080800, 0x0000208004010400, 0x0000404004010200,
2240             0x0000840000802000, 0x0000404002011000, 0x0000808001041000, 0x0000404000820800,
2241             0x0001041000202000, 0x0000820800101000, 0x0000104400080800, 0x0000020080080080,
2242             0x0000404040040100, 0x0000808100020100, 0x0001010100020800, 0x0000808080010400,
2243             0x0000820820004000, 0x0000410410002000, 0x0000082088001000, 0x0000002011000800,
2244             0x0000080100400400, 0x0001010101000200, 0x0002020202000400, 0x0001010101000200,
2245             0x0000410410400000, 0x0000208208200000, 0x0000002084100000, 0x0000000020880000,
2246             0x0000001002020000, 0x0000040408020000, 0x0004040404040000, 0x0002020202020000,
2247             0x0000104104104000, 0x0000002082082000, 0x0000000020841000, 0x0000000000208800,
2248             0x0000000010020200, 0x0000000404080200, 0x0000040404040400, 0x0002020202020200
2249             );
2250              
2251             @magicmoves_b_mask = (
2252             0x0040201008040200, 0x0000402010080400, 0x0000004020100A00, 0x0000000040221400,
2253             0x0000000002442800, 0x0000000204085000, 0x0000020408102000, 0x0002040810204000,
2254             0x0020100804020000, 0x0040201008040000, 0x00004020100A0000, 0x0000004022140000,
2255             0x0000000244280000, 0x0000020408500000, 0x0002040810200000, 0x0004081020400000,
2256             0x0010080402000200, 0x0020100804000400, 0x004020100A000A00, 0x0000402214001400,
2257             0x0000024428002800, 0x0002040850005000, 0x0004081020002000, 0x0008102040004000,
2258             0x0008040200020400, 0x0010080400040800, 0x0020100A000A1000, 0x0040221400142200,
2259             0x0002442800284400, 0x0004085000500800, 0x0008102000201000, 0x0010204000402000,
2260             0x0004020002040800, 0x0008040004081000, 0x00100A000A102000, 0x0022140014224000,
2261             0x0044280028440200, 0x0008500050080400, 0x0010200020100800, 0x0020400040201000,
2262             0x0002000204081000, 0x0004000408102000, 0x000A000A10204000, 0x0014001422400000,
2263             0x0028002844020000, 0x0050005008040200, 0x0020002010080400, 0x0040004020100800,
2264             0x0000020408102000, 0x0000040810204000, 0x00000A1020400000, 0x0000142240000000,
2265             0x0000284402000000, 0x0000500804020000, 0x0000201008040200, 0x0000402010080400,
2266             0x0002040810204000, 0x0004081020400000, 0x000A102040000000, 0x0014224000000000,
2267             0x0028440200000000, 0x0050080402000000, 0x0020100804020000, 0x0040201008040200
2268             );
2269              
2270             sub copy {
2271 944     944 1 48369 my ($self) = @_;
2272              
2273 944         6834 bless [@$self], ref $self;
2274             }
2275              
2276             sub whitePieces {
2277 1     1 1 591 shift->[CP_POS_WHITE_PIECES];
2278             }
2279              
2280             sub blackPieces {
2281 1     1 1 5 shift->[CP_POS_BLACK_PIECES];
2282             }
2283              
2284             sub kings {
2285 1     1 1 3 shift->[CP_POS_KINGS];
2286             }
2287              
2288             sub queens {
2289 1     1 1 4 shift->[CP_POS_QUEENS];
2290             }
2291              
2292             sub rooks {
2293 1     1 1 4 shift->[CP_POS_ROOKS];
2294             }
2295              
2296             sub bishops {
2297 1     1 1 5 shift->[CP_POS_BISHOPS];
2298             }
2299              
2300             sub knights {
2301 1     1 1 5 shift->[CP_POS_KNIGHTS];
2302             }
2303              
2304             sub pawns {
2305 1     1 1 4 shift->[CP_POS_PAWNS];
2306             }
2307              
2308             sub occupied {
2309 0     0 1 0 my ($self) = @_;
2310              
2311 0         0 return $self->[CP_POS_WHITE_PIECES] | $self->[CP_POS_BLACK_PIECES];
2312             }
2313              
2314             sub vacant {
2315 0     0 1 0 my ($self) = @_;
2316              
2317 0         0 return ~($self->[CP_POS_WHITE_PIECES] | $self->[CP_POS_BLACK_PIECES]);
2318             }
2319              
2320             sub halfMoves {
2321 0     0 1 0 shift->[CP_POS_HALF_MOVES];
2322             }
2323              
2324             sub halfMoveClock {
2325 0     0 1 0 shift->[CP_POS_HALF_MOVE_CLOCK];
2326             }
2327              
2328             sub reversibleClock {
2329 705728     705728 1 1232605 shift->[CP_POS_REVERSIBLE_CLOCK];
2330             }
2331              
2332             sub info {
2333 0     0 1 0 shift->[CP_POS_INFO];
2334             }
2335              
2336             sub evasionSquares {
2337 0     0 1 0 shift->[CP_POS_EVASION_SQUARES];
2338             }
2339              
2340             sub signature {
2341 4560     4560 1 234180 shift->[CP_POS_SIGNATURE];
2342             }
2343              
2344             sub inCheck {
2345 16321     16321 1 43819 shift->[CP_POS_IN_CHECK];
2346             }
2347              
2348             sub toFEN {
2349 4424     4424 1 349244 my ($self) = @_;
2350              
2351 4424         8071 my $w_pieces = $self->[CP_POS_WHITE_PIECES];
2352 4424         5273 my $b_pieces = $self->[CP_POS_BLACK_PIECES];
2353 4424         6156 my $pieces = $w_pieces | $b_pieces;
2354 4424         5255 my $pawns = $self->[CP_POS_PAWNS];
2355 4424         5054 my $bishops = $self->[CP_POS_BISHOPS];
2356 4424         5420 my $knights = $self->[CP_POS_KNIGHTS];
2357 4424         4878 my $rooks = $self->[CP_POS_ROOKS];
2358 4424         5553 my $queens = $self->[CP_POS_QUEENS];
2359              
2360 4424         5362 my $fen = '';
2361              
2362 4424         8616 for (my $rank = CP_RANK_8; $rank >= CP_RANK_1; --$rank) {
2363 35392         37432 my $empty = 0;
2364 35392         49492 for (my $file = CP_FILE_A; $file <= CP_FILE_H; ++$file) {
2365 283136         340305 my $shift = $self->coordinatesToShift($file, $rank);
2366 283136         305161 my $mask = 1 << $shift;
2367              
2368 283136 100       332080 if ($mask & $pieces) {
2369 107722 100       138288 if ($empty) {
2370 52964         60396 $fen .= $empty;
2371 52964         52609 $empty = 0;
2372             }
2373              
2374 107722 100       146344 if ($mask & $w_pieces) {
    50          
2375 54168 100       79280 if ($mask & $pawns) {
    100          
    100          
    100          
    100          
2376 27643         30879 $fen .= 'P';
2377             } elsif ($mask & $knights) {
2378 5276         5812 $fen .= 'N';
2379             } elsif ($mask & $bishops) {
2380 5559         6170 $fen .= 'B';
2381             } elsif ($mask & $rooks) {
2382 8054         8709 $fen .= 'R';
2383             } elsif ($mask & $queens) {
2384 3212         3547 $fen .= 'Q';
2385             } else {
2386 4424         6213 $fen .= 'K';
2387             }
2388             } elsif ($mask & $b_pieces) {
2389 53554 100       81801 if ($mask & $pawns) {
    100          
    100          
    100          
    100          
2390 27215         28790 $fen .= 'p';
2391             } elsif ($mask & $knights) {
2392 5489         6064 $fen .= 'n';
2393             } elsif ($mask & $bishops) {
2394 5136         5802 $fen .= 'b';
2395             } elsif ($mask & $rooks) {
2396 7935         10186 $fen .= 'r';
2397             } elsif ($mask & $queens) {
2398 3355         3925 $fen .= 'q';
2399             } else {
2400 4424         5052 $fen .= 'k';
2401             }
2402             }
2403             } else {
2404 175414         168979 ++$empty;
2405             }
2406              
2407 283136 100       451226 if ($file == CP_FILE_H) {
2408 35392 100       45248 if ($empty) {
2409 22352         24880 $fen .= $empty;
2410 22352         22124 $empty = 0;
2411             }
2412 35392 100       51443 if ($rank != CP_RANK_1) {
2413 30968         61836 $fen .= '/';
2414             }
2415             }
2416             }
2417             }
2418              
2419 4424 100       7253 $fen .= ($self->toMove == CP_WHITE) ? ' w ' : ' b ';
2420              
2421 4424         8723 my $castling = $self->castlingRights;
2422              
2423 4424 100       6277 if ($castling) {
2424 1460         1814 my $castle = '';
2425 1460 100       2343 $castle .= 'K' if $castling & 0x1;
2426 1460 100       2327 $castle .= 'Q' if $castling & 0x2;
2427 1460 100       2172 $castle .= 'k' if $castling & 0x4;
2428 1460 100       2213 $castle .= 'q' if $castling & 0x8;
2429 1460         2284 $fen .= "$castle ";
2430             } else {
2431 2964         4117 $fen .= '- ';
2432             }
2433              
2434 4424 100       7388 if ($self->enPassantShift) {
2435 309         569 $fen .= $self->shiftToSquare($self->enPassantShift);
2436             } else {
2437 4115         5278 $fen .= '-';
2438             }
2439              
2440 4424         15969 $fen .= sprintf ' %u %u', $self->[CP_POS_HALF_MOVE_CLOCK],
2441             1 + ($self->[CP_POS_HALF_MOVES] >> 1);
2442              
2443 4424         14322 return $fen;
2444             }
2445              
2446             sub board {
2447 0     0 1 0 my ($self) = @_;
2448              
2449 0         0 my $w_pieces = $self->[CP_POS_WHITE_PIECES];
2450 0         0 my $b_pieces = $self->[CP_POS_BLACK_PIECES];
2451 0         0 my $pieces = $w_pieces | $b_pieces;
2452 0         0 my $pawns = $self->[CP_POS_PAWNS];
2453 0         0 my $bishops = $self->[CP_POS_BISHOPS];
2454 0         0 my $knights = $self->[CP_POS_KNIGHTS];
2455 0         0 my $rooks = $self->[CP_POS_ROOKS];
2456 0         0 my $queens = $self->[CP_POS_QUEENS];
2457              
2458 0         0 my $ep_shift = $self->enPassantShift;
2459 0         0 my $board = " a b c d e f g h\n";
2460 0 0       0 if ($self->blackQueenSideCastlingRight) {
2461 0         0 $board .= " +-+-<-<-<-";
2462             } else {
2463 0         0 $board .= " +-+-+-+-+-";
2464             }
2465 0 0       0 if ($self->blackKingSideCastlingRight) {
2466 0         0 $board .= ">->-+-+\n";
2467             } else {
2468 0         0 $board .= "+-+-+-+\n";
2469             }
2470              
2471 0         0 for (my $rank = CP_RANK_8; $rank >= CP_RANK_1; --$rank) {
2472 0         0 $board .= ($rank + 1) . '|';
2473 0         0 for (my $file = CP_FILE_A; $file <= CP_FILE_H; ++$file) {
2474 0         0 my $shift = $self->coordinatesToShift($file, $rank);
2475 0         0 my $mask = 1 << $shift;
2476              
2477 0 0       0 $board .= ' ' if $file != CP_FILE_A;
2478 0 0 0     0 if ($mask & $pieces) {
    0          
2479 0 0       0 if ($mask & $w_pieces) {
    0          
2480 0 0       0 if ($mask & $pawns) {
    0          
    0          
    0          
    0          
2481 0         0 $board .= 'P';
2482             } elsif ($mask & $knights) {
2483 0         0 $board .= 'N';
2484             } elsif ($mask & $bishops) {
2485 0         0 $board .= 'B';
2486             } elsif ($mask & $rooks) {
2487 0         0 $board .= 'R';
2488             } elsif ($mask & $queens) {
2489 0         0 $board .= 'Q';
2490             } else {
2491 0         0 $board .= 'K';
2492             }
2493             } elsif ($mask & $b_pieces) {
2494 0 0       0 if ($mask & $pawns) {
    0          
    0          
    0          
    0          
2495 0         0 $board .= 'p';
2496             } elsif ($mask & $knights) {
2497 0         0 $board .= 'n';
2498             } elsif ($mask & $bishops) {
2499 0         0 $board .= 'b';
2500             } elsif ($mask & $rooks) {
2501 0         0 $board .= 'r';
2502             } elsif ($mask & $queens) {
2503 0         0 $board .= 'q';
2504             } else {
2505 0         0 $board .= 'k';
2506             }
2507             }
2508             } elsif ($ep_shift && $shift == $ep_shift) {
2509 0 0       0 if ($self->toMove == CP_WHITE) {
2510 0         0 $board .= 'v';
2511             } else {
2512 0         0 $board .= '^';
2513             }
2514             } else {
2515 0         0 $board .= '.';
2516             }
2517              
2518 0 0       0 if ($file == CP_FILE_H) {
2519             }
2520             }
2521 0         0 $board .= '|' . ($rank + 1) . "\n";
2522             }
2523              
2524 0 0       0 if ($self->whiteQueenSideCastlingRight) {
2525 0         0 $board .= " +-+-<-<-<-";
2526             } else {
2527 0         0 $board .= " +-+-+-+-+-";
2528             }
2529 0 0       0 if ($self->whiteKingSideCastlingRight) {
2530 0         0 $board .= ">->-+-+\n";
2531             } else {
2532 0         0 $board .= "+-+-+-+\n";
2533             }
2534              
2535 0         0 return $board;
2536             }
2537              
2538             sub legalMoves {
2539 1642     1642 1 18506 my ($self) = @_;
2540              
2541 1642         2397 my @legal;
2542              
2543 1642         4611 foreach my $move ($self->pseudoLegalMoves) {
2544             # Sets also captured piece and color.
2545 62782 100       104559 my $undo_info = $self->doMove($move) or next;
2546 58834         81666 push @legal, $undo_info->[0];
2547 58834         89051 $self->undoMove($undo_info);
2548             }
2549              
2550 1642         11206 return @legal;
2551             }
2552              
2553             sub dumpBitboard {
2554 0     0 1 0 my (undef, $bitboard) = @_;
2555              
2556 0         0 my $output = " a b c d e f g h\n";
2557 0         0 foreach my $rank (reverse(0 .. 7)) {
2558 0         0 $output .= $rank + 1;
2559 0         0 foreach my $file (0 .. 7) {
2560 0         0 my $shift = ($rank << 3) + $file;
2561 0 0       0 if ($bitboard & 1 << $shift) {
2562 0         0 $output .= ' x';
2563             } else {
2564 0         0 $output .= ' .';
2565             }
2566             }
2567 0         0 $output .= ' ' . ($rank + 1) . "\n";
2568             }
2569 0         0 $output .= " a b c d e f g h\n";
2570              
2571 0         0 return $output;
2572             }
2573              
2574             sub SAN {
2575 17     17 1 5030 my ($self, $move, $use_pseudo_legal_moves) = @_;
2576              
2577 17         91 my ($from, $to, $promote, $piece) = (
2578             $self->moveFrom($move),
2579             $self->moveTo($move),
2580             $self->movePromote($move),
2581             $self->movePiece($move),
2582             );
2583              
2584 17 100 100     93 if ($piece == CP_KING && ((($from - $to) & 0x3) == 0x2)) {
2585 4         9 my $to_mask = 1 << $to;
2586 4 100       12 if ($to_mask & CP_G_MASK) {
2587 2         20 return 'O-O';
2588             } else {
2589 2         17 return 'O-O-O';
2590             }
2591             }
2592              
2593             # Avoid extra hassle for queen moves.
2594 13         64 my @pieces = ('', '', 'N', 'B', 'R', 'Q', 'K');
2595              
2596 13         34 my $san = $pieces[$piece];
2597              
2598 13         36 my $from_board = $self->[CP_POS_WHITE_PIECES + $self->toMove]
2599             & $self->[CP_POS_BLACK_PIECES + $piece];
2600              
2601             # Or use legalMoves?
2602 13 50       58 my @legal_moves = $self->legalMoves or return;
2603 13 50       55 my @cmoves = $use_pseudo_legal_moves
2604             ? $self->pseudoLegalMoves : @legal_moves;
2605 13 50       35 return if !@cmoves;
2606              
2607 13         25 my (%files, %ranks);
2608 13         25 my $candidates = 0;
2609             # When we iterate over the moves make sure that we do not count moves that
2610             # just differ in the promotion piece, four times. We do that by just
2611             # stripping off the promotion piece and making the array unique.
2612 327         651 my %cmoves = map { $_ => 1 }
2613 13         35 map { $self->moveSetPromote($_, CP_NO_PIECE) }
  327         476  
2614             @cmoves;
2615 13         139 foreach my $cmove (keys %cmoves) {
2616 321         401 my ($cfrom, $cto) = ($self->moveFrom($cmove), $self->moveTo($cmove));
2617 321 100       528 next if $cto != $to;
2618              
2619 20         30 ++$candidates;
2620 20         65 my ($ffile, $frank) = $self->shiftToCoordinates($cfrom);
2621 20         56 ++$files{$ffile};
2622 20         49 ++$ranks{$frank};
2623             }
2624              
2625 13         32 my $to_mask = 1 << $to;
2626 13         35 my $to_move = $self->toMove;
2627 13         31 my $her_pieces = $self->[CP_POS_WHITE_PIECES + !$to_move];
2628 13         28 my $ep_shift = $self->enPassantShift;
2629 13         50 my @files = ('a' .. 'h');
2630 13         28 my @ranks = ('1' .. '8');
2631 13         27 my ($from_file, $from_rank) = $self->shiftToCoordinates($from);
2632              
2633 13 100       40 if ($candidates > 1) {
2634 5         13 my $numfiles = keys %files;
2635 5         9 my $numranks = keys %ranks;
2636              
2637 5 100       17 if ($numfiles == $candidates) {
    100          
2638 3         7 $san .= $files[$from_file];
2639             } elsif ($numranks == $candidates) {
2640 1         3 $san .= $ranks[$from_rank];
2641             } else {
2642 1         5 $san .= "$files[$from_file]$ranks[$from_rank]";
2643             }
2644             }
2645              
2646 13 50 66     76 if (($to_mask & $her_pieces)
      66        
      66        
2647             || ($ep_shift && $piece == CP_PAWN && $to == $ep_shift)) {
2648             # Capture. For pawn captures we always add the file unless it was
2649             # already added.
2650 7 100 100     36 if ($piece == CP_PAWN && !length $san) {
2651 4         10 $san .= $files[$from_file];
2652             }
2653 7         12 $san .= 'x';
2654             }
2655              
2656 13         43 $san .= $self->shiftToSquare($to);
2657              
2658 13         43 my $promote = $self->movePromote($move);
2659 13 100       36 if ($promote) {
2660 1         3 $san .= "=$pieces[$promote]";
2661             }
2662              
2663 13         46 my $copy = $self->copy;
2664 13 100 66     37 if ($copy->doMove($move) && $copy->inCheck) {
2665 3         13 my @moves = $copy->legalMoves;
2666 3 100       11 if (!@moves) {
2667 1         4 $san .= '#';
2668             } else {
2669 2         5 $san .= '+';
2670             }
2671             }
2672              
2673 13         294 return $san;
2674             }
2675              
2676             sub equals {
2677 841     841 1 206410 my ($self, $other) = @_;
2678              
2679 841 50       2258 return if @$self != @$other;
2680              
2681 841         1921 for (my $i = 0; $i < @$self; ++$i) {
2682 15138 100 100     23050 next if $i == CP_POS_EVASION_SQUARES && !$self->[CP_POS_IN_CHECK];
2683 14335 50       26770 return if $self->[$i] != $other->[$i];
2684             }
2685              
2686 841         2461 return $self;
2687             }
2688              
2689             sub RNG {
2690 30927     30927 1 31247 $cp_random ^= ($cp_random << 21);
2691 30927         30347 $cp_random ^= (($cp_random >> 35) & 0x1fff_ffff);
2692 30927         30402 $cp_random ^= ($cp_random << 4);
2693              
2694 30927         45095 return $cp_random;
2695             }
2696              
2697             sub __parseSAN {
2698 1277     1277   2945 my ($self, $move) = @_;
2699              
2700             # First clean-up but in multiple steps.
2701 1277         2358 my $san = $move;
2702              
2703             # First delete whitespace and dots.
2704 1277         3260 $san =~ s/[ \011-\015\.]//g;
2705              
2706             # So that we can strip-off s possible en-passant notation.
2707 1277         2361 $san =~ s/ep//gi;
2708              
2709             # And now other noise.
2710 1277         3579 $san =~ s/[^a-h0-8pnbrqko]//gi;
2711              
2712 1277         2184 my $pattern;
2713              
2714 1277         3148 my $to_move = $self->toMove;
2715 1277 100       3791 if ($san =~ /^[0oO][0oO]([0oO])?$/) {
2716 36         111 my $queen_side = $1;
2717              
2718 36 100       107 if ($to_move == CP_WHITE) {
2719 20 100       242 if ($queen_side) {
2720 8         25 $pattern = 'Ke1c1';
2721             } else {
2722 12         45 $pattern = 'Ke1g1';
2723             }
2724             } else {
2725 16 100       39 if ($queen_side) {
2726 4         12 $pattern = 'Ke8c8';
2727             } else {
2728 12         26 $pattern = 'Ke8g8';
2729             }
2730             }
2731             } else {
2732 1241         2531 my $piece = '.',
2733             my $from_file = '.';
2734 1241         1781 my $to_file = '.';
2735 1241         1814 my $from_rank = '.';
2736 1241         3159 my $to_rank = '.',
2737             my $promote = '';
2738              
2739             # Before we convert to lowercase, we try to extract the moving piece
2740             # which must always be uppercase.
2741 1241 100       4939 if ($san =~ s/^([PNBRQK])//) {
2742 953         2867 $piece = $1;
2743             }
2744              
2745 1241         4384 my @san = split //, lc $san;
2746              
2747 1241         3372 my %pieces = map { $_ => 1 } qw(p n b r q k);
  7446         18370  
2748              
2749             # Promotion?
2750 1241 100       3985 if (exists $pieces{$san[-1]}) {
2751 24         43 $promote = $san[-1];
2752 24         44 pop @san;
2753             }
2754              
2755             # Target rank?
2756 1241 100 66     7505 if (@san && $san[-1] >= '1' && $san[-1] <= '8') {
      66        
2757 1240         2102 $to_rank = $san[-1];
2758 1240         1972 pop @san;
2759             }
2760              
2761             # Target file?
2762 1241 50 33     8993 if (@san && $san[-1] >= 'a' && $san[-1] <= 'h') {
      33        
2763 1241         2274 $to_file = $san[-1];
2764 1241         1833 pop @san;
2765             }
2766              
2767             # From rank?
2768 1241 100 100     3691 if (@san && $san[-1] >= '1' && $san[-1] <= '8') {
      66        
2769 11         35 $from_rank = $san[-1];
2770 11         16 pop @san;
2771             }
2772              
2773             # From file?
2774 1241 50 66     4155 if (@san && $san[-1] >= 'a' && $san[-1] <= 'h') {
      66        
2775 137         250 $from_file = $san[-1];
2776 137         174 pop @san;
2777             }
2778              
2779             # Leading garbage?
2780 1241 50       2464 return if @san;
2781              
2782 1241         4537 $pattern = join '', $piece,
2783             $from_file, $from_rank, $to_file, $to_rank, $promote;
2784             }
2785              
2786             # Get the legal moves.
2787 1277         3958 my @legal = $self->movesCoordinateNotation($self->legalMoves);
2788              
2789             # Prefix every move with the piece that moves.
2790 1277         5138 my @pieces = qw(X P N B R Q K);
2791 1277         2218 foreach my $move (@legal) {
2792 44078         59451 my $from_square = substr $move, 0, 2;
2793 44078         58924 my $mover = $self->pieceAtSquare($from_square);
2794 44078         82719 $move = $pieces[$mover] . $move;
2795             }
2796              
2797 1277         2240 my @candidates;
2798 1277         2452 @candidates = grep { /^$pattern$/ } @legal;
  44078         107261  
2799              
2800             # We must find exactly one candidate. If we have 0 matches, the move
2801             # could not be parsed. If we have more than 1 match, the move was
2802             # ambiguous.
2803 1277 100 66     4185 if (@candidates != 1 && $move !~ /^[PNBRQK]/) {
2804             # If no piece was explicitely specified, try again with a pawn.
2805 85         320 $pattern =~ s/^./P/;
2806 85         196 @candidates = grep { /^$pattern$/ } @legal;
  3014         6633  
2807             }
2808              
2809 1277 50       2916 return if @candidates != 1;
2810              
2811 1277         2279 $move = $candidates[0];
2812 1277 50       5804 return if $move !~ /^[PNBRQK]([a-h][1-8])([a-h][1-8])([qrbn])?$/;
2813              
2814 1277         4923 return $self->__parseUCIMove($1, $2, $3);
2815             }
2816              
2817             sub perftByUndo {
2818 9729     9729 1 43271 my ($self, $depth) = @_;
2819              
2820 9729         11250 my $nodes = 0;
2821 9729         20485 my @moves = $self->pseudoLegalMoves;
2822 9729         17449 foreach my $move (@moves) {
2823 210261 100       288622 my $undo_info = $self->doMove($move) or next;
2824              
2825 192804 100       283076 if ($depth > 1) {
2826 9671         25268 $nodes += $self->perftByUndo($depth - 1);
2827             } else {
2828 183133         183557 ++$nodes;
2829             }
2830              
2831 192804         274050 $self->undoMove($undo_info);
2832             }
2833              
2834 9729         18167 return $nodes;
2835             }
2836              
2837             sub perftByCopy {
2838 9729     9729 1 15723 my ($class, $pos, $depth) = @_;
2839              
2840 9729         12253 my $nodes = 0;
2841 9729         22121 my @moves = $pos->pseudoLegalMoves;
2842 9729         17148 foreach my $move (@moves) {
2843 210261         496767 my $copy = bless [@$pos], 'Chess::Plisco';
2844 210261 100       344785 $copy->doMove($move) or next;
2845              
2846 192804 100       324463 if ($depth > 1) {
2847 9671         21894 $nodes += $class->perftByCopy($copy, $depth - 1);
2848             } else {
2849 183133         354943 ++$nodes;
2850             }
2851             }
2852              
2853 9729         27184 return $nodes;
2854             }
2855              
2856             sub perftByUndoWithOutput {
2857 0     0 1 0 my ($self, $depth, $fh) = @_;
2858              
2859 0 0       0 return if $depth <= 0;
2860              
2861 0         0 require Time::HiRes;
2862 0         0 my $started = [Time::HiRes::gettimeofday()];
2863              
2864 0         0 my $nodes = 0;
2865              
2866 0         0 my @moves = $self->pseudoLegalMoves;
2867 0         0 foreach my $move (@moves) {
2868 0 0       0 my $undo_info = $self->doMove($move) or next;
2869              
2870 0         0 my $movestr = $self->moveCoordinateNotation($move);
2871              
2872 0         0 $fh->print("$movestr: ");
2873              
2874 0         0 my $subnodes;
2875              
2876 0 0       0 if ($depth > 1) {
2877 0         0 $subnodes = $self->perft($depth - 1);
2878             } else {
2879 0         0 $subnodes = 1;
2880             }
2881              
2882 0         0 $nodes += $subnodes;
2883              
2884 0         0 $fh->print("$subnodes\n");
2885              
2886 0         0 $self->undoMove($undo_info);
2887             }
2888              
2889 39     39   404 no integer;
  39         113  
  39         399  
2890              
2891 0         0 my $elapsed = Time::HiRes::tv_interval($started, [Time::HiRes::gettimeofday()]);
2892              
2893 0         0 my $nps = '+INF';
2894 0 0       0 if ($elapsed) {
2895 0         0 $nps = int (0.5 + $nodes / $elapsed);
2896             }
2897 0         0 $fh->print("info nodes: $nodes ($elapsed s, nps: $nps)\n");
2898              
2899 0         0 return $nodes;
2900             }
2901              
2902             sub perftByCopyWithOutput {
2903 0     0 1 0 my ($self, $depth, $fh) = @_;
2904              
2905 0 0       0 return if $depth <= 0;
2906              
2907 0         0 require Time::HiRes;
2908 0         0 my $started = [Time::HiRes::gettimeofday()];
2909              
2910 0         0 my $nodes = 0;
2911              
2912 0         0 my @moves = $self->pseudoLegalMoves;
2913 0         0 foreach my $move (@moves) {
2914 0         0 my $copy = bless [@$self], 'Chess::Plisco';
2915 0 0       0 $copy->doMove($move) or next;
2916              
2917 0         0 my $movestr = $copy->moveCoordinateNotation($move);
2918              
2919 0         0 $fh->print("$movestr: ");
2920              
2921 0         0 my $subnodes;
2922              
2923 0 0       0 if ($depth > 1) {
2924 0         0 $subnodes = $self->perftByCopy($copy, $depth - 1);
2925             } else {
2926 0         0 $subnodes = 1;
2927             }
2928              
2929 0         0 $nodes += $subnodes;
2930              
2931 0         0 $fh->print("$subnodes\n");
2932             }
2933              
2934 39     39   9903 no integer;
  39         83  
  39         172  
2935              
2936 0         0 my $elapsed = Time::HiRes::tv_interval($started, [Time::HiRes::gettimeofday()]);
2937              
2938 0         0 my $nps = '+INF';
2939 0 0       0 if ($elapsed) {
2940 0         0 $nps = int (0.5 + $nodes / $elapsed);
2941             }
2942 0         0 $fh->print("info nodes: $nodes ($elapsed s, nps: $nps)\n");
2943              
2944 0         0 return $nodes;
2945             }
2946              
2947             sub coordinatesToShift {
2948 332993     332993 1 378631 my (undef, $file, $rank) = @_;
2949              
2950 332993         395936 return ($rank << 3) + $file;
2951             }
2952              
2953             sub coordinatesToSquare {
2954 64     64 1 119 my (undef, $file, $rank) = @_;
2955              
2956 64         289 return chr(97 + $file) . (1 + $rank);
2957             }
2958              
2959             sub shiftToCoordinates {
2960 10081     10081 1 11089 my (undef, $shift) = @_;
2961              
2962 10081         10477 my $file = $shift & 0x7;
2963 10081         10324 my $rank = $shift >> 3;
2964              
2965 10081         13850 return $file, $rank;
2966             }
2967              
2968             sub squareToCoordinates {
2969 64     64 1 27125 my (undef, $square) = @_;
2970              
2971 64         322 return ord($square) - 97, -1 + substr $square, 1;
2972             }
2973              
2974             sub shiftToSquare {
2975 8834     8834 1 199411 my (undef, $shift) = @_;
2976              
2977 8834         9632 my $rank = 1 + ($shift >> 3);
2978 8834         8952 my $file = $shift & 0x7;
2979              
2980 8834         25135 return sprintf '%c%u', $file + ord 'a', $rank;
2981             }
2982              
2983             sub squareToShift {
2984 47233     47233 1 58955 my ($whatever, $square) = @_;
2985              
2986 47233 50       106064 if ($square !~ /^([a-h])([1-8])$/) {
2987 0         0 die __x("Illegal square '{square}'.\n", square => $square);
2988             }
2989              
2990 47233         69435 my $file = ord($1) - ord('a');
2991 47233         58297 my $rank = $2 - 1;
2992              
2993 47233         62734 return $whatever->coordinatesToShift($file, $rank);
2994             }
2995              
2996             sub consistent {
2997 40     40 1 110 my ($self) = @_;
2998              
2999 40         45 my $consistent = 1;
3000              
3001 40         89 my $w_pieces = $self->[CP_POS_WHITE_PIECES];
3002 40         44 my $b_pieces = $self->[CP_POS_BLACK_PIECES];
3003              
3004 40 50       72 if ($w_pieces & $b_pieces) {
3005 0         0 warn "White and black pieces overlap.\n";
3006 0         0 undef $consistent;
3007             }
3008              
3009 40         48 my $occupied = $w_pieces | $b_pieces;
3010 40         46 my $empty = ~$occupied;
3011              
3012 40         43 my $pawns = $self->[CP_POS_PAWNS];
3013 40         43 my $knights = $self->[CP_POS_KNIGHTS];
3014 40         43 my $bishops = $self->[CP_POS_BISHOPS];
3015 40         44 my $rooks = $self->[CP_POS_ROOKS];
3016 40         49 my $queens = $self->[CP_POS_QUEENS];
3017 40         50 my $kings = $self->[CP_POS_KINGS];
3018              
3019 40         48 my $occupied_by_pieces = $pawns | $knights | $bishops | $rooks | $queens
3020             | $kings;
3021 40 50       61 if ($occupied_by_pieces & $empty) {
3022 0 0       0 if ($pawns & $empty) {
3023 0         0 warn "Orphaned pawn(s) (neither black nor white).\n";
3024 0         0 undef $consistent;
3025             }
3026 0 0       0 if ($knights & $empty) {
3027 0         0 warn "Orphaned knight(s) (neither black nor white).\n";
3028 0         0 undef $consistent;
3029             }
3030 0 0       0 if ($bishops & $empty) {
3031 0         0 warn "Orphaned bishop(s) (neither black nor white).\n";
3032 0         0 undef $consistent;
3033             }
3034 0 0       0 if ($rooks & $empty) {
3035 0         0 warn "Orphaned rooks(s) (neither black nor white).\n";
3036 0         0 undef $consistent;
3037             }
3038 0 0       0 if ($queens & $empty) {
3039 0         0 warn "Orphaned queens(s) (neither black nor white).\n";
3040 0         0 undef $consistent;
3041             }
3042 0 0       0 if ($kings & $empty) {
3043 0         0 warn "Orphaned king(s) (neither black nor white).\n";
3044 0         0 undef $consistent;
3045             }
3046             }
3047              
3048 40         49 my $not_occupied_by_pieces = ~$occupied_by_pieces;
3049 40 50       76 if ($not_occupied_by_pieces & $b_pieces) {
    50          
3050 0         0 warn "Square occupied by black without a piece.\n";
3051 0         0 undef $consistent;
3052             } elsif ($not_occupied_by_pieces & $w_pieces) {
3053 0         0 warn "Square occupied by white without a piece.\n";
3054 0         0 undef $consistent;
3055             }
3056              
3057 40 50       57 if ($pawns & $knights) {
3058 0         0 warn "Pawns and knights overlap.\n";
3059 0         0 undef $consistent;
3060             }
3061 40 50       57 if ($pawns & $bishops) {
3062 0         0 warn "Pawns and bishops overlap.\n";
3063 0         0 undef $consistent;
3064             }
3065 40 50       51 if ($pawns & $rooks) {
3066 0         0 warn "Pawns and rooks overlap.\n";
3067 0         0 undef $consistent;
3068             }
3069 40 50       61 if ($pawns & $queens) {
3070 0         0 warn "Pawns and queens overlap.\n";
3071 0         0 undef $consistent;
3072             }
3073 40 50       53 if ($pawns & $kings) {
3074 0         0 warn "Pawns and kings overlap.\n";
3075 0         0 undef $consistent;
3076             }
3077 40 50       67 if ($knights & $bishops) {
3078 0         0 warn "Knights and bishops overlap.\n";
3079 0         0 undef $consistent;
3080             }
3081 40 50       58 if ($knights & $rooks) {
3082 0         0 warn "Knights and rooks overlap.\n";
3083 0         0 undef $consistent;
3084             }
3085 40 50       50 if ($knights & $queens) {
3086 0         0 warn "Knights and queens overlap.\n";
3087 0         0 undef $consistent;
3088             }
3089 40 50       68 if ($knights & $kings) {
3090 0         0 warn "Knights and kings overlap.\n";
3091 0         0 undef $consistent;
3092             }
3093 40 50       51 if ($bishops & $rooks) {
3094 0         0 warn "Bishops and rooks overlap.\n";
3095 0         0 undef $consistent;
3096             }
3097 40 50       66 if ($bishops & $queens) {
3098 0         0 warn "Bishops and queens overlap.\n";
3099 0         0 undef $consistent;
3100             }
3101 40 50       50 if ($bishops & $kings) {
3102 0         0 warn "Bishops and kings overlap.\n";
3103 0         0 undef $consistent;
3104             }
3105 40 50       56 if ($queens & $kings) {
3106 0         0 warn "Queens and kings overlap.\n";
3107 0         0 undef $consistent;
3108             }
3109              
3110 40 50       192 return $self if $consistent;
3111              
3112 0         0 warn $self->dumpAll;
3113              
3114 0         0 return;
3115             }
3116              
3117              
3118             sub pieceAtSquare {
3119 44146     44146 1 104521 my ($self, $square) = @_;
3120              
3121 44146         58953 return $self->pieceAtShift($self->squareToShift($square));
3122             }
3123              
3124             sub pieceAtCoordinates {
3125 64     64 1 49894 my ($self, $file, $rank) = @_;
3126              
3127 64         135 return $self->pieceAtShift($self->coordinatesToShift($file, $rank));
3128             }
3129              
3130             sub pieceAtShift {
3131 328181     328181 1 492519 my ($self, $shift) = @_;
3132              
3133 328181 50       490321 return if $shift < 0;
3134 328181 50       455894 return if $shift > 63;
3135              
3136 328181         363290 my $mask = 1 << $shift;
3137 328181         407397 my ($piece, $color) = (CP_NO_PIECE);
3138 328181 100       607248 if ($mask & $self->[CP_POS_WHITE_PIECES]) {
    100          
3139 62877         74294 $color = CP_WHITE;
3140             } elsif ($mask & $self->[CP_POS_BLACK_PIECES]) {
3141 46660         57564 $color = CP_BLACK;
3142             }
3143              
3144 328181 100       476825 if (defined $color) {
3145 109537 100       257148 if ($mask & $self->[CP_POS_PAWNS]) {
    100          
    100          
    100          
    100          
3146 8067         8584 $piece = CP_PAWN;
3147             } elsif ($mask & $self->[CP_POS_KNIGHTS]) {
3148 19698         24662 $piece = CP_KNIGHT;
3149             } elsif ($mask & $self->[CP_POS_BISHOPS]) {
3150 18347         22104 $piece = CP_BISHOP;
3151             } elsif ($mask & $self->[CP_POS_ROOKS]) {
3152 29497         35724 $piece = CP_ROOK;
3153             } elsif ($mask & $self->[CP_POS_QUEENS]) {
3154 19046         23004 $piece = CP_QUEEN;
3155             } else {
3156 14882         18490 $piece = CP_KING;
3157             }
3158             }
3159              
3160 328181 100       420931 if (wantarray) {
3161 284099         550093 return $piece, $color;
3162             } else {
3163 44082         64597 return $piece;
3164             }
3165             }
3166              
3167             sub moveLegal {
3168 22     22 1 2041 my ($self, $move) = @_;
3169              
3170 22 100       115 if ($move =~ /[a-z]/i) {
3171 1 50       6 $move = $self->parseMove($move) or return;
3172             }
3173              
3174 22         99 my @legal_moves = $self->legalMoves;
3175 22         47 foreach my $legal_move (@legal_moves) {
3176 273 100       610 return $self if $self->moveEquivalent($legal_move, $move);
3177             }
3178              
3179 3         18 return;
3180             }
3181              
3182             sub applyMove {
3183 32     32 1 172 my ($self, $move) = @_;
3184              
3185 32 50       109 if ($move =~ /[a-z]/i) {
3186 32 50       92 $move = $self->parseMove($move) or return;
3187             }
3188              
3189 32         90 return $self->doMove($move);
3190             }
3191              
3192             sub unapplyMove {
3193 13     13 1 6147 my ($self, $state) = @_;
3194              
3195 13 50       29 return if !ref $state;
3196 13 50       45 return if 'ARRAY' ne reftype $state;
3197              
3198 13         28 return $self->undoMove($state);
3199             }
3200              
3201             sub dumpAll {
3202 0     0 1 0 my ($self) = @_;
3203              
3204             my $pad19 = sub {
3205 0     0   0 my $str = $_;
3206 0         0 while (19 > length $str) {
3207 0         0 $str .= ' ';
3208             }
3209              
3210 0         0 return $str;
3211 0         0 };
3212              
3213 0         0 my $output = '';
3214              
3215 0         0 my $w_pieces = $self->dumpBitboard($self->[CP_POS_WHITE_PIECES]);
3216 0         0 my $b_pieces = $self->dumpBitboard($self->[CP_POS_BLACK_PIECES]);
3217 0         0 my @w_pieces = map { $pad19->() } split /\n/, $w_pieces;
  0         0  
3218 0         0 my @b_pieces = map { $pad19->() } split /\n/, $b_pieces;
  0         0  
3219 0         0 $output .= " White Black\n";
3220 0         0 for (my $i = 0; $i < @w_pieces; ++$i) {
3221 0         0 $output .= "$w_pieces[$i] $b_pieces[$i]\n";
3222             }
3223              
3224 0         0 my $pawns = $self->dumpBitboard($self->[CP_POS_PAWNS]);
3225 0         0 my @pawns = map { $pad19->() } split /\n/, $pawns;
  0         0  
3226 0         0 my $knights = $self->dumpBitboard($self->[CP_POS_KNIGHTS]);
3227 0         0 my @knights = map { $pad19->() } split /\n/, $knights;
  0         0  
3228 0         0 $output .= "\n Pawns Knights\n";
3229 0         0 for (my $i = 0; $i < @pawns; ++$i) {
3230 0         0 $output .= "$pawns[$i] $knights[$i]\n";
3231             }
3232              
3233 0         0 my $bishops = $self->dumpBitboard($self->[CP_POS_BISHOPS]);
3234 0         0 my @bishops = split /\n/, $bishops;
3235 0         0 my $rooks = $self->dumpBitboard($self->[CP_POS_ROOKS]);
3236 0         0 my @rooks = map { $pad19->() } split /\n/, $rooks;
  0         0  
3237 0         0 $output .= "\n Bishops Rooks\n";
3238 0         0 for (my $i = 0; $i < @bishops; ++$i) {
3239 0         0 $output .= "$bishops[$i] $rooks[$i]\n";
3240             }
3241              
3242 0         0 my $queens = $self->dumpBitboard($self->[CP_POS_QUEENS]);
3243 0         0 my @queens = split /\n/, $queens;
3244 0         0 my $kings = $self->dumpBitboard($self->[CP_POS_KINGS]);
3245 0         0 my @kings = map { $pad19->() } split /\n/, $kings;
  0         0  
3246 0         0 $output .= "\n Queens Kings\n";
3247 0         0 for (my $i = 0; $i < @queens; ++$i) {
3248 0         0 $output .= "$queens[$i] $kings[$i]\n";
3249             }
3250              
3251 0         0 return $output;
3252             }
3253              
3254             sub dumpInfo {
3255 0     0 1 0 my ($self) = @_;
3256              
3257 0         0 my $output = 'Castling: ';
3258              
3259 0         0 my $castling = $self->castlingRights;
3260 0 0       0 if ($castling) {
3261 0 0       0 $output .= 'K' if $castling & 0x1;
3262 0 0       0 $output .= 'Q' if $castling & 0x2;
3263 0 0       0 $output .= 'k' if $castling & 0x4;
3264 0 0       0 $output .= 'q' if $castling & 0x8;
3265             } else {
3266 0         0 $output .= '- ';
3267             }
3268              
3269 0         0 $output .= "\nTo move: ";
3270 0 0       0 if (CP_WHITE == $self->toMove) {
3271 0         0 $output .= "white\n";
3272             } else {
3273 0         0 $output .= "black\n";
3274             }
3275              
3276 0         0 $output .= 'En passant square: ';
3277 0 0       0 if ($self->enPassantShift) {
3278 0         0 $output .= $self->shiftToSquare($self->enPassantShift);
3279             } else {
3280 0         0 $output .= '-';
3281             }
3282              
3283 0         0 $output .= "\nKing to move: ";
3284 0         0 $output .= $self->shiftToSquare($self->kingShift);
3285 0         0 $output .= "\n";
3286              
3287 0         0 my $checkers = $self->[CP_POS_IN_CHECK];
3288 0 0       0 if ($checkers) {
3289 0         0 $output .= "In check: yes\n";
3290              
3291 0         0 my $evasion_strategy = $self->evasion;
3292 0         0 $output .= 'Check evasion strategies: ';
3293 0 0       0 if ($evasion_strategy == CP_EVASION_ALL) {
    0          
    0          
3294 0         0 $output .= "king move, capture, block\n";
3295             } elsif ($evasion_strategy == CP_EVASION_CAPTURE) {
3296 0         0 $output .= "king move, capture\n";
3297             } elsif ($evasion_strategy == CP_EVASION_KING_MOVE) {
3298 0         0 $output .= "king move\n";
3299             } else {
3300 0         0 $output .= "$evasion_strategy (?)\n";
3301             }
3302              
3303 0         0 $output .= "Check evasion squares:\n";
3304 0         0 $output .= $self->dumpBitboard($self->[CP_POS_EVASION_SQUARES]);
3305              
3306 0         0 $output .= "Checkers:\n";
3307 0         0 $output .= $self->dumpBitboard($self->[CP_POS_IN_CHECK]);
3308             } else {
3309 0         0 $output .= "In check: no\n";
3310             }
3311              
3312 0         0 my $signature = $self->signature;
3313 0         0 $output .= "Signature: $signature\n";
3314              
3315 0         0 return $output;
3316             }
3317              
3318             sub movesCoordinateNotation {
3319 3517     3517 1 9599 my ($class, @moves) = @_;
3320              
3321 3517         7292 foreach my $move (@moves) {
3322 49245         70277 $move = moveCoordinateNotation(undef, $move);
3323             }
3324              
3325 3517         36212 return @moves;
3326             }
3327              
3328             sub moveNumbers {
3329 11     11 1 30 my ($class);
3330              
3331 11         23467 return @move_numbers;
3332             }
3333              
3334             ###########################################################################
3335             # Generate lookup tables.
3336             ###########################################################################
3337              
3338             # This would be slightly more efficient in one giant loop but with separate
3339             # loops for each variable, it is easier to understand and maintain.
3340              
3341             # King attack masks.
3342             for my $shift (0 .. 63) {
3343             my ($file, $rank) = shiftToCoordinates undef, $shift;
3344              
3345             my $mask = 0;
3346              
3347             # East.
3348             $mask |= (1 << ($shift + 1)) if $file < 7;
3349              
3350             # South-east.
3351             $mask |= (1 << ($shift - 7)) if $file < 7 && $rank > 0;
3352              
3353             # South.
3354             $mask |= (1 << ($shift - 8)) if $rank > 0;
3355              
3356             # South-west.
3357             $mask |= (1 << ($shift - 9)) if $file > 0 && $rank > 0;
3358              
3359             # West.
3360             $mask |= (1 << ($shift - 1)) if $file > 0;
3361              
3362             # North-west.
3363             $mask |= (1 << ($shift + 7)) if $file > 0 && $rank < 7;
3364              
3365             # North.
3366             $mask |= (1 << ($shift + 8)) if $rank < 7;
3367              
3368             # North-east.
3369             $mask |= (1 << ($shift + 9)) if $file < 7 && $rank < 7;
3370              
3371             $king_attack_masks[$shift] = $mask;
3372             }
3373              
3374             # Knight attack masks.
3375             for my $shift (0 .. 63) {
3376             my ($file, $rank) = shiftToCoordinates undef, $shift;
3377              
3378             my $mask = 0;
3379              
3380             # North-north-east.
3381             $mask |= (1 << ($shift + 17)) if $file < 7 && $rank < 6;
3382              
3383             # North-east-east.
3384             $mask |= (1 << ($shift + 10)) if $file < 6 && $rank < 7;
3385              
3386             # South-east-east.
3387             $mask |= (1 << ($shift - 6)) if $file < 6 && $rank > 0;
3388              
3389             # South-south-east.
3390             $mask |= (1 << ($shift - 15)) if $file < 7&& $rank > 1;
3391              
3392             # South-south-west.
3393             $mask |= (1 << ($shift - 17)) if $file > 0 && $rank > 1;
3394              
3395             # South-west-west.
3396             $mask |= (1 << ($shift - 10)) if $file > 1 && $rank > 0;
3397              
3398             # North-west-west.
3399             $mask |= (1 << ($shift + 6)) if $file > 1 && $rank < 7;
3400              
3401             # North-north-west.
3402             $mask |= (1 << ($shift + 15)) if $file > 0 && $rank < 6;
3403              
3404             $knight_attack_masks[$shift] = $mask;
3405             }
3406              
3407             # Pawn masks.
3408             my @white_pawn_single_masks;
3409             for my $shift (0 .. 63) {
3410             push @white_pawn_single_masks, 1 << ($shift + 8);
3411             }
3412             my @white_pawn_double_masks;
3413             for my $shift (0 .. 63) {
3414             if ($shift >= 8 && $shift <= 15) {
3415             push @white_pawn_double_masks, 1 << ($shift + 16);
3416             } else {
3417             push @white_pawn_double_masks, 0;
3418             }
3419             }
3420             my @white_pawn_capture_masks;
3421             for my $shift (0 .. 63) {
3422             my ($file, $rank) = shiftToCoordinates undef, $shift;
3423             my $mask = 0;
3424             if ($file > 0) {
3425             $mask |= 1 << ($shift + 7);
3426             }
3427             if ($file < 7) {
3428             $mask |= 1 << ($shift + 9);
3429             }
3430             push @white_pawn_capture_masks, $mask;
3431             }
3432             $pawn_masks[CP_WHITE] = [\@white_pawn_single_masks, \@white_pawn_double_masks,
3433             \@white_pawn_capture_masks];
3434              
3435             my @black_pawn_single_masks;
3436             for my $shift (0 .. 63) {
3437             push @black_pawn_single_masks, 1 << ($shift - 8);
3438             }
3439             my @black_pawn_double_masks;
3440             for my $shift (0 .. 63) {
3441             if ($shift >= 48 && $shift <= 55) {
3442             push @black_pawn_double_masks, 1 << ($shift - 16);
3443             } else {
3444             push @black_pawn_double_masks, 0;
3445             }
3446             }
3447             my @black_pawn_capture_masks;
3448             for my $shift (0 .. 63) {
3449             my ($file, $rank) = shiftToCoordinates undef, $shift;
3450             my $mask = 0;
3451             if ($file > 0) {
3452             $mask |= 1 << ($shift - 9);
3453             }
3454             if ($file < 7) {
3455             $mask |= 1 << ($shift - 7);
3456             }
3457             push @black_pawn_capture_masks, $mask;
3458             }
3459             $pawn_masks[CP_BLACK] = [\@black_pawn_single_masks, \@black_pawn_double_masks,
3460             \@black_pawn_capture_masks];
3461              
3462             # Map en passant squares to masks.
3463             foreach my $shift (16 .. 23) {
3464             $ep_pawn_masks[$shift] = 1 << ($shift + 8);
3465             }
3466             foreach my $shift (40 .. 47) {
3467             $ep_pawn_masks[$shift] = 1 << ($shift - 8);
3468             }
3469              
3470             # Common lines.
3471             for (my $i = 0; $i < 63; ++$i) {
3472             $common_lines[$i] = [];
3473             for (my $j = 0; $j < 63; ++$j) {
3474             $common_lines[$i]->[$j] = [];
3475             }
3476             }
3477              
3478             # Mask lookup for files and ranks for rooks.
3479             foreach my $m1 (
3480             CP_1_MASK, CP_2_MASK, CP_3_MASK, CP_4_MASK,
3481             CP_5_MASK, CP_6_MASK, CP_7_MASK, CP_8_MASK,
3482             CP_A_MASK, CP_B_MASK, CP_C_MASK, CP_D_MASK,
3483             CP_E_MASK, CP_F_MASK, CP_G_MASK, CP_H_MASK,
3484             ) {
3485             my $m2 = $m1;
3486             my @shifts;
3487             while ($m2) {
3488             push @shifts, bitboardCountTrailingZbits(undef, $m2);
3489             $m2 = bitboardClearLeastSet(undef, $m2);
3490             }
3491              
3492             foreach my $i (@shifts) {
3493             foreach my $j (@shifts) {
3494             my $mask = $m1;
3495             # Clear all bits that are not between i and j.
3496             for my $k (0 .. 63) {
3497             my $d1 = $i - $k;
3498             my $d2 = $j - $k;
3499             if ($d1 * $d2 > 0) {
3500             $mask &= ~(1 << $k);
3501             }
3502              
3503             }
3504             $common_lines[$i]->[$j] = [1, $m1, $mask];
3505             }
3506             }
3507             }
3508              
3509             # Mask lookup for diagonals for bishops. The short diagonals with 1 or 2
3510             # squares only are omitted because they cannot be used for pins.
3511             foreach my $m1 (
3512             CP_F1H3_MASK, CP_E1H4_MASK, CP_D1H5_MASK, CP_C1H6_MASK, CP_B1H7_MASK,
3513             CP_A1H8_MASK,
3514             CP_A2G8_MASK, CP_A3F8_MASK, CP_A4E8_MASK, CP_A5D8_MASK, CP_A6C8_MASK,
3515             CP_C1A3_MASK, CP_D1A4_MASK, CP_E1A5_MASK, CP_F1A6_MASK, CP_G1A7_MASK,
3516             CP_H1A8_MASK,
3517             CP_H2B8_MASK, CP_H3C8_MASK, CP_H4D8_MASK, CP_H5E8_MASK, CP_H6F8_MASK,
3518             ) {
3519             my $m2 = $m1;
3520             my @shifts;
3521             while ($m2) {
3522             push @shifts, bitboardCountTrailingZbits(undef, $m2);
3523             $m2 = bitboardClearLeastSet(undef, $m2);
3524             }
3525              
3526             foreach my $i (@shifts) {
3527             foreach my $j (@shifts) {
3528             my $mask = $m1;
3529             # Clear all bits that are not between i and j.
3530             for my $k (0 .. 63) {
3531             my $d1 = $i - $k;
3532             my $d2 = $j - $k;
3533             if ($d1 * $d2 > 0) {
3534             $mask &= ~(1 << $k);
3535             }
3536              
3537             }
3538             $common_lines[$i]->[$j] = [0, $m1, $mask];
3539             }
3540             }
3541             }
3542              
3543             # The indices are the target squares of the king.
3544             $castling_rook_move_masks[CP_C1] = CP_1_MASK & (CP_A_MASK | CP_D_MASK);
3545             $castling_rook_move_masks[CP_G1] = CP_1_MASK & (CP_H_MASK | CP_F_MASK);
3546             $castling_rook_move_masks[CP_C8] = CP_8_MASK & (CP_A_MASK | CP_D_MASK);
3547             $castling_rook_move_masks[CP_G8] = CP_8_MASK & (CP_H_MASK | CP_F_MASK);
3548              
3549             $castling_rook_to_mask[CP_C1] = 1 << CP_D1;
3550             $castling_rook_to_mask[CP_G1] = 1 << CP_F1;
3551             $castling_rook_to_mask[CP_C8] = 1 << CP_D8;
3552             $castling_rook_to_mask[CP_G8] = 1 << CP_F8;
3553              
3554             # The indices are the original squares of the rooks.
3555             @castling_rights_rook_masks = (-1) x 64;
3556             $castling_rights_rook_masks[CP_H1] = ~0x1;
3557             $castling_rights_rook_masks[CP_A1] = ~0x2;
3558             $castling_rights_rook_masks[CP_H8] = ~0x4;
3559             $castling_rights_rook_masks[CP_A8] = ~0x8;
3560              
3561             my @piece_values = (0, CP_PAWN_VALUE, CP_KNIGHT_VALUE, CP_BISHOP_VALUE,
3562             CP_ROOK_VALUE, CP_QUEEN_VALUE);
3563             @material_deltas = (0) x (1 + (1 | (CP_QUEEN << 1) | (CP_QUEEN << 4)));
3564             foreach my $captured (CP_NO_PIECE, CP_PAWN, CP_KNIGHT, CP_BISHOP, CP_ROOK, CP_QUEEN) {
3565             $material_deltas[CP_WHITE | ($captured << 4)] = ($piece_values[$captured] << 19);
3566             $material_deltas[CP_BLACK | ($captured << 4)] = (-$piece_values[$captured] << 19);
3567             foreach my $promote (CP_KNIGHT, CP_BISHOP, CP_ROOK, CP_QUEEN) {
3568             $material_deltas[CP_WHITE | ($promote << 1) | ($captured << 4)] =
3569             ($piece_values[$captured] + $piece_values[$promote] - CP_PAWN_VALUE) << 19;
3570             $material_deltas[CP_BLACK | ($promote << 1) | ($captured << 4)] =
3571             -($piece_values[$captured] + $piece_values[$promote] - CP_PAWN_VALUE) << 19;
3572             }
3573             }
3574              
3575             # Obscured masks.
3576             #
3577             # If a sliding pieces moves from FROM to TO, sliding pieces of the same type
3578             # may now also attack TO. The obscured_masks give the answer to the question
3579             # which squares had been previously obscured.
3580             foreach my $from (0 .. 63) {
3581             $obscured_masks[$from] = [(0) x 64];
3582             my $from_mask = 1 << $from;
3583             foreach my $to (0 .. 63) {
3584             my $common = $common_lines[$from]->[$to] or next;
3585              
3586             my ($type, $diagonal, $common) = @$common;
3587              
3588             # If $from is less than $to, all bits of the diagonal that are less
3589             # than from constitute the obscure squares, otherwise all bits that are
3590             # greater than from.
3591             if ($from < $to) {
3592             $obscured_masks[$from]->[$to] = $diagonal & ($from_mask - 1);
3593             } else {
3594             $obscured_masks[$from]->[$to] = $diagonal & ~($from_mask - 1) & ~$from_mask;
3595             }
3596             }
3597             }
3598              
3599             # Zobrist keys.
3600             my %zk_seen;
3601             for (my $i = 0; $i < 768; ++$i) {
3602             push @zk_pieces, RNG();
3603             }
3604             for (my $i = 0; $i < 16; ++$i) {
3605             push @zk_castling, RNG();
3606             }
3607             for (my $i = 0; $i < 8; ++$i) {
3608             push @zk_ep_files, RNG();
3609             }
3610             $zk_color = RNG();
3611              
3612             @zk_move_masks = (0) x 0x40_0000;
3613             # Moves:
3614             # 0-5: to
3615             # 6-11: from
3616             # 12-14: promote
3617             # 15-17: piece
3618             # 18-20: captured
3619             # 21: color
3620             my $gen_moves = sub {
3621             my ($moves, $piece, $from, $to, $color) = @_;
3622             my $move = $to | ($from << 6) | ($piece << 15) | ($color << 21);
3623             push @$moves, $move if $piece != CP_PAWN;
3624             push @$moves, $move | (CP_PAWN << 18);
3625             push @$moves, $move | (CP_KNIGHT << 18);
3626             push @$moves, $move | (CP_BISHOP << 18);
3627             push @$moves, $move | (CP_ROOK << 18);
3628             push @$moves, $move | (CP_QUEEN << 18);
3629              
3630             # En passant.
3631             if ($color == CP_WHITE && $piece == CP_PAWN && $to >= CP_A6 && $to <= CP_H6) {
3632             push @$moves, $move | (CP_KING << 18);
3633             } elsif ($color == CP_BLACK && $piece == CP_PAWN && $to >= CP_A3 && $to <= CP_H3) {
3634             push @$moves, $move | (CP_KING << 18);
3635             }
3636             };
3637             my $gen_promotions = sub {
3638             my ($moves, $from, $color) = @_;
3639             my $move = ($from << 6) | (CP_PAWN << 15) | ($color << 21);
3640             my $to = $color ? $from - 8 : $from + 8;
3641             # Normal promotions.
3642             push @$moves, $move | (CP_QUEEN << 12) | $to;
3643             push @$moves, $move | (CP_ROOK << 12) | $to;
3644             push @$moves, $move | (CP_BISHOP << 12) | $to;
3645             push @$moves, $move | (CP_KNIGHT << 12) | $to;
3646             # Promotions with captures to the left-side.
3647             if (($from & 0x7) != CP_FILE_A) {
3648             $to = $color ? $from - 9 : $from + 7;
3649             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_KNIGHT << 18);
3650             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_BISHOP << 18);
3651             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_ROOK << 18);
3652             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_QUEEN << 18);
3653             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_KNIGHT << 18);
3654             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_BISHOP << 18);
3655             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_ROOK << 18);
3656             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_QUEEN << 18);
3657             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_KNIGHT << 18);
3658             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_BISHOP << 18);
3659             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_ROOK << 18);
3660             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_QUEEN << 18);
3661             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_KNIGHT << 18);
3662             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_BISHOP << 18);
3663             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_ROOK << 18);
3664             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_QUEEN << 18);
3665             }
3666             # Promotions with captures to the right-side.
3667             if (($from & 0x7) != CP_FILE_H) {
3668             $to = $color ? $from - 7 : $from + 9;
3669             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_KNIGHT << 18);
3670             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_BISHOP << 18);
3671             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_ROOK << 18);
3672             push @$moves, $move | (CP_QUEEN << 12) | $to | (CP_QUEEN << 18);
3673             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_KNIGHT << 18);
3674             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_BISHOP << 18);
3675             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_ROOK << 18);
3676             push @$moves, $move | (CP_ROOK << 12) | $to | (CP_QUEEN << 18);
3677             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_KNIGHT << 18);
3678             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_BISHOP << 18);
3679             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_ROOK << 18);
3680             push @$moves, $move | (CP_BISHOP << 12) | $to | (CP_QUEEN << 18);
3681             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_KNIGHT << 18);
3682             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_BISHOP << 18);
3683             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_ROOK << 18);
3684             push @$moves, $move | (CP_KNIGHT << 12) | $to | (CP_QUEEN << 18);
3685             }
3686             };
3687              
3688             foreach my $file (CP_FILE_A .. CP_FILE_H) {
3689             my $mb = 1 << 21;
3690             foreach my $rank (CP_RANK_1 .. CP_RANK_8) {
3691             my @moves;
3692             my $from = coordinatesToShift(undef, $file, $rank);
3693             my $move_from = $from << 6;
3694              
3695             # Pawn moves.
3696             if ($rank == CP_RANK_2) {
3697             # White single step.
3698             push @moves, ((CP_PAWN << 15) | ($move_from) | $from + 8);
3699             # White double step.
3700             push @moves, ((CP_PAWN << 15) | ($move_from) | $from + 16);
3701             # White captures.
3702             $gen_moves->(\@moves, CP_PAWN, $from, $from + 7, CP_WHITE)
3703             if $file != CP_FILE_A;
3704             $gen_moves->(\@moves, CP_PAWN, $from, $from + 9, CP_WHITE)
3705             if $file != CP_FILE_H;
3706             # Black promotions.
3707             $gen_promotions->(\@moves, $from, CP_BLACK);
3708             } elsif ($rank > CP_RANK_2 && $rank < CP_RANK_7) {
3709             # White single steps.
3710             push @moves, ((CP_PAWN << 15) | ($move_from) | $from + 8);
3711             # White captures.
3712             $gen_moves->(\@moves, CP_PAWN, $from, $from + 7, CP_WHITE)
3713             if $file != CP_FILE_A;
3714             $gen_moves->(\@moves, CP_PAWN, $from, $from + 9, CP_WHITE)
3715             if $file != CP_FILE_H;
3716             # Black single steps.
3717             push @moves, ((CP_PAWN << 15) | ($move_from) | $from - 8) | $mb;
3718             # Black captures.
3719             $gen_moves->(\@moves, CP_PAWN, $from, $from - 9, CP_BLACK)
3720             if $file != CP_FILE_A;
3721             $gen_moves->(\@moves, CP_PAWN, $from, $from - 7, CP_BLACK)
3722             if $file != CP_FILE_H;
3723             } elsif ($rank == CP_RANK_7) {
3724             # Black single step.
3725             push @moves, ((CP_PAWN << 15) | ($move_from) | $from - 8) | $mb;
3726             # Black double step.
3727             push @moves, ((CP_PAWN << 15) | ($move_from) | $from - 16) | $mb;
3728             # Black captures.
3729             $gen_moves->(\@moves, CP_PAWN, $from, $from - 9, CP_BLACK)
3730             if $file != CP_FILE_A;
3731             $gen_moves->(\@moves, CP_PAWN, $from, $from - 7, CP_BLACK)
3732             if $file != CP_FILE_H;
3733             # White promotions.
3734             $gen_promotions->(\@moves, $from, CP_WHITE);
3735             }
3736              
3737             # Knight moves.
3738             my $attack_mask = $knight_attack_masks[$from];
3739             while ($attack_mask) {
3740             my $to = bitboardCountTrailingZbits(undef, $attack_mask);
3741             $gen_moves->(\@moves, CP_KNIGHT, $from, $to, CP_WHITE);
3742             $gen_moves->(\@moves, CP_KNIGHT, $from, $to, CP_BLACK);
3743             $attack_mask = bitboardClearLeastSet(undef, $attack_mask);
3744             }
3745              
3746             # Bishop and bishop-style queen moves.
3747             my ($to, $to_file, $to_rank);
3748             # North-east.
3749             $to = $from;
3750             for (my ($to_file, $to_rank) = ($file + 1, $rank + 1);
3751             $to_file <= CP_FILE_H && $to_rank <= CP_RANK_8;
3752             ++$to_file, ++$to_rank) {
3753             $to += 9;
3754             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_WHITE);
3755             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_BLACK);
3756             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3757             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3758             }
3759             # South-east.
3760             $to = $from;
3761             for (my ($to_file, $to_rank) = ($file + 1, $rank - 1);
3762             $to_file <= CP_FILE_H && $to_rank >= CP_RANK_1;
3763             ++$to_file, --$to_rank) {
3764             $to -= 7;
3765             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_WHITE);
3766             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_BLACK);
3767             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3768             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3769             }
3770             # South-west.
3771             $to = $from;
3772             for (my ($to_file, $to_rank) = ($file - 1, $rank - 1);
3773             $to_file >= CP_FILE_A && $to_rank >= CP_RANK_1;
3774             --$to_file, --$to_rank) {
3775             $to -= 9;
3776             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_WHITE);
3777             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_BLACK);
3778             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3779             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3780             }
3781             # North-west.
3782             $to = $from;
3783             for (my ($to_file, $to_rank) = ($file - 1, $rank + 1);
3784             $to_file >= CP_FILE_A && $to_rank <= CP_RANK_8;
3785             --$to_file, ++$to_rank) {
3786             $to += 7;
3787             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_WHITE);
3788             $gen_moves->(\@moves, CP_BISHOP, $from, $to, CP_BLACK);
3789             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3790             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3791             }
3792              
3793             # Rook and rook-style queen moves.
3794             foreach my $dist_to (-7 .. -1, +1 .. +7) {
3795             my $to = $from + $dist_to;
3796             next if $to < 0 || $to > 63;
3797             if (($from & 0x38) == ($to & 0x38)) {
3798             $gen_moves->(\@moves, CP_ROOK, $from, $to, CP_WHITE);
3799             $gen_moves->(\@moves, CP_ROOK, $from, $to, CP_BLACK);
3800             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3801             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3802             }
3803             }
3804             foreach my $dist_to (-7 .. -1, +1 .. +7) {
3805             my $to = $from + 8 * $dist_to;
3806             next if $to < 0 || $to > 63;
3807             if (($from & 0x7) == ($to & 0x7)) {
3808             $gen_moves->(\@moves, CP_ROOK, $from, $to, CP_WHITE);
3809             $gen_moves->(\@moves, CP_ROOK, $from, $to, CP_BLACK);
3810             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_WHITE);
3811             $gen_moves->(\@moves, CP_QUEEN, $from, $to, CP_BLACK);
3812             }
3813             }
3814              
3815             # King moves.
3816             $attack_mask = $king_attack_masks[$from];
3817             while ($attack_mask) {
3818             my $to = bitboardCountTrailingZbits(undef, $attack_mask);
3819             $gen_moves->(\@moves, CP_KING, $from, $to, CP_WHITE);
3820             $gen_moves->(\@moves, CP_KING, $from, $to, CP_BLACK);
3821             $attack_mask = bitboardClearLeastSet(undef, $attack_mask);
3822             }
3823              
3824             # Castlings.
3825             if ($from == CP_E1) {
3826             push @moves, ((CP_KING << 15) | (CP_E1 << 6) | CP_G1);
3827             push @moves, ((CP_KING << 15) | (CP_E1 << 6) | CP_C1);
3828             } elsif ($from == CP_E8) {
3829             push @moves, ((CP_KING << 15) | (CP_E8 << 6) | CP_G8) | $mb;
3830             push @moves, ((CP_KING << 15) | (CP_E8 << 6) | CP_C8) | $mb;
3831             }
3832              
3833             push @move_numbers, @moves;
3834              
3835             foreach my $move (@moves) {
3836             my $is_ep;
3837             my $color = 1 & ($move >> 21);
3838             my $captured = 0x7 & ($move >> 18);
3839             if ($captured == CP_KING) {
3840             $captured = CP_PAWN;
3841             $is_ep = 1;
3842             }
3843             my ($to, $from, $promote, $piece) = (
3844             moveTo(undef, $move),
3845             moveFrom(undef, $move),
3846             movePromote(undef, $move),
3847             movePiece(undef, $move),
3848             );
3849              
3850             my $zk_update = __zobristKeyLookup(undef, $piece, $color, $from)
3851             ^ __zobristKeyLookup(undef, $piece, $color, $to);
3852              
3853             $zk_update ^= $zk_color;
3854              
3855             # Castling?
3856             if ($piece == CP_KING && (($from - $to) & 0x3) == 0x2) {
3857             my ($rook_from, $rook_to);
3858             if ($color) {
3859             if ($to > $from) {
3860             ($rook_from, $rook_to) = (CP_H8, CP_F8);
3861             } else {
3862             ($rook_from, $rook_to) = (CP_A8, CP_D8);
3863             }
3864             } else {
3865             if ($to > $from) {
3866             ($rook_from, $rook_to) = (CP_H1, CP_F1);
3867             } else {
3868             ($rook_from, $rook_to) = (CP_A1, CP_D1);
3869             }
3870             }
3871             $zk_update ^= __zobristKeyLookup(undef, CP_ROOK, $color, $rook_from)
3872             ^ __zobristKeyLookup(undef, CP_ROOK, $color, $rook_to);
3873             } elsif ($is_ep) {
3874             my $ep_file = $to & 0x7;
3875             my $ep_shift = $color ? $to + 8 : $to - 8;
3876             $zk_update ^= __zobristKeyLookup(undef, CP_PAWN, !$color, $ep_shift);
3877             } elsif (CP_PAWN == $piece
3878             && (($to - $from == 16) || ($to - $from == -16))) {
3879             # Pawn double step?
3880             $zk_update ^= $zk_ep_files[$from & 0x7];
3881             } elsif ($captured) {
3882             $zk_update ^= __zobristKeyLookup(undef, $captured, !$color, $to);
3883             }
3884              
3885             if ($promote) {
3886             $zk_update ^= __zobristKeyLookup(undef, CP_PAWN, $color, $to);
3887             $zk_update ^= __zobristKeyLookup(undef, $promote, $color, $to);
3888             }
3889              
3890             $zk_move_masks[$move] = $zk_update;
3891             }
3892             }
3893             }
3894              
3895             # Magic moves.
3896             sub __initmagicmoves_occ {
3897 4198272     4198272   5065863 my ($squares, $linocc) = @_;
3898              
3899 4198272         4281220 my $ret = 0;
3900 4198272         6241215 for (my $i = 0; $i < @$squares; ++$i) {
3901 44603520 100       65507557 if ($linocc & (1 << $i)) {
3902 22301760         32450688 $ret |= (1 << $squares->[$i]);
3903             }
3904             }
3905              
3906 4198272         5415976 return $ret;
3907             }
3908              
3909             sub __initmagicmoves_Rmoves {
3910 3993600     3993600   4600006 my ($square, $occ) = @_;
3911              
3912 3993600         3942491 my $ret = 0;
3913 3993600         3868422 my $bit;
3914 3993600         3958166 my $bit_8_mask = (1 << (64 - 8)) - 1;
3915 3993600         3884256 my $bit_1_mask = (1 << (64 - 1)) - 1;
3916 3993600         4342699 my $rowbits = (0xFF) << (8 * ($square / 8));
3917              
3918 3993600         3961789 $bit = 1 << $square;
3919 3993600   100     3853118 do {
3920 7188480         7034422 $bit <<= 8;
3921 7188480         14363331 $ret |= $bit;
3922             } while ($bit && !($bit & $occ));
3923              
3924 3993600         3990707 $bit = 1 << $square;
3925 3993600   100     3847300 do {
3926 7188480         7057767 $bit >>= 8;
3927 7188480         7004101 $bit &= $bit_8_mask;
3928 7188480         13819293 $ret |= $bit;
3929             } while ($bit && !($bit & $occ));
3930              
3931 3993600         3940130 $bit = 1 << $square;
3932             {
3933 3993600         3867762 do {
  3993600         3874455  
3934 7188480         6984451 $bit <<= 1;
3935 7188480 100       8738004 if ($bit & $rowbits) {
3936 5591040         7867451 $ret |= $bit;
3937             } else {
3938 1597440         1656334 last;
3939             }
3940             } while (!($bit & $occ));
3941             }
3942              
3943 3993600         3937703 $bit = (1 << $square);
3944             {
3945 3993600         3820680 do {
  3993600         3854241  
3946 7188480         7009062 $bit >>= 1;
3947 7188480         7077424 $bit &= $bit_1_mask;
3948 7188480 100       8598128 if ($bit & $rowbits) {
3949 5591040         7752948 $ret |= $bit; }
3950             else {
3951 1597440         1658815 last;
3952             }
3953             } while (!($bit & $occ));
3954             }
3955            
3956 3993600         8582423 return $ret;
3957             }
3958              
3959             sub __initmagicmoves_Bmoves {
3960 204672     204672   234043 my ($square, $occ) = @_;
3961 204672         202273 my $ret = 0;
3962 204672         213625 my $bit;
3963             my $bit2;
3964 204672         230135 my $rowbits = ((0xFF) << (8 * ($square / 8)));
3965 204672         201497 my $bit_7_mask = (1 << (64 - 7)) - 1;
3966 204672         196660 my $bit_9_mask = (1 << (64 - 9)) - 1;
3967 204672         203339 my $bit2_sign_mask = (1 << 63) - 1;
3968              
3969 204672         199797 $bit = (1 << $square);
3970 204672         202880 $bit2 = $bit;
3971             {
3972 204672   100     197563 do {
  204672         195882  
3973 386880         382636 $bit <<= 8 - 1;
3974 386880         371335 $bit2 >>= 1;
3975 386880         375777 $bit2 &= $bit2_sign_mask;
3976 386880 100       465396 if ($bit2 & $rowbits) {
3977 338559         734152 $ret |= $bit;
3978             } else {
3979 48321         51411 last;
3980             }
3981             } while ($bit && !($bit & $occ));
3982             }
3983              
3984 204672         204498 $bit = (1 << $square);
3985 204672         205551 $bit2 = $bit;
3986             {
3987 204672   100     210200 do {
  204672         196099  
3988 386880         378697 $bit <<= 8 + 1;
3989 386880         364487 $bit2 <<= 1;
3990 386880 100       460151 if ($bit2 & $rowbits) {
3991 338559         704798 $ret |= $bit;
3992             } else {
3993 48321         51063 last;
3994             }
3995             } while ($bit && !($bit & $occ));
3996             }
3997              
3998 204672         203892 $bit = (1 << $square);
3999 204672         231421 $bit2 = $bit;
4000             {
4001 204672   100     207747 do {
  204672         200859  
4002 386880         377487 $bit >>= 8 - 1;
4003 386880         379604 $bit &= $bit_7_mask;
4004 386880         371837 $bit2 <<= 1;
4005 386880 100       465949 if ($bit2 & $rowbits)
4006             {
4007 338559         713213 $ret |= $bit;
4008             } else {
4009 48321         51244 last;
4010             }
4011             } while ($bit && !($bit & $occ));
4012             }
4013              
4014 204672         202121 $bit = (1 << $square);
4015 204672         203984 $bit2 = $bit;
4016             {
4017 204672   100     196773 do {
  204672         207948  
4018 386880         377808 $bit >>= 8 + 1;
4019 386880         381394 $bit &= $bit_9_mask;
4020 386880         368111 $bit2 >>= 1;
4021 386880         368950 $bit2 &= $bit2_sign_mask;
4022 386880 100       463374 if ($bit2 & $rowbits) {
4023 338559         717783 $ret |= $bit;
4024             } else {
4025 48321         49664 last;
4026             }
4027             } while ($bit && !($bit & $occ));
4028             }
4029              
4030 204672         495671 return $ret;
4031             }
4032              
4033             # Init magicmoves.
4034             my @__initmagicmoves_bitpos64_database = (
4035             63, 0, 58, 1, 59, 47, 53, 2,
4036             60, 39, 48, 27, 54, 33, 42, 3,
4037             61, 51, 37, 40, 49, 18, 28, 20,
4038             55, 30, 34, 11, 43, 14, 22, 4,
4039             62, 57, 46, 52, 38, 26, 32, 41,
4040             50, 36, 17, 19, 29, 10, 13, 21,
4041             56, 45, 25, 31, 35, 16, 9, 12,
4042             44, 24, 15, 8, 23, 7, 6, 5
4043             );
4044              
4045 39     39   274719 use constant MINIMAL_B_BITS_SHIFT => 55;
  39         95  
  39         3301  
4046 39     39   243 use constant MINIMAL_R_BITS_SHIFT => 52;
  39         72  
  39         22769  
4047              
4048             my $b_bits_shift_mask = (1 << (64 - MINIMAL_B_BITS_SHIFT)) - 1;
4049             my $r_bits_shift_mask = (1 << (64 - MINIMAL_R_BITS_SHIFT)) - 1;
4050             my $mask58 = (1 << (64 - 58)) - 1;
4051             for (my $i = 0; $i < 64; ++$i) {
4052             my @squares;
4053             my $numsquares = 0;
4054             my $temp = $magicmoves_b_mask[$i];
4055              
4056             while ($temp) {
4057             my $bit = $temp & -$temp;
4058             $squares[$numsquares++] = $__initmagicmoves_bitpos64_database[$mask58 & (($bit * 0x07EDD5E59A4E28C2) >> 58)];
4059             $temp ^= $bit;
4060             }
4061             for ($temp = 0; $temp < (1 << $numsquares); ++$temp) {
4062             my $tempocc = __initmagicmoves_occ(\@squares, $temp);
4063             my $j = (($tempocc) * $magicmoves_b_magics[$i]);
4064             my $k = ($j >> MINIMAL_B_BITS_SHIFT) & $b_bits_shift_mask;
4065             $magicmovesbdb[$i]->[$k]
4066             = __initmagicmoves_Bmoves($i, $tempocc);
4067             }
4068             }
4069              
4070             for (my $i = 0; $i < 64; ++$i) {
4071             my @squares;
4072             my $numsquares = 0;
4073             my $temp = $magicmoves_r_mask[$i];
4074             while ($temp) {
4075             my $bit = $temp & -$temp;
4076             $squares[$numsquares++] = $__initmagicmoves_bitpos64_database[$mask58 & (($bit * 0x07EDD5E59A4E28C2) >> 58)];
4077             $temp ^= $bit;
4078             }
4079             for ($temp = 0; $temp < 1 << $numsquares; ++$temp) {
4080             my $tempocc = __initmagicmoves_occ(\@squares, $temp);
4081              
4082             my $j = (($tempocc) * $magicmoves_r_magics[$i]);
4083             my $k = ($j >> MINIMAL_R_BITS_SHIFT) & $r_bits_shift_mask;
4084             $magicmovesrdb[$i][$k] = __initmagicmoves_Rmoves($i, $tempocc);
4085             }
4086             }
4087              
4088             1;