Sirio on Youtube

Finally I manage to upload this video made with DosBox:

Soon I will upload the sources...

ChessKISS 0.7

Last day of the year and a new version..., from readme.txt:


31/12/10 0.7 update:

-General
A lot of structures are align to power of two

-Board
FillMoves() also fills Pawns
Get rid off UpdateIndices(), a new approach is used

-Definitions
New piece score values

-Engine
Movements now use TStack<string>
Movements are now cleared after each game
Eval command now returns debug info

-Evaluation
New debug info
Isolated double pawns are counted
UndevelopedKnightRookComboPenalty() was used as bonus when it a penalty
Castling bonus removed
No castling rights are penalty only are initial and middle stages
Fianchetto bonus fixed
Pawn penalty now uses fixed values rather than incremental values (for the moment)
Blocked center penalty improved
KING_NOT_ON_SIDE_PENALTY uses a new approach

-Moves
Now En passant moves have the sufix "/ep"

ChessKISS 0.6

Well, another update, this is getting close to the end...

From readme:


21/12/10, 0.6 update:

-General
Cleaning

-Board
GenerateEvasions() works but still not used
Fixed castling rights
Pawn generation optimized a bit
GetCastlingRights() was also setting rights
Now the engine correctly choose the rook side once is discarding castling rights

-Evaluation
Unstoppable bonus error
BLOCKING_CENTER was issued to all pawns rather than to only one
A bit of pawn storm

-Moves
Added AddRange()

-Pieces
Added IsSlice()
New Initial value

-Search
Checks in Quiescent() not done until Captures stage
Checks in See() go to good captures even if they loose material
Removed temporally the dynamic window

-Zobrist
Finally the hash takes into account the castling rights

Ternary operator ? in Delphi

Delphi does not have an ternary operator, but with templates we can do something similar:

TBool<T> = class
public
  class function IFF(aCondition: boolean; aTrue, aFalse: T): T; inline;
end;

{ TBool<T> }

class function TBool<T>.IFF(aCondition: boolean; aTrue, aFalse: T): T;
begin
  if aCondition then
    Exit(aTrue)
  else
    Exit(aFalse);
end;
I use it in ChessKISS (just for fun) in this way:
//Null moves
mate := False;
if (FUseNullMove and FAllowNullMove) and (CurrentCheck = checkNo) and (CurrentStage <> sPawnEnding) then
begin
  R := TBool<integer>.IFF(aDepth > 6, 3, 2);

  Switch;
  FAllowNullMove := False;  //do not use recursive null moves
  CurrentScore := -AlphaBeta(-aBeta, -aBeta + 1, aDepth - R);
  FAllowNullMove := True;
  Switch;

  if CurrentScore >= aBeta then
  begin
    FCache.Add(FBoard.GetBoardHash(FSide), NO_MOVE, aDepth, CurrentScore, htBeta);
    Exit(aBeta);  //Cutoff!
  end else
    if (CurrentScore <= -PieceValues[ptKing]) and (FMateExtension) then
      mate := True;
end;
The main problem with that is that both expressions are evaluated before the call is make, which it should not be a problem I we know that, but avoid expensive calls like:
TBool<boolean>IFF(i > 3, ExpensiveTrue(), ExpensiveFalse())
Since it will call both functions, both functions will be evaluated. This another example that can even be worse:
TBool<integer>IFF(list <> nil, list.Count, 'null')
If the list is null then Houston we have a problem since it will anyway evaluate List.Count.

ChessKISS 0.5

Hi

After long time I think that finally I have a stable version, is difficult to conciliate work, family and hobbies, I've made some silly errors that should not happend in a normal situation, but well, that's life. Nevertheless I'm quite proud of this creature...


From readme:


06/12/10, 0.5 update:

-Search
Added contempt factor
Fixed nasty error, a whole node ignored by futility always returned DRAW
Removed OutOfBoard(), now is called InsideBoard() and uses a new schema
Removed all try/finally

-History
New Update() method

-Moves
New constant NO_MOVE = 0

-Evaluation
New bonus added in Rooks
No king pawn penalty missing left col
Fixed king attack Path[]
Fixed silly error, returning negative values in king attack rather than positive values
Fixed PawnInfo initialization

ChessKISS, new version 0.4

A new version has been deployed, from readme:


03/12/10, 0.4 update:

-Board,
New GenerateEvassions(), not working 100%
Fixed some minor issues
New Perft() method

-Transposition
Speedup and history added
Non moves allowed

