CIL Toolkit: code snippets: move generation

[sje]

The toolkit now understands the eighty column limit for PGN move text output.

Code: Select all

(defun encode-tagpair (my-stream my-pgntn my-value)
  "Encode a PGN tag pair on a stream."
  (fmt-brack-l my-stream)
  (if my-pgntn
    (put-string my-stream (svref as-pgntn-vec my-pgntn))
    (put-nil my-stream))
  (blank my-stream)
  (fmt-quote my-stream)
  (put-string my-stream my-value)
  (fmt-quote my-stream)
  (fmt-brack-r my-stream)
  (values))

(defun encode-tp-vec (my-stream my-tp-vec)
  "Encode a vector of PGN tag pair values on a stream."
  (dopgntns (pgntn)
    (when (svref my-tp-vec pgntn)
      (encode-tagpair my-stream pgntn (svref my-tp-vec pgntn))
      (newline my-stream)))
  (values))

(defconstant movetext-column-limit 80)

(defun encode-movetext-item (my-stream my-item-string my-column)
  "Encode a movetext string starting at the given column; return the new column."
  (let ((result my-column) (item-length (length my-item-string)))
    (when (>= (+ result 1 item-length) movetext-column-limit)
      (newline my-stream)
      (setf result 0))
    (when (positive? result)
      (blank my-stream)
      (incf result))
    (put-string my-stream my-item-string)
    (incf result item-length)
    result))
  
(defun encode-movetext-afc (my-stream my-afc my-column)
  "Encode a movetext AFC starting at the given column; return the new column."
  (encode-movetext-item my-stream (afc-string my-afc) my-column))
  
(defun encode-movetext-move (my-stream my-move my-column)
  "Encode a movetext move starting at the given column; return the new column."
  (encode-movetext-item my-stream (san-string my-move) my-column))
  
(defun encode-movetext-gsr (my-stream my-gsr my-column)
  "Encode a movetext game status result starting at the given column; return the new column."
  (encode-movetext-item my-stream (svref as-gsr-vec my-gsr) my-column))

(defun encode-movetext (my-stream my-game)
  "Encode a game's movetext and game status indicator."
  (let*
    (
      (column 0)
      (pos    (clone-pos (game-pos my-game)))
      (moves  nil)
      (move   nil)
      (afc    (calc-afc-from-fenpos (game-base-fenpos my-game)))
    )
    (dowhile (positive? (pos-push-count pos))
      (push (first (pos-move-stack pos)) moves)
      (retract-move pos))
    (when (and moves (= (afc-act-color afc) color-black))
      (setf column (encode-movetext-afc my-stream afc column))
      (setf move (pop moves))
      (setf column (encode-movetext-move my-stream move column))
      (incf-afc afc))
    (dowhile moves
      (if (= (afc-act-color afc) color-white)
        (setf column (encode-movetext-afc my-stream afc column)))
      (setf move (pop moves))
      (setf column (encode-movetext-move my-stream move column))
      (incf-afc afc))
    (setf column (encode-movetext-gsr my-stream (game-gsr my-game) column))
    (when (positive? column)
      (newline my-stream)))
  (values))

(defun encode-pgn (my-stream my-pgn)
  "Encode a PGN game on a stream."
  (encode-tp-vec my-stream (pgn-tp-vec my-pgn))
  (newline my-stream)
  (encode-movetext my-stream (pgn-game my-pgn))
  (values))

[sje]

Actually that version of encode-movetext is doing too much work. Here's a faster one that doesn't fool around with position move retraction:

Code: Select all

(defun encode-movetext (my-stream my-game)
  "Encode a game's movetext and game status indicator."
  (let
    (
      (column 0)
      (moves  (reverse (pos-move-stack (game-pos my-game))))
      (move   nil)
      (afc    (calc-afc-from-fenpos (game-base-fenpos my-game)))
    )
    (when (and moves (= (afc-act-color afc) color-black))
      (setf column (encode-movetext-afc my-stream afc column))
      (setf move (pop moves))
      (setf column (encode-movetext-move my-stream move column))
      (incf-afc afc))
    (dowhile moves
      (if (= (afc-act-color afc) color-white)
        (setf column (encode-movetext-afc my-stream afc column)))
      (setf move (pop moves))
      (setf column (encode-movetext-move my-stream move column))
      (incf-afc afc))
    (setf column (encode-movetext-gsr my-stream (game-gsr my-game) column))
    (when (positive? column)
      (newline my-stream)))
  (values))

