diff --git a/Makefile b/Makefile index 57898ee7..8b73bc34 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \ - macsym lmcons dmcg hack + macsym lmcons dmcg hack agb DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ diff --git a/build/misc.tcl b/build/misc.tcl index dde65f6a..324db238 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -402,6 +402,10 @@ respond "with ^C" "DSPLY==0\r" respond "\n" "CHEOPS==0\r\003" expect ":KILL" +# CKR +respond "*" ":midas games;ts ckr_agb;ckr\r" +expect ":KILL" + # Spacewar, standalone respond "*" ":midas /t dsk0:.;@ spcwar_spcwar; newwar\r" respond "with ^C" "APR==0\r" diff --git a/doc/games.md b/doc/games.md index bcda16d9..b3b1fb32 100644 --- a/doc/games.md +++ b/doc/games.md @@ -10,6 +10,10 @@ type one of: - `:games;adv340` - `:games;adv448` +### Checkers + +Checkers program by Alan Baisley. To play, type `:games;ckr`. + ### Jotto Two players, one of which is the computer, competes in first guessing diff --git a/doc/programs.md b/doc/programs.md index 5acd9a70..883555b2 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -38,6 +38,7 @@ - CHESS, unknown chess program. - CHESS2, Alan Baisley's Tech II chess program. - CHTN/CFTP, Chaosnet TELNET and FTP support. +- CKR, Alan Baisley's checkers program. - COMIFY, convert HEX to COM format. - COMPLR, Lisp compiler. - COMSAT, mail server. diff --git a/src/agb/ckr.88 b/src/agb/ckr.88 new file mode 100644 index 00000000..d5c278bc --- /dev/null +++ b/src/agb/ckr.88 @@ -0,0 +1,384 @@ +TITLE CHECKERS +.MLLIT==1 + +IRP A,,[A,B,C,D,P,V,I,I2] A=.IRPCNT+1 ? TERMIN + +SOUT=1_33 + +LOC 41 + JSR UUOH +LOC 100 + + +; 29 30 31 32 ; 32 33 34 35 +; 25 26 27 28 ; 27 28 29 30 +; 21 22 23 24 ; 23 24 25 26 +; 17 18 19 20 ; 18 19 20 21 +; 13 14 15 16 ; 14 15 16 17 +; 9 10 11 12 ; 9 10 11 12 +; 5 6 7 8 ; 5 6 7 8 +; 1 2 3 4 ; 0 1 2 3 + + +DEFINE CONC A,B +A!B!TERMIN + +MASK==1_4+1_13.+1_22.+1_31. +LEGMF==40 + +MATERIAL: 0 + +WPCS: 0 +BPCS: 0 + +WKNGS: 0 +BKNGS: 0 + + +EVAL: SETO B, ; EVALUATE POS WITHOUT FURTHER JUMP PENDING +EVALCP: ; EVALUATE POS WITH FURTHER JUMP PENDING + + CAIA P,BPRINT ? .IOT TYIC, ; FOR DEBUGGING ONLY + + TLZ I,LEGMF +IRP Q1,,[WPCS,WPCS,WKNGS,WKNGS]Q2,,[5,4,-5,-4] + MOVE Q1(I) + CONC JUMPE EV,\<.IRPCNT*2+2> + AND -1(P) ; -1 OR DEST OF LAST CAPTURE + LSH @(I)[,Q2 ? ,-Q2] + AND @(I)[BPCS ? WPCS] + ANDCM [MASK] + LSH @(I)[,Q2 ? ,-Q2] + ANDCM WPCS ? ANDCM BPCS + ANDCM [MASK] +CONC EV,\<.IRPCNT*2+1>,: + JFFO .+2 + CONC JRST EV,\<.IRPCNT*2+2>, + MOVEI D,4+.IRPCNT + ANDCM BIT(A) + PUSHJ P,MCEVAL ; MAKE CAPTURE AND RETURN VAL + CAMLE V,ALPHA ? JSP D,NEWVAR ; RETURNS TO 1(D) + JSP D,DPV + ADD V,(P) ? JUMPGE V,EV2A + CONC JRST EV,\<.IRPCNT*2+1>, +CONC EV,\<.IRPCNT*2+2>,: +TERMIN + + TLNE I,LEGMF ? JRST EV2A + SETO + EXCH -1(P) + AOJE EVMVS + XORI I,1 + MOVE ALPHA ? EXCH BETA ? MOVEM ALPHA + JRST EVAL +EVMVS: CAML P,DEPTH ? JRST EV2C +IRP Q1,,[WPCS,WPCS,WKNGS,WKNGS]Q2,,[5,4,-5,-4] + MOVE Q1(I) + CONC JUMPE EV,\<.IRPCNT*2+12> + LSH @(I)[,Q2 ? ,-Q2] + ANDCM [MASK] + ANDCM WPCS ? ANDCM BPCS +CONC EV,\<.IRPCNT*2+11>,: + JFFO .+2 + CONC JRST EV,\<.IRPCNT*2+12>, + MOVEI D,.IRPCNT + ANDCM BIT(A) + PUSHJ P,MMEVAL ; MAKE MOVE AND RETURN VAL OF RESULTING POS + CAMLE V,ALPHA ? JSP D,NEWVAR ; RETURNS TO 1(D) + JSP D,DPV + ADD V,(P) ? JUMPGE V,EV2A + CONC JRST EV,\<.IRPCNT*2+11>, +CONC EV,\<.IRPCNT*2+12>,: +TERMIN + + HRROI V,-10000.-PDL(P) + TLNE I,LEGMF +EV2A: MOVE V,ALPHA +EV2B: TLNN P,-1 ? JRST EXIT +IRP A,,[ALPHA,B,CVAR,MATERIAL,I,BKNGS,WKNGS,BPCS,WPCS,BETA,0] POP P,A ? TERMIN + TRNE B,20 ? MOVN V,V +CPOPJ: POPJ P, + +EV2C: XCT (I)[MOVE V,MATERIAL ? MOVN V,MATERIAL] + JRST EV2B + +MMEVAL: JSP C,CCONS + TLO I,LEGMF +IRP A,,[0,BETA,WPCS,BPCS,WKNGS,BKNGS,I,MATERIAL,CVAR,[[-1]],ALPHA] PUSH P,A ? TERMIN + MOVE B,ALPHA ? EXCH B,BETA ? MOVEM B,ALPHA + MOVE B,@(I)[@SWMV(D) ? @SBMV(D)] + XORM B,WPCS(I) + TDNE B,WKNGS(I) ? JRST MMEV2 ; MOVE BY KING + AND B,WPCS(I) ; DESTINATION BIT + TDNN B,LRANK(I) ? JRST MMEV3 + IORM B,WKNGS(I) + XCT (I)[AOSA MATERIAL ? SOSA MATERIAL] ; PROMOTING MOVE +MMEV2: XORM B,WKNGS(I) +MMEV3: XORI I,1 + JRST EVAL + +MCEVAL: JSP C,CCONS + TLO I,LEGMF +IRP A,,[0,BETA,WPCS,BPCS,WKNGS,BKNGS,I,MATERIAL,B] PUSH P,A ? TERMIN + MOVE B,@(I)[@SWCP1-4(D) ? @SBCP1-4(D)] + SETCMI I2,-2(I) + XORM B,WPCS(I2) ; CLEAR CAPT'D PIECE + TDNE B,WKNGS(I2) + SKIPA C,(I)[3 ? -3] + MOVE C,(I)[2 ? -2] + ADDM C,MATERIAL + ANDCAM B,WKNGS(I2) ; CLEAR CAPT'D KING IF ANY + MOVE B,@(I)[@SWCP2-4(D) ? @SBCP2-4(D)] + PUSH P,B ? PUSH P,ALPHA + XORM B,WPCS(I) ; MOVE PIECE + TDNN B,WKNGS(I) ? JRST .+3 + XORM B,WKNGS(I) ? JRST EVALCP ; MOVE KING IF ANY + AND B,WPCS(I) ; DESTINATION BIT + TDNN B,LRANK(I) ? JRST EVALCP ; TRY FURTHER CAPTURES + XCT (I)[AOS MATERIAL ? SOS MATERIAL] ; PROMOTING CAPTURE + IORM B,WKNGS(I) + SETOM -1(P) + XORI I,1 + JRST EVAL + +CCONS: HRROI B,-1 +CONS: EXCH B,VARL2+1 ; SAVE MOVE IN PRINCIPAL VARIATION LIST + EXCH B,CONS + HRLI A,(D) + XOR A,(I)[0 ? SETZ] + MOVEM A,VARL1-VARL2(B) + MOVEM B,CVAR + JRST (C) + +DPV: MOVE B,CVAR + JRST DPV1 + +NEWVAR: MOVEM V,ALPHA + MOVE B,CVAR + AOJ D, + EXCH B,@-2(P) ; NEW VARIATION + JUMPLE B,(D) +DPV1: MOVE A,B ; RESTORE OLD PV TO FREE STORAGE + EXCH A,CONS +DPV2: SKIPG C,(B) ? JRST DPV3 + SKIPL B,(C) ? JRST DPV2 + MOVEM A,(C) ? JRST (D) +DPV3: MOVEM A,(B) ? JRST (D) + +ALPHA: 0 +BETA: 0 + +BIT: REPEAT 44, 1_<43-.RPCNT> + +SWMV: SP5(A) ? SP4(A) ? SM5(A) ? SM4(A) +SBMV: SM5(A) ? SM4(A) ? SP5(A) ? SP4(A) + +SP5: REPEAT 44, 41_<43-.RPCNT-5> +SM4: REPEAT 44, 21_<43-.RPCNT> +SP4: REPEAT 44, 21_<43-.RPCNT-4> +SM5: REPEAT 44, 41_<43-.RPCNT> + +LRANK: 17_32. ? 17 + +SWCP1: SC1P5(A) ? SC1P4(A) +SBCP1: SC1M5(A) ? SC1M4(A) ? SC1P5(A) ? SC1P4(A) + +SWCP2: SC2P5(A) ? SC2P4(A) +SBCP2: SC2M5(A) ? SC2M4(A) ? SC2P5(A) ? SC2P4(A) + +SC1P5: REPEAT 44, 1_<43-.RPCNT-5> +SC1M4: REPEAT 44, 1_<43-.RPCNT+4> +SC1P4: REPEAT 44, 1_<43-.RPCNT-4> +SC1M5: REPEAT 44, 1_<43-.RPCNT+5> + +SC2P5: REPEAT 44, 2001_<43-.RPCNT-12> +SC2M4: REPEAT 44, 401_<43-.RPCNT> +SC2P4: REPEAT 44, 401_<43-.RPCNT-10> +SC2M5: REPEAT 44, 2001_<43-.RPCNT> + +THINK: MOVEI VARL2 ? MOVEM CVAR + SETOM VARL2 + MOVE [EXCH B,VARL2+1] ? MOVSI A,-158. ? MOVEM CONS + AOJ ? MOVEM VARL2+1(A) ? AOBJN A,.-2 + MOVE [JRST 4,CONS] ? MOVEM VARL2+159. + MOVNI 700000 ? MOVEM ALPHA ? MOVEM BETA ? MOVEM PDL + JRST EVAL +EXIT: MOVE A,VARL2 + JUMPL A,RD +EXIT1: JUMPL A,EXIT2 + XCT (I)[SKIPGE B,VARL1-VARL2(A) ? SKIPL B,VARL1-VARL2(A)] + JRST EXIT2 + HLRZ D,B ? ANDI D,7 + PUSH P,A ? MOVEI A,(B) + XOR D,(I)[0 ? 2] + ADD A,@MMOVE1 + PUSHJ P,MMOVE + POP P,A + MOVE A,(A) + XORI I,1 + JRST EXIT1 +EXIT2: XORI I,1 ? JRST RD + +RESET: MOVEI GAMEP ? MOVEM GAMEP + MOVE [IBOARD,,WPCS] + BLT BKNGS + SETZB I,MATERIAL + MOVEI P,PDL + JRST RD + +GO: +TYIC==1 +TYOC==2 + .OPEN TYIC,['TTY] + .VALUE + .OPEN TYOC,[4021,,'TTY] + .VALUE + JRST RESET + +UUOH: 0 + HLRZ 40 ? CAIE (SOUT) ? .VALUE +.SOUT: MOVSI 440700 ? HLLM 40 +.SOUT1: ILDB 40 ? JUMPE @UUOH + .IOT TYOC, ? JRST .SOUT1 + +2SP=PUSHJ P,. + .IOT TYOC,[40] + POPJ P, + +BPRINT: PUSH P,B + SOUT [ASCIZ /C/] + MOVSI A,-8 ? MOVSI B,40000 +BP1: .IOT TYOC,[15] + TRNN A,1 ? 2SP + MOVSI C,-4 +BP2: MOVEI "0 + TDNN B,WKNGS ? TDNE B,BKNGS ? MOVEI "2 + TDNE B,WPCS ? ADDI 1 + TDNE B,BPCS ? ADDI 2 + .IOT TYOC, ? 2SP + ROT B,1 + AOBJN C,BP2 + ROT B,-8 + TRNN A,1 ? ROT B,-1 + SOUT @BDTAB(A) + AOBJN A,BP1 + .IOT TYOC,[15] + POP P,B + POPJ P, + +BDTAB: [ASCIZ / 32-35/] + [ASCIZ / 27-30/] + [ASCIZ / 23-26/] + [ASCIZ / 18-21/] + [ASCIZ / 14-17/] + [ASCIZ / 9-12/] + [ASCIZ / 5-8/] + [ASCIZ / 0-3/] + +PAT: BLOCK 77 + + VARL2 + -1 +PDL: BLOCK 999. +CVAR: 0 +VARL1: BLOCK 160. +VARL2: BLOCK 160. + +IBOARD: 17757 ? 757740,, ? 0 ? 0 + +DEPTH: 4*9,, + +RDNUM: MOVEI A, +RDNUM1: .IOT TYIC,B + CAIL B,"0 ? CAILE B,"9 ? POPJ P, + IMULI A,12 ? ADDI A,-"0 (B) + JRST RDNUM1 + +RD: PUSHJ P,BPRINT + MOVSI A,440700 ? MOVEI +RD1: .IOT TYIC,B + CAIL B,"A ? CAILE B,"Z ? JRST RD2 + TLNE A,770000 ? IDPB B,A + JRST RD1 +RD2: MOVSI A,-NSYMS +RD3: AOJ A, ? CAME SYMTAB-1(A) ? AOBJN A,RD3 + JUMPG A,RD + SKIPE B,SYMTAB(A) ? JRST (B) + MOVEI A,SYMTAB-MVS-1(A) + ASH A,-1 + MOVEI D,(A) + PUSHJ P,RDNUM + SETCMI A,-44(A) + PUSHJ P,MMOVE + JRST RD + +SYMTAB: + ASCII /R/ ? RESET + ASCII /M/ ? THINK + ASCII /U/ ? UNMOVE + ASCII /S/ ? SETUP + ASCII /D/ ? SETD +MVS: ASCII /NE/ ? 0 + ASCII /NW/ ? 0 + ASCII /SW/ ? 0 + ASCII /SE/ ? 0 + ASCII /NEJ/ ? 0 + ASCII /NWJ/ ? 0 + ASCII /SWJ/ ? 0 + ASCII /SEJ/ ? 0 +NSYMS=<.-SYMTAB>/2 + +SETD: PUSHJ P,RDNUM + IMULI A,10. + HRLZM A,DEPTH + JRST RD + +UNMOVE: MOVE A,GAMEP ? HRRZ I2,-4(A) +UNMOV2: TLNN A,-1 ? JRST RD + CAIE I2,@-4(A) ? JRST UNMOV3 + IRP B,,[WPCS,BPCS,WKNGS,BKNGS,I,MATERIAL] POP A,B ? TERMIN + JRST UNMOV2 +UNMOV3: MOVEM A,GAMEP + JRST RD + +GAMEP: . +GAME: BLOCK 1200. + +MMOVE: MOVE GAMEP + IRP A,,[MATERIAL,I,BKNGS,WKNGS,BPCS,WPCS] PUSH A ? TERMIN + MOVEM GAMEP + MOVE BIT(A) + TDNE WPCS ? TDZA I,I ? MOVEI I,1 +MMOVE1: SUB A,(D)[5? 4? -5? -4? 12? 10? -12? -10] + XOR D,(I)[0 ? 2] + CAIGE D,4 ? JRST MMOVE2 + MOVE B,@(I)[@SWCP1-4(D) ? @SBCP1-4(D)] + SETCMI I2,-2(I) + XORM B,WPCS(I2) ; CLEAR CAPT'D PIECE + TDNE B,WKNGS(I2) + SKIPA C,(I)[3 ? -3] + MOVE C,(I)[2 ? -2] + ADDM C,MATERIAL + ANDCAM B,WKNGS(I2) ; CLEAR CAPT'D KING IF ANY + MOVE B,@(I)[@SWCP2-4(D) ? @SBCP2-4(D)] + XORM B,WPCS(I) ; MOVE PIECE + TDNN B,WKNGS(I) ? JRST .+3 + XORM B,WKNGS(I) ? JRST MMOVE4 ; MOVE KING IF ANY + AND B,WPCS(I) ; DESTINATION BIT + TDNN B,LRANK(I) ? JRST MMOVE4 ; TRY FURTHER CAPTURES + XCT (I)[AOS MATERIAL ? SOS MATERIAL] ; PROMOTING CAPTURE + IORM B,WKNGS(I) + JRST MMOVE4 + +MMOVE2: MOVE B,@(I)[@SWMV(D) ? @SBMV(D)] + XORM B,WPCS(I) + TDNE B,WKNGS(I) ? JRST MMOVE3 ; MOVE BY KING + AND B,WPCS(I) ; DESTINATION BIT + TDNN B,LRANK(I) ? JRST MMOVE4 + IORM B,WKNGS(I) + XCT (I)[AOSA MATERIAL ? SOSA MATERIAL] ; PROMOTING MOVE +MMOVE3: XORM B,WKNGS(I) +MMOVE4: XORI I,1 + POPJ P, + +END GO