-Evaluation
General optimization
New king attack scheme
Removed pinning in pawn and queen
Fixed double pawns (both pawns were penalized)
New rook connection
New bishop pair scheme
More pawn rewards
New mobility scheme
Added fianchetto
Added king weak pawn

-Moves
New IsPromotion() method

-Piece
New DifferentSide() method

-Search
Fix nasty reduction error
New iterative deepening scheme
Remove bad captures in Quiescent() unless in check

-Engine
Stabilize a bit the Analyze command
New commands searchd and searcht

Download it in the download section (top right)

ChessKISS, new version 0.3

Finally I'm able to release this new version, I hope I didn't break anything, from readme.txt:


21/11/2010, 0.3 update:

-General
Tables.pas removed
TranspositionTable.pas removed
New Cache.pas, we do not longer use TDictionaty<> but our own hash version
-Board
New TSquare in order to have more info in Board
Nove/capture generation functions splitted in two (with target/no target)

Added Side to the Play() function and overload one
Optimized castling move generation
InternalGenerateCaptures() must have a aOneMove parameter
Fixed big bug in StaticExchangeEvaluation() function
New GetPieceType(), with this function comparisons are easy: if GetPieceType(0) = B_KING then xxx

-Definitions
Many constants moved to the related functions

-Evaluation
Improved trapped knight/bishop
Heavy use of new GetPieceType() function
New King safety concept (also defense added)
Blocking pawn in center check
Piece tropism
UndevelopedKnightRookComboPenalty() fixed
LateMoveReductionPlays removed
Imbalance (in test)
Fixed hung bug
Pawn bonus/penalty new values
Rook/queen early move penalty
LazyEval() fixed
Imbalance
Fixed hung
Pawn bonus/penalty new values
Rook/queen early move
LazyEval() fixed
-Search
AllowNullMove fixed
use Cache.TimeGoesBy() for ancient cache entries
Bonus time is div 3 rather than div 2
IsTimeOut() called every 4096 nodes
Futility rewrited

-Settings
LateMoveReductionPlays removed

-Moves
New Copy() method

-Pieces
New GetColMask() method

Particularities of ChessKISS

ChessKISS has some particularites, let's see some of them:

• Sequential generation of (not calculated over and over)
• Total pieces
• Piece list
• Piece count per type
• Board value
• King
• No UndoMove() method, rather that complicate the things and adding always new stuff, I've a record with all stuff needed, that record is update playing  or replaced restoring the board (which is a LIFO<T> structure), the good thing is that I don't have to bother undoing the information of the previous point, is just replaced by a whole new record. I don't know how slow is this compared with the proper way, but I'm quite happy with the simplicity.

All information is stored in the TData record, when we backup the board we do FBackup.Push(FData), when we undo we do FData := FBackup.Pop, so a regular move would look like:

FBoard.Backup;

FBoard.Play(move);

FBoard.Switch;
AlphaBeta();
FBoard.Switch;

FBoard.Restore;

I've found some big mistakes, so I hope tomorrow I will uploaded a new version.

Damm!, the download links do not longer work...

It looks like File Dropper does not keep the files for more than 1 week?, do you know a good alternative to upload the files?

Thanks!

Chess, good and bad feelings

It is a nice feeling to see your little creature evolve, specially if it wins, but it is really difficult to tune these creatures, I mean, you modify a tiny part of the program and the results can be catastrophic an the worse thing is that you don't even notice it until the engine starts loosing miserably against other engines, then you have to rollback all changes and start measuring and per one again, slow and painfull...