Oh, and here's the normalize-pgn routine that gets called as needed. It makes sure that the tags for Setup, FEN, Result, and PlyCount are consistent with the game move data:

Code: Select all

(defun normalize-pgn (my-pgn)
  "Normalize a PGN game in place."
  (let* ((game (pgn-game my-pgn)) (pos (game-pos game)))
    (if (is-initial-array-fenpos? (game-base-fenpos game))
      (progn
        (put-tp-str my-pgn pgntn-setup nil)
        (put-tp-str my-pgn pgntn-fen nil))
      (progn
        (put-tp-str my-pgn pgntn-setup "1")
        (put-tp-str my-pgn pgntn-fen (fenpos-string (game-base-fenpos game)))))
    (put-tp-str my-pgn pgntn-result (svref as-gsr-vec (game-gsr game)))
    (when (get-tp-str my-pgn pgntn-plycount)
      (put-tp-str my-pgn pgntn-plycount (format nil "~D" (pos-push-count pos)))))
  my-pgn)

[sje]

Movepath enumeration from the initial array to depth six, visiting all nodes with a full generate/execute/retract cycle for each move without transposition tables:

Code: Select all

* (time-emp-van pos0 6)
Total path count for depth six: 119060324
F/P: 119.49768 KHz / 8.368363 usec

Movepath enumeration from the initial array to depth six, counting all nodes with bulk counting of terminal nodes without transposition tables:

Code: Select all

* (time-emp-ctn pos0 6)
Total path count for depth six: 119060324
F/P: 1.4477179 MHz / 690.74225 nsec

So the bulk counter mode is about twelve times faster than the full visit/update mode.

Further optimizations are possible, but I don't expect any major improvement. The numbers change with different positions, but only slightly.

With the full update mode, the entire bitboard database and several other incrementally updated structures are present at every node. I'm confident that there's plenty of data available to build an evaluation function that's at least as good as that in the venerable Chess 4.x program, and I'd say that such an evaluator would run at about a quarter of the raw visit speed giving an average node frequency of 30 KHz.

How strong would a 30 KHz not-very-smart searcher be? Back in the 1970s, Chess 4.x ran at about one tenth that speed on an advanced CDC mainframe and played at around 1900 elo. So I'd guess that a 30 KHz searcher might make it to 2100 or so.

Of course, this is not the ultimate goal; it's just a measurement of the current progress.

[sje]

Common Lisp itself does not have extensive support of interprocess communication, threads, networking, and so forth. However, there is support for all of these for nearly all Common Lisp implementations.

The one downside is that the phrase "nearly all" is not the same as "all". The second downside is that these implementations vary to the extent that source level dependencies are introduced. The real world effect is that projects that access non-core functionality tend to pick some Common Lisp vendor and stick with them. This is not good for portability.

The new CIL Toolkit is different in that it should be as vendor independent as possible, at least as far as can be done and with specific allowance for free Common Lisp implementations.

To make interprocess communication and multiplexing work, the toolkit uses:

1) Named pipes for I/O channels;

2) Separate instances of Lisp processors for implementing threads;

3) Lisp object passing and random access files for sharing data;

4) A combination of the standard "listen" (stream polling) and "sleep" functions to efficiently replicate the semantics of the Unix select() system call.

Here's some sample code the implements a simple and portable client/server:

Code: Select all

;;; IPC testing

(defconstant ipc-pipe0-name "CILp0")
(defconstant ipc-pipe1-name "CILp1")

(defconstant ipc-pipe-name-vec (vector ipc-pipe0-name ipc-pipe1-name))

(defun echo-server ()
  "Run an echo server."
  (let ((ipc-pipe0 nil) (ipc-pipe1 nil) (text nil))
    (format t "Opening input ~A~%" (svref ipc-pipe-name-vec 1))
    (setf ipc-pipe0 (open (svref ipc-pipe-name-vec 1) :direction :input))
    (format t "Opening output ~A~%" (svref ipc-pipe-name-vec 0))
    (setf ipc-pipe1 (open (svref ipc-pipe-name-vec 0) :direction :output :if-exists :overwrite))
    (format t "Ready~%")
    (loop
      (sleep 0.01)
      (dowhile (listen ipc-pipe0)
        (setf text (read-line ipc-pipe0))
        (write-line text)
        (write-line text ipc-pipe1)))
    (close ipc-pipe0)
    (close ipc-pipe1)))


