Macro results from the CPAN

Chess-Plisco

#! /bin/false

# Copyright (C) 2021-2026 Guido Flohr <guido.flohr@cantanea.com>,
# all rights reserved.

# This program is free software. It comes without any warranty, to
# the extent permitted by applicable law. You can redistribute it
# and/or modify it under the terms of the Do What the Fuck You Want
# to Public License, Version 2, as published by Sam Hocevar. See
# http://www.wtfpl.net/ for more details.

# This file is heavily inspired by python-chess.

use strict;
use integer;

use List::Util qw(reduce);
use Locale::TextDomain qw('Chess-Plisco');
use Scalar::Util qw(reftype);

use Chess::Plisco qw(:all);
# Macros from Chess::Plisco::Macro are already expanded here!

my $TBPIECES = 7;

use constant PD_INDEXTABLE => 0;
use constant PD_SIZETABLE => 1;
use constant PD_DATA => 2;
use constant PD_OFFSET => 3;
use constant PD_SYMLEN => 4;
use constant PD_SYMPAT => 5;
use constant PD_BLOCKSIZE => 6;
use constant PD_IDXBITS => 7;
use constant PD_MIN_LEN => 8;
use constant PD_BASE => 9;

use constant INVTRIANGLE => [1, 2, 3, 10, 11, 19, 0, 9, 18, 27];

# FIXME! These are candidates for macros!
my $offdiag = sub {
	my ($shift) = @_;

	my ($file, $rank) = ($shift & 0x7, $shift >> 3);

	return $rank - $file;
};

my $flipdiag = sub {
	my ($shift) = @_;

	return (($shift >> 3) | ($shift << 3)) & 63;
};

my $read_byte = sub {
	my ($data_ref, $offset) = @_;

	return ord substr $$data_ref, $offset, 1;
};

my $remove_ep = sub {
	my ($pos) = @_;

	my $pos2 = $pos->copy;

	$pos2->[CP_POS_EN_PASSANT_SHIFT] = 0;

	return $pos2;
};

my $is_checkmate = sub {
	my ($pos) = @_;

	my $game_over = $pos->gameOver or return;
	return 1 if ($game_over && CP_GAME_WHITE_WINS);
	return 1 if ($game_over && CP_GAME_BLACK_WINS);
};

use constant PD_INDEXTABLE => 0;
use constant PD_SIZETABLE => 1;
use constant PD_DATA => 2;
use constant PD_OFFSET => 3;
use constant PD_SYMLEN => 4;