In the last tournament (I don't play engines that I know they always win, what for?, they are design by clever people for many many years with a lot of chess knowledge and help from chess experts) ChessKISS was lucky enough to win all matches, but does that means that ChessKISS is better than other engines?, no!, that's why ELO exists, you have to play hundrens of games in order to balance your ELO.


Arena tournament

Rank	Engine	Author	Country	Rating	Score	%	Ch	Pu	Ts	Ms	Pi	Bi	S-B
1	ChessKISS	Abel Belzunces	Spain	2200	5.0/5	100.0	· ·· ··	1-0-0	1-0-0	1-0-0	1-0-0	1-0-0	10,00
2	Pulsar2009-9b	Mike Adams	USA	2200	4.0/5	80.0	0-1-0	· ·· ··	1-0-0	1-0-0	1-0-0	1-0-0	6,00
3	Tscp181	Tom Kerrigan	USA	2200	3.0/5	60.0	0-1-0	0-1-0	· ·· ··	1-0-0	1-0-0	1-0-0	3,00
4	Mscp	Marcel van Kervinck	Netherlands	2200	1.5/5	30.0	0-1-0	0-1-0	0-1-0	· ·· ··	1-0-0	0-0-1	1,25
5	Piranha	Martin Villwock	Germany	2200	1.0/5	20.0	0-1-0	0-1-0	0-1-0	0-1-0	· ·· ··	1-0-0	0,50
6	BigLion	Matthias Gemuh	Cameroon	2200	0.5/5	10.0	0-1-0	0-1-0	0-1-0	0-0-1	0-1-0	· ·· ··	0,75

ChessKISS and memory

This engine is a memory hunter, trying to reduce the memory I've created two new entries in the .ini which are the maximum amount of memory that the transposition tables can use expressed in megabytes:


[cache]
EvaluationHashSize=16
TranspositionTableSize=256

(also it is needed for the winboard protocol, but I haven't implemented yet)

Before I was using a simple TDictionary<int64, TInfo> (key/value)

Now I use an intermediate class called TCache which internally uses a TDictionary AND a TLinkedList, but why?

Because we must delete entries once we have reach the maximum amount of memory allowed, how we do it?, just adding the key to the LinkedList and deleting always the first item (first item is always the oldest one)

procedure TCache<TKey, TValue>.Add(aKey: TKey; aValue: TValue);
begin
  FItems.Add(aKey, aValue);
  AddPointer(aKey, aValue);
end;

procedure TCache<Key, Value>.AddPointer(const aKey: Key; const aValue: Value);
begin
  FPointers.Enqueue(aKey);
  Inc(FCurrentSize, Length(aValue));

  case FType of
    ctPerEntries:
      begin
        if Count > FMaxSize then
          DeleteOldest;
      end;

    ctPerSize:
      begin
        while FCurrentSize > FMaxSize do
          DeleteOldest;
      end;
  end;
end;

function TCache<Key, Value>.Length(const aValue: Value): integer;
var
  v: TValue;

begin
  v := TValue.From<Value>(aValue);
  if v.Kind in [tkLString, tkWString, tkUString] then
    Exit(System.Length(v.AsString) * SizeOf(char))
  else
    Exit(v.DataSize);
end;
procedure TCache<TKey, TValue>.DeleteOldest;
begin
  Remove(FPointers[0]);
end;

procedure TCache<TKey, TValue>.Remove(aKey: TKey);
var
  i: integer;

begin
  FItems.Remove(aKey);
  FPointers.Delete(aKey);
end;

Why a LinkedList, because is the best collection once you want to remove the initital item, is just a matter of freeze the node and update the head node, for example with list or arrays the WHOLE list has to be moved to the left.

LinkedList:

procedure TLinkedList<T>.Delete(aItem: T);
var
  current, prior, next: TNodeList;

begin
  current := InternalFind(aItem);
  if current = nil then
    raise Exception.Create('Item not found');

  prior := current.Prior;
  next := current.Next;

  TryFreeObject(current.Item);

  //Update head
  if FHead = current then
  begin
    if next <> nil then
      FHead := next
    else
      FHead := nil;
  end;

  //Update tail
  if FTail = current then
  begin
    if prior <> nil then
      FTail := prior
    else
      FTail := nil;
  end;

  //Update sides
  if prior <> nil then
    prior.Next := next;

  if next <> nil then
    next.Prior := prior;

  current.Free;
  Dec(FCount);
end;

A fast delete..., now a typical array approach:

procedure TArrayEx<T>.Delete(aIndex: integer);
var
  i: integer;

begin
  if aIndex < FCount - 1 then
  begin
    for i := aIndex to FCount - 1 do
      FArray[i] := FArray[i + 1];
    FArray[FCount] := Default(T);
  end;

  Dec(FCount);
end;
The more elements the worst...
So now we do:
constructor TTranspositionTable.Create;
begin
  //In MB!
  FData := TCache<int64, TInfo>.Create(ctPerSize, 
TSettings.Instance.Transposition TableSize * 1024 * 1024);
FHits := 0;
  FMisses := 0;
end;
And voila! (of course the own LinkedList also consumes memory...)
But the engine still consumes too much memory, I've to find out why and where...

ChessKISS code optimizations

I've lately been doing a lot of optimizations in the code that I want to share with you (although the main speed up always comes from reducing the tree size...)

class TKillers

Before:

FHits: array[0..63, 0..63, 0..63] of integer; //Depth,From,To

After:

FHits: array[0..63, 0..$ffff] of integer; //Depth,From&To

Since the index is already pack as 16 bits now we use that directly as index, so a new function was created in TMoveHelper:

class function TMoveHelper.GetIndex(aMove: TMove): integer;
begin
  //This function RETURNS 16 bits [0..65535] not 6 bits [0..63] as index
  //Max will be $4040 [63][63]
  Exit(aMove shr 16);
end;

The same rule applies to THistoric:

type
  THistoric = class
  private
    FHistory: array[0..$ffff] of integer; //$4040
  public
    constructor Create;
    procedure Add(aMove: TMove; aDepth: integer);
    function Get(aMove: TMove): integer; inline;
    procedure Clear;
  end;

procedure THistoric.Add(aMove: TMove; aDepth: integer);
begin
  if (aMove <> 0) and (not TMoveHelper.IsCaptureOrPromote(aMove)) then
    Inc(FHistory[TMoveHelper.GetIndex(aMove)], aDepth);
end;

function THistoric.Get(aMove: TMove): integer;
begin
  if aMove = 0 then
    Exit(0)
  else
    Exit(FHistory[TMoveHelper.GetIndex(aMove)]);
end;
In order to speed up the moves creation we have a few tables that helps checking 
when a move is outside the board without "if's". 
The function is TBoardchess.OutOfBoard(aIndex, aDir: TDir): boolean;
Before it was using a map of integers, now I've change it to booleans:
Map: array[0..143] of boolean =
  (
    True, True, True,  True,  True,  True,  True,  True,  True,  True,  True, True, //0
    True, True, True,  True,  True,  True,  True,  True,  True,  True,  True, True, //12
    True, True, False, False, False, False, False, False, False, False, True, True, //24
    True, True, False, False, False, False, False, False, False, False, True, True, //36
    True, True, False, False, False, False, False, False, False, False, True, True, //48
    True, True, False, False, False, False, False, False, False, False, True, True, //64
    True, True, False, False, False, False, False, False, False, False, True, True, //72
    True, True, False, False, False, False, False, False, False, False, True, True, //84
    True, True, False, False, False, False, False, False, False, False, True, True, //96
    True, True, False, False, False, False, False, False, False, False, True, True, //108
    True, True, True,  True,  True,  True,  True,  True,  True,  True,  True, True, //120
    True, True, True,  True,  True,  True,  True,  True,  True,  True,  True, True  //132
  );

Before outside was 0 and inside was 1, so the output assembler is now:
function OutOfBoard(aIndex: integer; aDir: TDir): boolean; inline; 
begin
  Exit(Map[MapLookup[aIndex] + Offsets12[aDir]]); 
end;

ASM:
004A68D0 8B049538054B00   mov eax,[edx*4+$4b0538]
004A68D7 0FB6D1           movzx edx,cl
004A68DA 03049538064B00   add eax,[edx*4+$4b0638]
004A68E1 0FB680A8044B00   movzx eax,[eax+$004b04a8]
Before it was:
Unit34.pas.593: Exit(Map[MapLookup[aIndex] + Offsets12[aDir]] = 0);
004A68D0 8B0495E8064B00   mov eax,[edx*4+$4b06e8]
004A68D7 0FB6D1           movzx edx,cl
004A68DA 030495E8074B00   add eax,[edx*4+$4b07e8]
004A68E1 833C85A8044B0000 cmp dword ptr [eax*4+$4b04a8],$00
004A68E9 0F94C0           setz al
So a line less and no branching millions times always count... ( I hope :-) )
Revisiting the move generation I could remove some extra lines in 
all move/capture functions:
procedure TChessboard.GenerateKingMoves(aPiece: TPiece; aIndex: integer; var aMoves: TMoveSet);
var
  i, dst, src: integer;

begin
  src := aPiece.Index;
  i := 7;
  while i >= 0 do
  begin
    if not OutOfBoard(src, TDir(i)) then
    begin
      dst := Offsets8Cols[TDir(i)] + src;
      if (GetPiece(dst) = nil) and ((aIndex = -1) or (dst = aIndex)) then
        aMoves.Add(TMoveHelper.Pack(ptKing, src, dst, actMove));
    end;

    Dec(i);
  end;
end;

New versions

Finally today I manage to update the versions and the links (see download sections), so:

• Library updated to 1.1
• Demos updated to 1.1
• ChessKISS updated to 0.2 (check readme.txt to track the changes)

Another quick tournament

Arena tournament

Rank	Engine	Author	Country	Rating	Score	%	Ro	Ch	GE	Ts	Bi	Pi	Ms	S-B
1	Roce38	Roman Hartman	Switzerland	2200	5.0/6	83.3	· ·· ··	1-0-0	0-1-0	1-0-0	1-0-0	1-0-0	1-0-0	12,00
2	ChessKISS	Abel Belzunces	Spain	2200	4.5/6	75.0	0-1-0	· ·· ··	0-0-1	1-0-0	1-0-0	1-0-0	1-0-0	9,50
3	GERBIL	Bruce Moreland	USA	2200	4.0/6	66.6	1-0-0	0-0-1	· ·· ··	0-0-1	0-1-0	1-0-0	1-0-0	10,75
4	Tscp181	Tom Kerrigan	USA	2200	3.0/6	50.0	0-1-0	0-1-0	0-0-1	· ·· ··	0-0-1	1-0-0	1-0-0	5,25
5	BigLion	Matthias Gemuh	Cameroon	2200	2.5/6	41.6	0-1-0	0-1-0	1-0-0	0-0-1	· ·· ··	0-1-0	1-0-0	5,50
6	Piranha	Martin Villwock	Germany	2200	2.0/6	33.3	0-1-0	0-1-0	0-1-0	0-1-0	1-0-0	· ·· ··	1-0-0	2,50
7	Mscp	Marcel van Kervinck	Netherlands	2200	0.0/6	0	0-1-0	0-1-0	0-1-0	0-1-0	0-1-0	0-1-0	· ·· ··	0,00

I'm quite happy about the current status, so it's time to release a new version...

Parallel ForEach

I will present a class for handling loops in parallel execution, the class is located in BB.Task:

type
  TProc<T> = reference to procedure(aValue: T);

  TParallelForEach<T> = class
  private
    type
      TTask = class(TThread)
      private
        FProc: TProc<T>;
        FItems: TList<T>;
      protected
        procedure Execute; override;
      public
        constructor Create(aProc: TProc<T>; aItems: TList<T>);
      end;

    var
      FItems: TList<T>;
      FMaxThreadsPerCPU: integer;
      FTasks: array of TThread;

    function GetCPUCount: integer;
  public
    constructor Create(aItems: TList<T>);
    destructor Destroy; override;
    procedure Run(aProc: TProc<T>);
    procedure Wait;

    property MaxThreadsPerCPU: integer read FMaxThreadsPerCPU write FMaxThreadsPerCPU;
  end;

You pass in the constructor a list of T (ok, it should be an iterator, but in Delphi, I suppose for compatibility issues no list implement a common iterator interface, what a pitty...)

You pass a closure in the Run() method and also you can express the maximum threads created per CPU (this property is very important!)

And you can wait for all task to be finish with the Wait() method (this will also happend when you free the class)

An easy example:

var
  p: TParallelForEach<integer>;
  list: TList<integer>;
  i: integer;

begin
  t := GetTickCount;

  list := TList<integer>.Create;
  try
    for i := 1 to 100 do
      list.Add(Random(i * 10));

    p := TParallelForEach<integer>.Create(list);
    p.MaxThreadsPerCPU := 10;
    p.Run(procedure(aItem: integer)
          begin
            //Heavy task
            Sleep(aItem);
          end
          );
    p.Wait;
  finally
    list.Free;
  end;
Depending on how heavy is the closure you must indicate a certain amount of threads, for this silly example with 2 CPU's I found out that 10 is the best option (although the default value is 2). It does not make sense to overload the system with 100 threads...


And finally the implementation:



{ TParallelForEach<T> }

constructor TParallelForEach<T>.Create(aItems: TList<T>);
begin
  FItems := aItems;
  FMaxThreadsPerCPU := 2;
end;

destructor TParallelForEach<T>.Destroy;
var
  i: integer;

begin
  for i := 0 to Length(FTasks) - 1 do
    FTasks[i].Free;

  inherited;
end;

function TParallelForEach<T>.GetCPUCount: integer;
var
  ProcessMask, SystemMask: dword;

begin
  //This routine calculates the number of CPUs available to the process, not necessarily on the system
  Result := 1;
  if GetProcessAffinityMask(GetCurrentProcess, ProcessMask, SystemMask) then
  begin
    while ProcessMask <> 0 do
    begin
      if Odd(ProcessMask) then
        Inc(Result);
      ProcessMask := ProcessMask shr 1;
    end;
    Dec(Result);
  end;
end;

procedure TParallelForEach<T>.Run(aProc: TProc<T>);
var
  i, ThreadCount: integer;
  groups: array of TList<T>;

begin
  //Calculate total threads
  ThreadCount := FMaxThreadsPerCPU * GetCPUCount;
  if ThreadCount > FItems.Count then
    ThreadCount := FItems.Count;

  //Create as many data groups as required
  SetLength(groups, ThreadCount);
  for i := 0 to ThreadCount - 1 do
    groups[i] := TList<T>.Create;

  //Dispersion of items
  for i := 0 to FItems.Count - 1 do
    groups[i mod ThreadCount].Add(FItems[i]);

  //Launch all tasks
  SetLength(FTasks, Length(groups));
  for i := Low(groups) to High(groups) do
  begin
    FTasks[i] := TTask.Create(aProc, groups[i]);
    FTasks[i].Start;
  end;
end;

procedure TParallelForEach<T>.Wait;
var
  i: integer;

begin
  for i := 0 to Length(FTasks) - 1 do
    FTasks[i].WaitFor;
end;

{ TParallelForEach<T>.TTask }

constructor TParallelForEach<T>.TTask.Create(aProc: TProc<T>; aItems: TList<T>);
begin
  inherited Create(True);

  FProc := aProc;
  FItems := aItems;

  FreeOnTerminate := False;
end;

procedure TParallelForEach<T>.TTask.Execute;
var
  i: integer;

begin
  for i := 0 to FItems.Count - 1 do
    FProc(FItems[i]);
  FItems.Free;
end;

Another tournament

Rank	Engine	Author	Country	Rating	Score	%	Ch	Ts	Ro	Bi	Pi	Ph	S-B
1	ChessKISS	Abel Belzunces	Spain	2200	6.5/8	81.2	· ·· ··	1-0-1	1-0-1	0-0-1	1-0-0	2-0-0	18,75
2	Tscp181	Tom Kerrigan	USA	2200	4.5/8	56.2	0-1-1	· ·· ··	1-1-0	1-0-0	1-1-0	1-0-0	15,25
2	Roce38	Roman Hartman	Switzerland	2200	4.5/7	64.2	0-1-1	1-1-0	· ·· ··	1-0-0	1-0-0	1-0-0	15,25
4	BigLion	Matthias Gemuh	Cameroon	2200	4.5/7	64.2	0-0-1	0-1-0	0-1-0	· ·· ··	2-0-0	2-0-0	9,25
5	Piranha	Martin Villwock	Germany	2200	3.0/8	37.5	0-1-0	1-1-0	0-1-0	0-2-0	· ·· ··	2-0-0	4,50
6	Phalanx	Dusan Dobes	Czech	2200	0.0/8	0	0-2-0	0-1-0	0-1-0	0-2-0	0-2-0	· ·· ··	0,00

Not bad at all!, not a single loss

More handy classes, part 2

For interlocked functions (atomic operations) I have a special class in BB.Sync:

type

TInterlocked = class
  public
    class function CAS(var aTarget: integer; aCurrentVal, aNewVal: integer): boolean; overload;
    class function CAS(var aTarget: cardinal; aCurrentVal, aNewVal: cardinal): boolean; overload;
    class function CAS(var aTarget: pointer; aCurrentVal, aNewVal: pointer): boolean; overload;
    class function CAS(var aTarget: TObject; aCurrentVal, aNewVal: TObject): boolean; overload;
    class function CAS(var aTarget: LongBool; aCurrentVal, aNewVal: LongBool): boolean; overload;
    class function Inc(var aValue: integer): integer; overload;
    class function Inc(var aValue: int64): integer; overload;
    class function Dec(var aValue: integer): integer; overload;
    class function Dec(var aValue: int64): integer; overload;
    class function Add(var aValue: integer; aCounter: integer): integer;
    class function Sub(var aValue: integer; aCounter: integer): integer;
    class function SetValue(var aTarget: integer; aValue: integer): integer;
  end;

CAS is a acronym of "Compare And Swap", is a must operation in parallel code. Think on a certain class that has an owner thread as the first caller (for whatever reason), the easiest possibility is to use a critical section, but that affects the performance quite a  lot, another possibility is to use CAS():

constructor TLock.Create;
begin
  inherited;

  FCurrentThread := 0; //Nobody owns me
  FDepth := 0;
end;

destructor TLock.Destroy;
begin
  Unlock;

  inherited;
end;

function TLock.IsLocked: boolean;
begin
  result := FCurrentThread <> 0; //Somebody owns me?
end;

function TLock.Lock(aTime: cardinal): boolean;
var
  ticks: Cardinal;

begin
  result := False;

  ticks := GetTickCount;
  repeat
    if TryLock then
    begin
      result := True;
      Break;
    end;

    Sleep(5);
  until GetTickCount - ticks > aTime;
end;

procedure TLock.Lock;
begin
  Lock(INFINITE);
end;

function TLock.TryLock: boolean;
begin
  //The special part of the code
  //It can be translated as
  //
  //ATOMIC ON
  // if FCurrentThread = 0 then
  //    FCurrentThread := GetCurrentThreadId;
  //  Exit(FCurrentThread);
  //ATOMIC OFF
  //
//This can only happens once, so next thread will exit the function 
  //without success
//
  //You could use a critical section here
  //  result := (FCurrentThread = GetCurrentThreadId) or 
(TInterlocked.CAS(FCurrentThread, 0, GetCurrentThreadId));
  if result then
    TInterlocked.Inc(FDepth); //How many times does my owner owns me?
end;

function TLock.Unlock: boolean;
begin
  result := False;
  if FCurrentThread = GetCurrentThreadId then //If caller = owner then release
  begin
    if TInterlocked.Dec(FDepth) = 0 then
    begin
      FCurrentThread := 0; //Now any other thread is able to own me
      result := True;
    end;
  end;
end;

Next post I will talk about ParallelForEach<T>

Arena tournament

Last night I prepared a chess tournament among some chess engines via Arena (including of course ChessKISS), these are the results:

Well, fourth is not bad, but against BigLion and Piranha the engine missed some easy wins, but due to a bloddy bug in the repetition code, the program played three times the same move (of course the other two engines seems to have the same problem...) ending in a draw, what a pitty...

I hope soon I can fix that error.

Some utils...

Today I will present some handy classes, they are all located in BB.Utils.* namespace.

This class will swap any kind of value:

TSwap<T> = class
public
  class procedure Swap(var a, b: T);
end;

Implementation:

class procedure TSwap<T>.Swap(var a, b: T);
var
  tmp: T;

begin
  tmp := a;
  a := b;
  b := tmp;
end

Example:

var
  a, b: integer;

begin
  a := 1;
  b := 2;
  TSwap<integer>.Swap(a, b);
  //Now a=2 & b=1
end;

This class let you do dynamic calls:

TCaller = class
public
  class procedure Call(aMethod: TMethod); overload;
  class procedure Call(aMethod: TMethod; aSender: TObject); overload;
  class procedure Call(aObject: TObject; const aMethod: string); overload;
end;

The implementation:

class procedure TCaller.Call(aMethod: TMethod);
begin
  TMethodPointer(aMethod)();
end;

class procedure TCaller.Call(aObject: TObject; const aMethod: string);
var
  m: TMethod;

begin
  m.Data := aObject;
  m.Code := aObject.MethodAddress(aMethod);
  Call(m);
end;

class procedure TCaller.Call(aMethod: TMethod; aSender: TObject);
begin
  TNotifyEvent(aMethod)(aSender);
end;
Example:

begin
  TCaller.Call(Button1, 'click');  
  //This will dinamically call the click method of a button.
  //This enables you to persist method names and use them
  //for your own purpose (by configuration you dedice
  //which action calls which method
end;
This class behaves like a bit container:

TBitSet = record
private
  FData: int64;
public
  constructor Create(aValue: int64);
  procedure ClearBit(aBit: integer); inline;
  function GetBit(aBit: integer): boolean; inline;
  procedure SetBit(aBit: integer); inline;
  function AsByte: byte; inline;
  function AsWord: word; inline;
  function AsInt: integer; inline;
  function AsInt64: int64; inline;
end;

Implementation

{ TBitSet }

//Bit64: array [0..63] of int64 =
//is an int64 precalculated array (it does not look good when I paste the values)
function TBitSet.AsByte: byte;
begin
  Exit(byte(FData));
end;

function TBitSet.AsInt: integer;
begin
  Exit(integer(FData));
end;

function TBitSet.AsInt64: int64;
begin
  Exit(FData);
end;

function TBitSet.AsWord: word;
begin
  Exit(word(FData));
end;

procedure TBitSet.ClearBit(aBit: integer);
begin
  FData := FData and ($FFFFFFFFFFFFFFFF xor Bit64[aBit]);
end;

constructor TBitSet.Create(aValue: int64);
begin
  FData := aValue;
end;

function TBitSet.GetBit(aBit: integer): boolean;
begin
  Exit(FData and Bit64[aBit] <> 0);
end;

procedure TBitSet.SetBit(aBit: integer);
begin
  FData := FData or Bit64[aBit];
end;

Example:

var
  t: TBitSet;
  i: integer;

begin
  t := TBitSet.Create($ffff);
  t.ClearBit(15);
  i := t.AsInt; //Now i = $fff
end;
And the last class is a time helper, is used also in ChessKISS for the Winboard protocol.

TTimeSpan = class
public
  class function Make(aDays, aHours, aMinutes, aSeconds, aMilliseconds: cardinal): cardinal;
  class procedure Unmake(aValue: cardinal; out aDays, aHours, aMinutes, aSeconds, aMilliseconds: cardinal);
  class function MillisecondsToDays(aValue: cardinal): cardinal;
  class function MillisecondsToHours(aValue: cardinal): cardinal;
  class function MillisecondsToMinutes(aValue: cardinal): cardinal;
  class function MillisecondsToSeconds(aValue: cardinal): cardinal;
  class function Milliseconds(aValue: cardinal): cardinal;
  class function SecondsToMilliseconds(aValue: cardinal): cardinal; inline;
  class function MinutesToMilliseconds(aValue: cardinal): cardinal; inline;
  class function HoursToMilliseconds(aValue: cardinal): cardinal; inline;
  class function DaysToMilliseconds(aValue: cardinal): cardinal; inline;
end;

Implementation

{ TTimeSpan }

class function TTimeSpan.DaysToMilliseconds(aValue: cardinal): cardinal;
begin
  result := HoursToMilliseconds(aValue) * 24;
end;

class function TTimeSpan.HoursToMilliseconds(aValue: cardinal): cardinal;
begin
  result := MinutesToMilliseconds(aValue) * 60;
end;

class function TTimeSpan.MinutesToMilliseconds(aValue: cardinal): cardinal;
begin
  result := SecondsToMilliseconds(aValue) * 60;
end;

class function TTimeSpan.SecondsToMilliseconds(aValue: cardinal): cardinal;
begin
  result := aValue * 1000;
end;

class procedure TTimeSpan.Unmake(aValue: cardinal; out aDays, aHours, aMinutes, aSeconds, aMilliseconds: cardinal);
begin
  aDays := MillisecondsToDays(aValue);
  Dec(aValue, DaysToMilliseconds(aDays));

  aHours := MillisecondsToHours(aValue);
  Dec(aValue, HoursToMilliseconds(aHours));

  aMinutes := MillisecondsToMinutes(aValue);
  Dec(aValue, MinutesToMilliseconds(aMinutes));

  aSeconds := MillisecondsToSeconds(aValue);
  Dec(aValue, SecondsToMilliseconds(aSeconds));

  aMilliseconds := aValue;
end;

class function TTimeSpan.Make(aDays, aHours, aMinutes, aSeconds, aMilliseconds: cardinal): cardinal;
begin
  result := Milliseconds(aMilliseconds) + SecondsToMilliseconds(aSeconds) + MinutesToMilliseconds(aMinutes) + HoursToMilliseconds(aHours) + DaysToMilliseconds(aDays);
end;

class function TTimeSpan.MillisecondsToDays(aValue: cardinal): cardinal;
begin
  Result := aValue div (1000 * 60 * 60 * 24);
end;

class function TTimeSpan.MillisecondsToHours(aValue: cardinal): cardinal;
begin
  Result := aValue div (1000 * 60 * 60);
end;

class function TTimeSpan.Milliseconds(aValue: cardinal): cardinal;
begin
  Result := aValue;
end;

class function TTimeSpan.MillisecondsToMinutes(aValue: cardinal): cardinal;
begin
  Result := aValue div (1000 * 60);
end;

class function TTimeSpan.MillisecondsToSeconds(aValue: cardinal): cardinal;
begin
  Result := aValue div 1000;
end

Example:
if Pos('level', cmd) = 1 then
begin
  //level 40 30 0  (40 moves, 30 minutes, 0)
  SplitString(cmd, ' ', list);
  FEngine.SetTimePerGame(TTimeSpan.MinutesToMilliseconds(StrToInt(list[2])));
  { TODO : 40 moves 5 minutes }
  Exit(True);
end;
Enjoy it?