/****************************************************************************/ /* */ /* BCS Algorithm 68: White to move and mate in n moves. */ /* */ /* J. R. Manning, Shoe & Allied Trades R. A., Kettering, UK. */ /* */ /* The Computer Journal, Vol. 14 No. 2, May 1971,209-213. */ /* */ /****************************************************************************/ /* Translated from Algol 60 to PL/I by R. A. Vowels, 2 June 2008. */ /* I have enhanced the input and output so as to show the */ /* pieces as letters instead of as integers. */ /* Black's pieces are represented by lower-case letters, while */ /* white's pieces are represented as upper-case letters. */ /* Thus, Q = white's queen, q = black's queen, etc. */ /* An empty board square is shown as a period (.). */ /* Errors corrected: /* 1. In procedure SCANMO, orthagonal move by Rook or Queen, /* "if w = 7 | w = 9 then" should be "if w = 7 | w = 8 then", /* in order to involve Queen. /* 2. In OWNCH, searching for friendly king: Loop should search positions */ /* from 1 to 78, not 1 to 79. /* 3. stal may need initializing. */ /* This program solves chess problems of the type "White to */ /* move and mate in n moves". */ /* x is the depth of search; /* a(x,m) takes the value 0 if square m is empty, /* and the values -1, -3, -4, -7, -8, -9 /* if it is occupied by an enemy pawn, knight, bishop, /* rook, queen or king repectively, /* and +1, +3, +4, +7, +8, +9 if it is occupied by a /* friendly pawn, knight, bishop, rook, queen or king. /* Note that the board is treated as a linear vector /* of 64 elements, not as an 8 x 8 matrix. /* One cross-section a(k,*) represents the positions /* of the pieces after one move. A(1,*) is the /* initial position, A(2,*) is black's reply; a(3,*) /* is white's reply to black, and so on. /* stal is used to guard against the possibility of a /* stalemate. /* ep(*) holds information about en passant moves. /* exh appears to be true if all white's moves are exhausted for /* this square, false otherwise. /* val An array whose values are true when a board square is a /* valid square, i.e., for the positions 1 to 8, 11 to 18, etc, /* as enumerated for array A below. /* After each trial move, the Boolean procedure OWNCH is /* entered to test whether one's own king is left in check. /* If not, then the board is reversed /* ( a(x+1, m) = -a(x,79-m) ) and the computer is ready to /* 'play from the opposite side'. */ /* The board - array a - is represented as follows. Actual /* board positions are numbered from 1 to 8, 11 to 18, /* 21 to 28, 31 to 38, 41 to 48, 51 to 58, 61 to 68, /* 71 to 78, as indicated within the square marked by four /* crosses (x). /* Note that board positions (e.g., 38) can be read as /* co-ordinates (e,g,, 3,8) measured from top left-hand corner /* of the board, rows numbering from 0, and columns numbering /* from 1. +----+----+----+----+----+----+----+----+----+----+----+----+ | |-20 |-19 |-18 |-17 |-16 |-15 |-14 |-13 |-12 |-11 |-10 | +----+----+----+----+----+----+----+----+----+----+----+----+ |-11 |-10 | -9 | -8 | -7 | -6 | -5 | -4 | -3 | -2 | -1 | 0 | +----+----x----+----+----+----+----+----+----+----x----+----+ | -1 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | +----+----x----+----+----+----+----+----+----+----x----+----+ | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | +----+----+----+----+----+----+----+----+----+----+----+----+ | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | | +----+----+----+----+----+----+----+----+----+----+----+----+ */ (SUBRG, FOFL, SIZE): CHESS: PROCEDURE OPTIONS (MAIN); declare (y, n, j) fixed binary; declare board file; declare debug bit (1) static aligned initial ('0'b); put ('How many moves to mate?:'); get list (n); y = n + n; begin; declare (a(y+1, -20:99), ep(0:y+1) ) fixed binary (7); declare (x, s, z) fixed binary; declare (val(-20:99), stal(0:y+1), exh(0:y+1), white) bit (1) aligned; /* This procedure returns TRUE ('1'b) if own king is in check. */ OWNCH: PROCEDURE (xp) returns (bit(1) aligned) OPTIONS (REORDER); declare xp fixed binary; declare (x, k, mk, m) fixed binary; declare result bit (1) aligned; on error snap system; x = xp; result = '1'b; if debug then put skip list ('Looking for friendly King.'); /* Search for friendly King. */ do m = 1 to 78; /* corrected; was 79. */ if a(x,m) = 9 then do; mk = m; /* mk is square where the king is. */ go to L4; end; end; /* Look for threats of check from opponent's pawns or pieces. */ /* Look out for opponent's Knight. */ L4: if debug then put skip edit ('Found friendly king at position ', trim(mk)) (A); if debug then put skip list ('Looking for threat of check from opponent''s Knight'); do m = 8, 12, 19, 21; if a(x, mk+m) = -3 | a(x, mk-m) = -3 then go to L1; end; /* Look out for opponent's pawn. */ if debug then put skip list ('Looking for threat of check from opponent''s pawn'); if a(x, mk-9) = -1 | a(x, mk-11) = -1 then go to L1; /* Look out for opponent's King. */ if debug then put skip list ('Looking for threat of check from opponent''s King'); do m = 11, 10, 9, 1; if a(x, mk+m) = -9 | a(x, mk-m) = -9 then go to L1; end; /* Look out for opponent's Rook and Queen (orthogonal move). */ if debug then put skip list ('Looking for threat of check from opponent''s Rook or Queen'); do m = -1, -10, 1, 10; k = mk; do k = k+m by m while (val(k)); if a(x, k) = -7 | a(x, k) = -8 then go to L1; else if a(x, k) ^= 0 then go to L2; end; L2: end; /* Look out for opponent's Bishop and Queen (diagonal move). */ if debug then put skip list ('Looking for threat of check from opponent''s Bishop or Queen'); do m = -9, -11, 9, 11; k = mk; do k = k+m by m while (val(k)); if a(x, k) = -4 | a(x,k) = -8 then go to L1; else if a(x, k) ^= 0 then go to L3; end; L3: end; if debug then put skip list ('OWNCH is FALSE.'); return ( '0'b ); L1: if debug then put skip list ('OWNCH is TRUE.'); return ( result ); END OWNCH; /* Procedure TRYM makes a trial move by moving a piece from square */ /* p to square q. The argument corresponding to R is always SCANMO. */ TRYM: PROCEDURE (PP, QP, R) RECURSIVE OPTIONS (REORDER); declare (pp, qp) fixed binary; declare (p, q) fixed binary; declare r entry (); declare (d, m) fixed binary; on error snap system; if debug then put skip edit ('ENTERED TRYM to move piece at ', trim(pp), ' to position ', trim(qp)) (a); p = pp; q = qp; exh(x) = '0'b; d = a(x, q); /* Save the piece at position q ... */ a(x, q) = a(x, p); /* ... and move the piece at position p there, */ a(x, p) = 0; /* ... and delete the piece originally at position p. */ if ownch(x) then do; /* The piece moved into check. */ a(x, p) = a(x, q); a(x, q) = d; /* Restore the board. */ if debug then put skip list ('TRYM: MOVED INTO CHECK, SO BACK UP.'); go to M6; end; stal(x) = '0'b; if x = y then do; exh(x) = '1'b; go to M6; end; if debug then call display_board(x); /* Reverse the Board storing the new board one level higher, */ /* so that computer plays from the opposite side. */ do m = 1 to 78; a(x+1, m) = -a(x, 79-m); end; /* Board is reversed so that computer plays from the opposite side. */ if debug then call display_board(x+1); a(x, p) = a(x, q); a(x, q) = d; if white then do; stal(x+1) = ^ownch(x+1); if x = y-1 & stal(y) then go to M6; end; white = ^white; x = x + 1; if x > j then j = x; call r; x = x-1; white = ^white; if exh(1) & ^stal(j) then do; m = a(1, p); put skip edit ('Mate in ', trim(isrl(j, 1)), ': key move from position ', display_position (p), ' to position ', display_position (q), ' ' ) (A); if m = 1 then do; put skip list ('pawn'); if q > 70 then do; put edit ('=') (a); m = -a(2, 79-q); end; end; select (m); when (3) put edit ('knight') (a); when (4) put edit ('bishop') (a); when (7) put edit ('rook') (a); when (8) put edit ('queen') (a); otherwise put edit ('king') (a); end; exh(1) = '0'b; end; if x = 1 then j = x; M6: END TRYM; /* This procedure scans all possible moves, one by one. When a possible */ /* move is found, TRYM is invoked. */ SCANMO: PROCEDURE () RECURSIVE OPTIONS (REORDER); declare (w, i, m, k) fixed binary; RETRACE: PROCEDURE(); on error snap system; if ^stal(x+1) | ^white then go to L5; END RETRACE; on error snap system; w = ep(x-1); /* en passant capture. */ if w > 0 then do m = 80-w, 78-w; if a(x,m) = 1 then do; a(x, 79-w) = 0; call trym(m, 69-w, scanmo); a(x, 79-w) = -1; if exh(x) then call retrace; end; end; /* of e.p. capture. */ do m = 1 to 78; w = a(x, m); if w < 1 then go to L4; /* Skip opponent's pawn or piece, and empty square. */ /* Pawn move. */ if w = 1 then do; if a(x, m-10) = 0 then do; if m < 19 then /* pawn promotion to knight, bishop, */ /* rook, or queen. */ do k = 3, 4, 7, 8; a(x, m) = k; call trym(m, m-10, scanmo); a(x, m) = 1; if exh(x) then call retrace; end; else do; call trym(m, m-10, scanmo); if exh(x) then call retrace; end; if m > 60 & m < 69 & a(x, m-20) = 0 then do; /* double move by pawn. */ ep(x) = m-20; call trym(m, m-20, scanmo); ep(x) = 0; if exh(x) then call retrace; end; end; do i = 9, 11; if a(x, m-i) < 0 then do; if m < 19 then /* Pawn promotion by capture. */ do k = 3, 4, 7, 8; a(x,m) = k; call trym(m, m-i, scanmo); a(x,m) = 1; if exh(x) then call retrace; end; else /* pawn capture. */ do; call trym(m, m-i, scanmo); if exh(x) then call retrace; end; end; end; end; /* pawn move. */ /* Knight move. */ if w = 3 then do i = 8, 12, 19, 21, -8, -12, -19, -21; if a(x, i+m) < 1 & val(i+m) then do; call trym(m, i+m, scanmo); if exh(x) then call retrace; end; end; /* knight move. */ /* Diagonal move by bishop or queen. */ if w = 4 | w = 8 then do i = -11, -9, 9, 11; k = m; do k = k+i by i while (val(k) & a(x, k) < 1); call trym(m, k, scanmo); if exh(x) then call retrace; if a(x, k) ^= 0 then go to Q7; end; Q7: end; /* diagonal move. */ /* Orthogonal move by rook or queen. */ if w = 7 | w = 8 then /* This was w = 9, but 9 is King. */ /* Changed to 8 for queen. */ do i = -10, -1, 1, 10; if debug then do; if w = 7 then put skip edit ( 'Checking Rook moves at position ', trim(m)) (a); else put skip edit ( 'Checking orthogonal Queen moves at position ', trim(m))(a); end; k = m; do k = k+i by i while (val(k) & a(x, k) < 1); if debug then put skip edit ('Checking position ', trim(k)) (A); call trym (m, k, scanmo); if exh(x) then call retrace; if a(x, k) ^= 0 then go to Q8; end; Q8: end; /* of orthogonal move. */ /* King move */ if w = 9 then do i = -11, -10, -9, -1, 1, 9, 10, 11; if a(x, i+m) < 1 & val(i+m) then do; call trym(m, i+m, scanmo); if exh(x) then call retrace; end; end; /* of King move. */ L4: end; exh(x-1) = '1'b; L5: END SCANMO; /* Displays a position in algebraic notation. */ DISPLAY_POSITION: PROCEDURE (m) RETURNS ( CHAR(2) ); declare m fixed binary; declare (row, column) fixed binary (7); on error snap system; row = 8 - divide(m, binary(10), 7, 0); column = mod(m, 10); return ( substr('ABCDEFGH', column, 1) || substr('12345678', row, 1) ); END DISPLAY_POSITION; DISPLAY_BOARD: PROCEDURE (level); declare level fixed binary; declare (s, z) fixed binary (7); put skip list ('Level ' || trim(level)); do s =1 to 71 by 10; put skip edit (' ') (col(25), a); do z = 0 to 7; select ( a(level, s+z) ); when (-1) put edit ('p') (x(1), a); when (-3) put edit ('n') (x(1), a); when (-4) put edit ('b') (x(1), a); when (-7) put edit ('r') (x(1), a); when (-8) put edit ('q') (x(1), a); when (-9) put edit ('k') (x(1), a); when ( 1) put edit ('P') (x(1), a); when ( 3) put edit ('N') (x(1), a); when ( 4) put edit ('B') (x(1), a); when ( 7) put edit ('R') (x(1), a); when ( 8) put edit ('Q') (x(1), a); when ( 9) put edit ('K') (x(1), a); otherwise put edit ('.') (x(1), a); end; end; end; END DISPLAY_BOARD; INPUT_BOARD: PROCEDURE; declare v character (1); declare k fixed binary (7); declare (s, z) fixed binary (7); do s =1 to 71 by 10; do z = 0 to 7; get file (board) edit (v) (a(1)); select (v); when ('p') k = -1; when ('n') k = -3; when ('b') k = -4; when ('r') k = -7; when ('q') k = -8; when ('k') k = -9; when ('P') k = 1; when ('N') k = 3; when ('B') k = 4; when ('R') k = 7; when ('Q') k = 8; when ('K') k = 9; when ('.') k = 0; otherwise do; put skip list ('Invalid piece, ' || v || '. Empty square assumed'); k = 0; end; end; a(1, s+z) = k; val(s+z) = '1'b; end; end; END INPUT_BOARD; /* Initialize the board. */ do s = -20 to 99; val(s) = '0'b; do z = 1 to y+1; a(z,s) = 0; end; end; stal = '0'b; /* may need initializing? */ /* Obtain the values and the implied board positions from the player. */ put skip list ('Please type the 64 values representing the pieces and their implied positions:'); open file (board) title ( '/BOARD.DAT,TYPE(CRLF),RECSIZE(80)' ) input; /* read in the initial position. */ call input_board; /* do s =1 to 71 by 10; do z = 0 to 7; get file (board) list (a(1, s+z)); val(s+z) = '1'b; end; end; */ call display_board (1); /* Display the initial position. */ ep = 0; /* En passant capture is forbidden on white's first move. */ stal(1), white = '1'b; x, j = 1; call scanmo; put skip list ('No other solution'); end; /* of the BEGIN block. */ END CHESS;