(defun echo-client ()
  "Run an echo client."
  (let ((ipc-pipe0 nil) (ipc-pipe1 nil))
    (format t "Opening output ~A~%" (svref ipc-pipe-name-vec 1))
    (setf ipc-pipe1 (open (svref ipc-pipe-name-vec 1) :direction :output :if-exists :overwrite))
    (format t "Opening input ~A~%" (svref ipc-pipe-name-vec 0))
    (setf ipc-pipe0 (open (svref ipc-pipe-name-vec 0) :direction :input))
    (format t "Ready~%")
    (loop
      (sleep 0.01)
      (dowhile (listen)
        (write-line (read-line) ipc-pipe1))
      (dowhile (listen ipc-pipe0)
        (write-line (read-line ipc-pipe0))))
    (close ipc-pipe0)
    (close ipc-pipe1)))

(In the above code, the close calls are just for show and aren't normally executed.)

There is some subtlety involved here. Opening a named pipe for input (output) will block until another process opens the same pipe for output (input). This means that the access setup for a given named pipe must be completed before setting up a second named pipe for I/O.

Oh, and before the code can run, at the shell level we need to do a one time creation of the named pipes:

Code: Select all

$ mkfifo CILp0
$ mkfifo CILp1

[sje]

The above code needed only some fine adjustments to also run under cmucl (CMU Common Lisp processor) as well as clisp.

Alas, the code won't work with gcl (GNU Common Lisp). Or at least I couldn't figure out how to get gcl to do named pipes after several hours of work.

Next up: the toolkit event loop.

[sje]

Revised client/server code; cleaned up and with flushing (needed for cmucl) plus a termination test added:

Code: Select all

;;; Selector server named pipe names; pipe files must be created earlier by mkfifo utility

(defconstant ipc-fr-srv-pipe-name "CILp0" "Written by the server")
(defconstant ipc-to-srv-pipe-name "CILp1" "Read by the server")


;;; Text echo server and client

(defun echo-server ()
  "Run an echo server."
  (let ((fr-srv-pipe nil) (to-srv-pipe nil) (stop nil) (text nil))
    (format t "Opening input ~A~%" ipc-to-srv-pipe-name)
    (setf to-srv-pipe (open ipc-to-srv-pipe-name :direction :input))
    (format t "Opening output ~A~%" ipc-fr-srv-pipe-name)
    (setf fr-srv-pipe (open ipc-fr-srv-pipe-name :direction :output :if-exists :overwrite))
    (format t "Ready~%")
    (dowhile (not stop)
      (sleep 0.01)
      (dowhile (listen to-srv-pipe)
        (setf text (read-line to-srv-pipe))
        (write-line text)
        (write-line text fr-srv-pipe)
        (finish-output fr-srv-pipe)
        (when (string= text "exit")
          (setf stop t))))
    (close fr-srv-pipe)
    (close to-srv-pipe)))


(defun echo-client ()
  "Run an echo client."
  (let ((fr-srv-pipe nil) (to-srv-pipe nil) (stop nil) (text nil))
    (format t "Opening output ~A~%" ipc-to-srv-pipe-name)
    (setf to-srv-pipe (open ipc-to-srv-pipe-name :direction :output :if-exists :overwrite))
    (format t "Opening input ~A~%" ipc-fr-srv-pipe-name)
    (setf fr-srv-pipe (open ipc-fr-srv-pipe-name :direction :input))
    (format t "Ready~%")
    (dowhile (not stop)
      (sleep 0.01)
      (dowhile (listen)
        (setf text (read-line))
        (write-line text to-srv-pipe)
        (finish-output to-srv-pipe))
      (dowhile (listen fr-srv-pipe)
        (setf text (read-line fr-srv-pipe))
        (write-line text)
        (when (string= text "exit")
          (setf stop t))))
    (close fr-srv-pipe)
    (close to-srv-pipe)))

The sleep call runs for one centisecond. This is below the interactive perceptual limit and the overhead is low enough to have no noticeable effect on CPU loading.

[sje]

The selector server that performs the actual search can be called by any of the three command processors (ICP, xboard, and UCI); each command processor uses the same syntax and semantics for this purpose.

Instead of inventing yet another formatted command protocol and a corresponding parser, the toolkit keeps things simple. Rather than shipping formatted text like EPD, XML, or some other semi-rigid format, each command processor just writes a single Lisp object and the selector server uses the built-in Lisp parser (the read function) to do any decoding. Each Lisp object used or communication is just a simple association list.

One association tag that's present in each such command list is the "verb" tag. For communicating position data, there are three verbs: "play" to play a move, "unplay" to unplay the last move, and "reload" (full position and history, used only when no alternative sequence is available).

For example, consider the following PGN that would be present in a command processor:

Code: Select all

[Event "Unnamed event"]
[Site "gail"]
[Date "2008.10.01"]
[Round "-"]
[White "Unnamed player"]
[Black "Unnamed player"]
[Result "*"]
[Setup "1"]
[FEN "2qrr1n1/3b1kp1/2pBpn1p/1p2PP2/p2P4/1BP5/P3Q1PP/4RRK1 w - - 0 1"]

1. Qh5+ Nxh5 2. fxe6+ Kg6 3. Bc2+ Kg5 *

A reload command would be built via:

Code: Select all

(defun build-reload (my-cpc)
  "Build a reload command; called by a search client."
  (let
    (
      (result nil)
      (moves  (reverse (cpc-move-stack my-cpc)))
    )
    (push (cons 'played (mapcar #'san-string moves)) result)
    (push (cons 'fen    (fenpos-string (cpc-base-fenpos my-cpc))) result)
    (push (cons 'verb   'reload) result)
    result))

And it's output for the above PGN would be (free format):

Code: Select all

((VERB . RELOAD)
 (FEN . "2qrr1n1/3b1kp1/2pBpn1p/1p2PP2/p2P4/1BP5/P3Q1PP/4RRK1 w - - 0 1")
 (PLAYED "Qh5+" "Nxh5" "fxe6+" "Kg6" "Bc2+" "Kg5"))

This is sent from the command processor (the client) to the selector (the server on a separate thread) using the pipe scheme. The selector first builds its internal version of the association list, and then evaluates:

Code: Select all

(cdr (assoc 'verb the-assoc-list-that-just-got-read))

This would give the symbol RELOAD, and so the a-list would be dispatched to the reload handler. Similar processing is done for the other verbs.

Some care is needed when sending the Lisp objects over the named pipe channel. The text line functions can't be used because of possible overflow as some implementations limit a line input to 1K characters and a long PGN can exceed that. There are also some other subtle reasons for abstracting command exchange at the object level instead of the text line level.

[sje]

Here is the example Lisp form echo server and client.

Lisp forms may span more than one line and one line can have more than one Lisp form. Forms may also be recursively nested. Fortunately, the built-in Lisp functions "read" and "write" handle all the details.

The only helper code here is the insertion of a newline between forms (any whitespace character would work) as otherwise two adjacent symbol forms would be mushed together by the writer and would be read as a single form by the reader.

Code: Select all

(defun echo-server ()
  "Run a Lisp form echo server."
  (let ((fr-srv-pipe nil) (to-srv-pipe nil) (stop nil) (form nil))
    (format t "Opening input ~A~%" ipc-to-srv-pipe-name)
    (setf to-srv-pipe (open ipc-to-srv-pipe-name :direction :input))
    (format t "Opening output ~A~%" ipc-fr-srv-pipe-name)
    (setf fr-srv-pipe (open ipc-fr-srv-pipe-name :direction :output :if-exists :overwrite))
    (format t "Ready~%")
    (dowhile (not stop)
      (sleep 0.01)
      (dowhile (listen to-srv-pipe)
        (setf form (read to-srv-pipe))
        (write form) (newline t)
        (write form :stream fr-srv-pipe) (newline fr-srv-pipe)
        (finish-output fr-srv-pipe)
        (when (eq? form 'exit)
          (setf stop t))))
    (close fr-srv-pipe)
    (close to-srv-pipe)))

(defun echo-client ()
  "Run a Lisp form echo client."
  (let ((fr-srv-pipe nil) (to-srv-pipe nil) (stop nil) (form nil))
    (format t "Opening output ~A~%" ipc-to-srv-pipe-name)
    (setf to-srv-pipe (open ipc-to-srv-pipe-name :direction :output :if-exists :overwrite))
    (format t "Opening input ~A~%" ipc-fr-srv-pipe-name)
    (setf fr-srv-pipe (open ipc-fr-srv-pipe-name :direction :input))
    (format t "Ready~%")
    (dowhile (not stop)
      (sleep 0.01)
      (dowhile (listen)
        (setf form (read))
        (write form :stream to-srv-pipe) (newline to-srv-pipe)
        (finish-output to-srv-pipe))
      (dowhile (listen fr-srv-pipe)
        (setf form (read fr-srv-pipe))
        (write form) (newline t)
        (when (eq? form 'exit)
          (setf stop t))))
    (close fr-srv-pipe)
    (close to-srv-pipe)))

In the above server function, a one line change to the line:

Code: Select all

        (setf form (read to-srv-pipe))

to:

Code: Select all

        (setf form (eval (read to-srv-pipe)))

would change the echo server into an evaluation server. This technique can be useful in application environments where a non Lisp program needs to have a Lisp task performed.

[sje]

Stuff that a command processor can send to a move selector server thread:

Code: Select all

;;; Selector server verbs

(defconstant ssv-deponder (enum-init) "Begin time limit observation during the search")
(defconstant ssv-exit     (enum-next) "Server to exit")
(defconstant ssv-finish   (enum-next) "Finish the current search and send result")
(defconstant ssv-level    (enum-next) "Set the level components")
(defconstant ssv-option   (enum-next) "Set the option components")
(defconstant ssv-play     (enum-next) "Play the indicated move")
(defconstant ssv-reload   (enum-next) "Reload the base position and move history")
(defconstant ssv-report   (enum-next) "Report status")
(defconstant ssv-reset    (enum-next) "Reset server PSE")
(defconstant ssv-start    (enum-next) "Start a search")
(defconstant ssv-syncreq  (enum-next) "Synchronization request")
(defconstant ssv-unplay   (enum-next) "Unplay the last played move")

(defconstant ssv-limit (enum-limit))

(defmacro dossvs ((my-ssv-var) &body my-body)
  "Construct a per selector server verb iteration loop."
  `(dotimes (,my-ssv-var ssv-limit) (declare (type fixnum ,my-ssv-var)) ,@my-body))

(defconstant as-ssv-vec
  (make-array ssv-limit
    :initial-contents
      (vector
        "deponder"
        "exit"
        "finish"
        "level"
        "option"
        "play"
        "reload"
        "report"
        "reset"
        "start"
        "syncreq"
        "unplay")))

Stuff that a move selector server can send to a command processor thread:

Code: Select all

;;; Selector server replies

(defconstant ssr-resolved (enum-init) "Report search resolution; ready to be finished")
(defconstant ssr-result   (enum-next) "Search result report")
(defconstant ssr-status   (enum-next) "Current status item values")
(defconstant ssr-syncack  (enum-next) "Synchronization acknowledgement")

(defconstant ssr-limit (enum-limit))

(defmacro dossrs ((my-ssr-var) &body my-body)
  "Construct a per selector server reply iteration loop."
  `(dotimes (,my-ssr-var ssr-limit) (declare (type fixnum ,my-ssr-var)) ,@my-body))

(defconstant as-ssr-vec
  (make-array ssr-limit
    :initial-contents
      (vector
        "resolved"
        "result"
        "status"
        "syncack")))

[sje]

A small speed optimization for a bitboard program can be obtained by changing the bitboard database construction routine to load stepper pieces before sweep pieces. This can be helpful for those cases where a program creates a lot of bitboard databases from board array scanning. The idea is to reduce the overall work by minimizing costly sweep attack updates on sparsely populated boards.

In the following code, the men are placed in piece order: pawns, knights, bishops, rooks, queens, and finally the kings.

Code: Select all

;;; Bitboard database construction

(defun calc-bbdb (my-board)
  "Create a bitboard database from a board."
  (let ((result (mk-bbdb)) (ms-list-vec (make-array piece-rlimit :initial-element nil)))
    (dosqs (sq)
      (let ((man (get-man my-board sq)))
        (when (is-man-nonvac? man)
          (push (cons man sq) (svref ms-list-vec (svref mc-man-to-piece-vec man))))))
    (dopieces (piece)
      (dolist (pair (svref ms-list-vec piece))
        (add-man-bbdb (car pair) (cdr pair) result)))
    result))