lib/Chess/Plisco/Tablebase/Syzygy.pm view on Meta::CPAN

		my $p = [(0) x $TBPIECES];
		my $i = 0;
		while ($i < $self->{num}) {
			my $piece_type = $self->{pieces}->[$bside]->[$i] & 0x07;
			my $colour = ($self->{pieces}->[$bside]->[$i] ^ $cmirror) >> 3;
			my $bb = $colour ? ($pos->[$piece_type] & $pos->[CP_POS_BLACK_PIECES]) : ($pos->[$piece_type] & $pos->[CP_POS_WHITE_PIECES]); 

			while ($bb) {
				my $shift = (do {	my $B = $bb & -$bb;	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) & 0x0f0f0f0...
				$p->[$i++] = $shift;

				$bb = (($bb) & (($bb) - 1));
			}
		}

		# FIXME! idx is not always used by decompressPairs()!
		my $idx = $self->_encodePiece($self->{norm}->[$bside], $p, $self->{factor}->[$bside]);
		$res = $self->_decompressPairs($self->{precomp}->[$bside], $idx);
	} else {
		my $p = [(0) x $TBPIECES];
		my $i = 0;
		my $k = $self->{files}->[0]->{pieces}->[0]->[0] ^ $cmirror;
		my $colour = $k >> 3;
		my $piece_type = $k & 0x07;
		my $bb = $colour ? ($pos->[$piece_type] & $pos->[CP_POS_BLACK_PIECES]) : ($pos->[$piece_type] & $pos->[CP_POS_WHITE_PIECES]);

		while ($bb) {
			my $shift = (do {	my $B = $bb & -$bb;	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...
			$p->[$i++] = $shift ^ $mirror;

			$bb = (($bb) & (($bb) - 1));
		}

		my $f = $self->_pawnFile($p);
		my $pc = $self->{files}->[$f]->{pieces}->[$bside];

		while ($i < $self->{num}) {
			my $colour = ($pc->[$i] ^ $cmirror) >> 3;
			my $piece_type = $pc->[$i] & 0x07;
			my $bb = $colour ? ($pos->[$piece_type] & $pos->[CP_POS_BLACK_PIECES]) : ($pos->[$piece_type] & $pos->[CP_POS_WHITE_PIECES]); 

			while ($bb) {
				my $shift = (do {	my $B = $bb & -$bb;	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) & 0x0f0f0f0...
				$p->[$i++] = $shift ^ $mirror;

				$bb = (($bb) & (($bb) - 1));
			}
		}

		# FIXME! idx is not always used by decompressPairs()!
		my $idx = $self->_encodePawn($self->{files}->[$f]->{norm}->[$bside], $p, $self->{files}->[$f]->{factor}->[$bside]);
		$res = $self->_decompressPairs($self->{files}->[$f]->{precomp}->[$bside], $idx);
	}

	return $res - 2;
}

package Chess::Plisco::Tablebase::Syzygy::DtzTable;
$Chess::Plisco::Tablebase::Syzygy::DtzTable::VERSION = 'v1.0.3';
use Chess::Plisco qw(:all);
# Macros from Chess::Plisco::Macro are already expanded here!

use base qw(Chess::Plisco::Tablebase::Syzygy::Table);

use constant TBZ_MAGIC => "\xd7\x66\x0c\xa5";

use constant WDL_TO_MAP => [1, 3, 0, 2, 0];

use constant PA_FLAGS => [8, 0, 0, 0, 4];

use constant PD_INDEXTABLE => 0;
use constant PD_SIZETABLE => 1;
use constant PD_DATA => 2;
use constant PD_OFFSET => 3;
use constant PD_SYMLEN => 4;
use constant PD_SYMPAT => 5;
use constant PD_BLOCKSIZE => 6;
use constant PD_IDXBITS => 7;
use constant PD_MIN_LEN => 8;
use constant PD_BASE => 9;

sub __initTableDtz {
	my ($self) = @_;

	$self->_initMmap;

	if ($self->{initialized}) {
		return;
	}

	$self->_checkMagic(TBZ_MAGIC);

	$self->{factor} = [(0) x $TBPIECES];
	$self->{norm} = [(0) x $self->{num}];
	$self->{tb_size} = [0, 0, 0, 0];
	$self->{size} = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0];
	$self->{files} = [
		Chess::Plisco::Tablebase::Syzygy::PawnFileDataDtz->new,
		Chess::Plisco::Tablebase::Syzygy::PawnFileDataDtz->new,
		Chess::Plisco::Tablebase::Syzygy::PawnFileDataDtz->new,
		Chess::Plisco::Tablebase::Syzygy::PawnFileDataDtz->new,
	];


	my $files = ($read_byte->($self->{data}, 4) & 0x2) ? 4 : 1;

	my $p_data = 5;

	if (!$self->{has_pawns}) {
		$self->{map_idx} = [[0, 0, 0, 0]];

		$self->__setupPiecesPieceDtz($p_data, 0);
		$p_data += $self->{num} + 1;
		$p_data += $p_data & 0x01;

		$self->{precomp} = $self->_setupPairs($p_data, $self->{tb_size}->[0], 0);
		$self->{flags} = $self->{_flags};

		$p_data = $self->{_next};
		$self->{p_map} = $p_data;
		if ($self->{flags} & 2) {

lib/Chess/Plisco/Tablebase/Syzygy.pm view on Meta::CPAN

		my $k = $self->{files}->[0]->{pieces}->[0] ^ $cmirror;
		my $piece_type = $k & 0x07;
		my $colour = $k >> 3;
		my $bb = $colour ? ($pos->[$piece_type] & $pos->[CP_POS_BLACK_PIECES]) : ($pos->[$piece_type] & $pos->[CP_POS_WHITE_PIECES]); 

		my $i = 0;
		my $p = [(0) x ($TBPIECES - 1)];
		while ($bb) {
			my $shift = (do {	my $B = $bb & -$bb;	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...
			$p->[$i++] = $shift ^ $mirror;

			$bb = (($bb) & (($bb) - 1));
		}

		my $f = $self->_pawnFile($p);
		if (($self->{flags}->[$f] & 1) != $bside) {
			return 0, -1;
		}

		my $pc = $self->{files}->[$f]->{pieces};
		while ($i < $self->{num}) {
			$piece_type = $pc->[$i] & 0x07;
			$colour = ($pc->[$i] ^ $cmirror) >> 3;
			my $bb = $colour ? ($pos->[$piece_type] & $pos->[CP_POS_BLACK_PIECES]) : ($pos->[$piece_type] & $pos->[CP_POS_WHITE_PIECES]); 

			while ($bb) {
				my $shift = (do {	my $B = $bb & -$bb;	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) & 0x0f0f0f0...
				$p->[$i++] = $shift ^ $mirror;

				$bb = (($bb) & (($bb) - 1));
			}
		}

		my $idx = $self->_encodePawn($self->{files}->[$f]->{norm}, $p, $self->{files}->[$f]->{factor});
		$res = $self->_decompressPairs($self->{files}->[$f]->{precomp}, $idx);

		if ($self->{flags}->[$f] & 2) {
			if (!($self->{flags}->[$f] & 16)) {
				$res = $read_byte->($self->{data}, $self->{p_map} + $self->{map_idx}->[$f]->[WDL_TO_MAP->[$wdl + 2]] + $res);
			} else {
				$res = $self->_readUint16($self->{p_map} + 2 * ($self->{map_idx}->[$f]->[WDL_TO_MAP->[$wdl + 2]] + $res));
			}
		}

		if (!($self->{flags}->[$f] & $->[$wdl + 2]) || ($wdl & 1)) {
			$res *= 2;
		}
	}

	return $res, 1;
}

package Chess::Plisco::Tablebase::Syzygy;
$Chess::Plisco::Tablebase::Syzygy::VERSION = 'v1.0.3';
use File::Basename qw(basename);
use File::Globstar qw(globstar);
use Locale::TextDomain qw('Chess-Plisco');
use Tie::Cache::LRU;

use Chess::Plisco qw(:all);
# Macros from Chess::Plisco::Macro are already expanded here!

use base qw(Chess::Plisco::Tablebase);

use constant TBW_SUFFIX => 'rtbw';
use constant TBZ_SUFFIX => 'rtbz';
use constant WDL_TO_DTZ => [-1, -101, 0, 101, 1];

sub new {
	my ($class, $directory, %__options) = @_;

	my %options = (
		load_wdl => 1,
		load_dtz => 1,
		max_fds => 128,
		%__options
	);

	my %tables;
	if (0 + $options{max_fds} > 0) {
		tie %tables, 'Tie::Cache::LRU', $options{max_fds};
	}

	my $self = bless {
		tables => \%tables,
		wdl => {},
		dtz => {},
		wdl_files => 0,
		dtz_files => 0,
	}, $class;

	$self->addDirectory($directory, %options) if defined $directory;

	return $self;
}

sub addDirectory {
	my ($self, $directory, %__options) = @_;

	my %options = (
		load_wdl => 1,
		load_dtz => 1,
		%__options
	);

	my (@rtbw_files, @rtbz_files);
	$directory = File::Spec->rel2abs($directory);

	if ($options{recursive}) {
		@rtbw_files = globstar "$directory/**/*.rtbw" if $options{load_wdl};
		@rtbz_files = globstar "$directory/**/*.rtbz" if $options{load_dtz};
	} else {
		@rtbw_files = globstar "$directory/*.rtbw" if $options{load_wdl};
		@rtbz_files = globstar "$directory/*.rtbz" if $options{load_dtz};
	}

	my @files = (@rtbw_files, @rtbz_files);

	my $num_files = 0;
	foreach my $filename (@files) {
		++$num_files if $self->__addFile($filename, %options)

( run in 1.705 second using v1.01-cache-2.11-cpan-5a3173703d6 )